Interviews "deck" support in Tk/TCL - show 1 of N widgets
Joe VanAndel
# this procedure is designed to create a "deck" of widgets, only 1 of
# which is visible at time (ala Interviews)
# the deck is created within a fixed size frame, to avoid resizing when
# switching between different "cards"
#
# the first child created is visible by default.
#
#
# once the "deck" is created, we can select which "card" to show by calling
# deck_flip_to deck_name window_suffix
#
# we use the TCL convention that "args" is a list of lists, which allows
# a variable number of arguments
#
# __CurrentCard is a global array that keeps track of the currently visible
# "card" for each deck.
#
# we create vertical and horizontal "props" to set minimum dimensions
# for the deck
#
proc create_deck {my_name args} {
global __CurrentCard
frame $my_name
frame $my_name.width -geometry 5x1
frame $my_name.height -geometry 1x5
set nc [llength $args]
# puts stdout "args = $args ($nc)"
if {[llength $args] > 0} {
set first_child [lindex $args 0]
# we grab the 1st child widget's name, prepend our name, and create it
set child_suffix [lindex $first_child 1]
set child_name ${my_name}.${child_suffix}
set child_cmd [lindex $first_child 0]
# puts stdout "\$child_cmd = $child_cmd \$child_name = $child_name"
set c [eval $child_cmd $child_name [lrange $first_child 2 end]]
# now, we pack the child, so it is visible
pack append $my_name $my_name.width top $my_name.height right \
$c {expand frame center}
set __CurrentCard($my_name) $child_name
# deck_flip_to $my_name $child_suffix
}
# simply create each subsequent child, but don't pack them
foreach arg [lrange $args 1 end] {
set child_suffix [lindex $arg 1]
set child_name ${my_name}.${child_suffix}
set c [eval [lindex $arg 0] $child_name [lrange $arg 2 end]]
}
return $my_name
}
# make a given card of the deck visible by packing it.
#
# we set the size of the deck to the maximum size of any of the cards,
# so that we eliminate re-sizing when flipping between cards.
# At worst, we don't get the size correct until we've flipped thru all the
# cards
#
# TODO - protect against bad child_suffix being passed in
proc deck_flip_to {deck child_suffix} {
global __CurrentCard
# puts stderr "flip to $child_suffix"
# unpack the previously shown "card", so it is not visible
pack unpack $__CurrentCard(${deck})
set child_name ${deck}.${child_suffix}
set __CurrentCard($deck) $child_name
pack append $deck $child_name {expand frame center}
update
# now, adjust dimensions of 'props' to maximum dimension of any 'card'
# subtract 1 to avoid height gradually growing by 1 pixel
# (caused by a bug in tk, I presume)
#
set width [winfo width $deck]
# set height [winfo height $deck]
set height [expr [winfo height $deck]-1]
set list [$deck.width configure -geometry]
# extract 5x1 from the string "-geometry geometry Geometry {} 5x1"
set last [expr {[llength $list] -1} ]
# extract just the width number
regsub {([0-9]*)x1} [lrange $list $last $last] {\1} oldwidth
if {$width > $oldwidth} then {
$deck.width configure -geometry ${width}x1
# puts stderr "oldwidth = $oldwidth, width = $width"
}
set list [$deck.height configure -geometry]
set last [expr {[llength $list] -1} ]
regsub {1x([0-9]*)} [lrange $list $last $last] {\1} oldheight
if {$height > $oldheight} {
$deck.height configure -geometry 1x${height}
# puts stderr "oldheight = $oldheight, height = $height"
}
}
# this procedure creates a frame with a fixed size,
# and packs the specified window inside it with the specified arguments
#
# note - child_args must be specified as a list, specifying only the
# last component of the name of # the widget,
# which is always build as $my_name.child_name
#
# e.g.:
# pack append . [fixed_frame .x 400 200 { button but -text "SHORT"}] \
# {expand fill}
proc fixed_frame {my_name width height child_args } {
frame $my_name
frame $my_name.width -geometry ${width}x1
frame $my_name.height -geometry 1x$height
# we want to create the child as $my_name.$child_end
#
append child_name $my_name "." [lindex $child_args 1]
set child [lindex $child_args 0]
#
# we use 'eval' to force a re-parse of $child_args as a sep. set of
# arguments, rather than a list
set c [eval $child $child_name [lrange $child_args 2 end]]
pack append $my_name $my_name.width top $my_name.height right \
$c {expand frame center}
return $my_name
}
proc deck_demo {w} {
frame $w -borderwidth 1 -relief sunken
pack append $w \
[label $w.t1 -text "deck demo " ] {top} \
[create_deck $w.deck \
"mk_card l1 $w.deck l2 {push for card 2} {CARD -> 1 <- }" \
"mk_card l2 $w.deck l3 {push for card 3} {CARD ->2<-}" \
"mk_card l3 $w.deck l1 {push for card 1} {CARD ->3<-}" ] {top}
return $w
}
proc mk_card {w deck card button_label card_label} {
frame $w -borderwidth 1 -relief sunken
pack append $w \
[button $w.b -text $button_label -command "deck_flip_to $deck $card" ] {left expand fill} \
[label $w.l -text $card_label ] {left expand fill}
return $w
}
# to demonstrate the deck
# execute the following line
# pack append . [deck_demo .f1] top
---------------------------------------
Joe VanAndel Internet:vana...@ncar.ucar.edu
NCAR - ATD/RSF
P.O Box 3000 Fax: 303-497-2044
Boulder, CO 80307-3000 Voice: 303-497-2071
Case Larsen
Here's another demo that makes use of the "deck" code. It's a palette
for a user interface builder in the flavor of of the NeXT interface
builder. As far as I know, it only requires extended Tcl to run.
#! /bin/sh
# This is a shell archive. Remove anything before this line, then unpack
# it by saving it into a file and typing "sh file". To overwrite existing
# files, type "sh file -c". You can also feed this as standard input via
# unshar, or by typing "sh <file", e.g.. If this archive is complete, you
# will see the following message at the end:
# "End of shell archive."
# Contents: palette pip/src/Attrs pip/src/Callback pip/src/CheckButton
# pip/src/Frame pip/src/Label pip/src/ListBox pip/src/Message
# pip/src/RadioButton pip/src/Scrollbar pip/src/UIB.Utils
# pip/src/bind.extra pip/src/bind.std
# pip/src/SAMPLE/Palette.CheckButtons.Tcl
# pip/src/SAMPLE/Palette.Labels.Tcl
# pip/src/SAMPLE/Palette.ListBoxes.Tcl
# pip/src/SAMPLE/Palette.Messages.Tcl
# pip/src/SAMPLE/Palette.RadioButtons.Tcl
# pip/src/SAMPLE/Palette.TopLevel.Tcl
# Wrapped by cla...@krakatoa.lbl.gov on Tue Apr 14 23:16:28 1992
PATH=/bin:/usr/bin:/usr/ucb ; export PATH
mkdir -p pip/src/SAMPLE
if test -f 'palette' -a "${1}" != "-c" ; then
echo shar: Will not clobber existing file \"'palette'\"
else
echo shar: Extracting \"'palette'\" \(1165 characters\)
sed "s/^X//" >'palette' <<'END_OF_FILE'
Xproc pipsource {file} {
Xset tmp [pwd]
Xcd pip/src
X source $file
Xcd $tmp
X}
Xpipsource Frame
Xpipsource Message
Xpipsource Label
Xpipsource ListBox
Xpipsource Scrollbar
Xpipsource CheckButton
Xpipsource RadioButton
X
Xsource deck
Xsource pip/src/SAMPLE/Palette.TopLevel.Tcl
Xsource pip/src/SAMPLE/Palette.CheckButtons.Tcl
Xsource pip/src/SAMPLE/Palette.RadioButtons.Tcl
Xsource pip/src/SAMPLE/Palette.Labels.Tcl
Xsource pip/src/SAMPLE/Palette.ListBoxes.Tcl
Xsource pip/src/SAMPLE/Palette.Messages.Tcl
X
Xframe .palette
X
XPalette.TopLevel.Create .palette
X
Xset lbox [keylget NameMap(.palette) paletteList]
Xforeach i [keylget widgetAttr($lbox) entries] {
X $lbox insert 0 $i
X}
X
Xbind $lbox <1> "deck_flip_to .palette.deck \[selection get\]"
X
Xproc mk_pal {w card} {
X frame $w
X Palette.$card.Create $w
X return $w
X}
X
Xbind . <Control-q> "destroy ."
X
Xpack append .palette \
X [create_deck .palette.deck \
X "mk_pal CheckButtons CheckButtons" \
X "mk_pal RadioButtons RadioButtons"\
X "mk_pal Labels Labels"\
X "mk_pal ListBoxes ListBoxes" \
X "mk_pal Messages Messages" ] top
X
X
Xpack append . .palette top
END_OF_FILE
if test 1165 -ne `wc -c <'palette'`; then
echo shar: \"'palette'\" unpacked with wrong size!
fi
# end of 'palette'
fi
if test -f 'pip/src/Attrs' -a "${1}" != "-c" ; then
echo shar: Will not clobber existing file \"'pip/src/Attrs'\"
else
echo shar: Extracting \"'pip/src/Attrs'\" \(1406 characters\)
sed "s/^X//" >'pip/src/Attrs' <<'END_OF_FILE'
X#$Id: Attrs,v 1.3 1992/04/11 00:14:11 cs169 Exp $
X
Xset widgetAttr("") ""
X
X# --------------------------------------------------------------
X# attr.set, attr.get --
X#
X# Sets/gets attributes on widget. These attributes aren't
X# supported by Tk.
X#
X#
X# Results:
X# XXX
X#
X# Side effects:
X# XXX
X#
X# --------------------------------------------------------------
X
Xproc attr.set {wname attrName value} {
X global widgetAttr
X keylset widgetAttr($wname) $attrName $value
X}
X
Xproc attr.get {wname attrName} {
X global widgetAttr
X if {[string compare $widgetAttr($wname) ""] == 0} {
X# error "no attributes";
X return "";
X }
X if {[catch {keylget widgetAttr($wname) $attrName}] == 1} {
X return "";
X }
X return [keylget widgetAttr($wname) $attrName]
X}
X
X# --------------------------------------------------------------
X# attr.names --
X#
X# Returns a list of all attributes defined on the widget.
X#
X#
X# Results:
X# XXX
X#
X# Side effects:
X# XXX
X#
X# --------------------------------------------------------------
Xproc attr.names {wname} {
X global widgetAttr
X set names ""
X foreach attr $widgetAttr($wname) {
X lappend names [lindex $attr 0]
X }
X return $names
X}
X
Xproc SetupNonTkAttrs {w} {
X global widgetAttr
X set widgetAttr($w) ""
X}
X
Xproc DupNonTkAttrs {new old} {
X global widgetAttr
X
X set widgetAttr($new) $widgetAttr($old)
X}
X
X
X
X
X
END_OF_FILE
if test 1406 -ne `wc -c <'pip/src/Attrs'`; then
echo shar: \"'pip/src/Attrs'\" unpacked with wrong size!
fi
# end of 'pip/src/Attrs'
fi
if test -f 'pip/src/Callback' -a "${1}" != "-c" ; then
echo shar: Will not clobber existing file \"'pip/src/Callback'\"
else
echo shar: Extracting \"'pip/src/Callback'\" \(232 characters\)
sed "s/^X//" >'pip/src/Callback' <<'END_OF_FILE'
X# Not this simple to set callbacks, so don't do it.
X# If you have to, look at callback.set in CallbackEdit
X#
X#proc SetCallback {w value} {
X# attr.set $w callback $value;
X#}
X
Xproc GetCallback {w} {
X return [attr.get $w callback];
X}
X
END_OF_FILE
if test 232 -ne `wc -c <'pip/src/Callback'`; then
echo shar: \"'pip/src/Callback'\" unpacked with wrong size!
fi
# end of 'pip/src/Callback'
fi
if test -f 'pip/src/CheckButton' -a "${1}" != "-c" ; then
echo shar: Will not clobber existing file \"'pip/src/CheckButton'\"
else
echo shar: Extracting \"'pip/src/CheckButton'\" \(200 characters\)
sed "s/^X//" >'pip/src/CheckButton' <<'END_OF_FILE'
X# routines to manage checkbuttons
X
Xproc InitSavedCheckButton {w} {
X bind.simple $w
X
X # do non-tk attributes here
X}
X
Xproc InitRuntimeCheckButton {w} {
X
X # do non-tk attributes here
X bind.callback $w
X}
END_OF_FILE
if test 200 -ne `wc -c <'pip/src/CheckButton'`; then
echo shar: \"'pip/src/CheckButton'\" unpacked with wrong size!
fi
# end of 'pip/src/CheckButton'
fi
if test -f 'pip/src/Frame' -a "${1}" != "-c" ; then
echo shar: Will not clobber existing file \"'pip/src/Frame'\"
else
echo shar: Extracting \"'pip/src/Frame'\" \(374 characters\)
sed "s/^X//" >'pip/src/Frame' <<'END_OF_FILE'
X# Frame -- code for inserting a widget into a new frame and modifying
X# frames
X
Xsource bind.extra
Xsource UIB.Utils
X#############################################
X##
X## Public
X##
X#############################################
Xproc InitSavedFrame {w} {
X bind.frame $w
X
X # do nontk attributes here
X}
X
Xproc InitRuntimeFrame {w} {
X
X # do non-tk attributes here
X bind.callback $w
X}
END_OF_FILE
if test 374 -ne `wc -c <'pip/src/Frame'`; then
echo shar: \"'pip/src/Frame'\" unpacked with wrong size!
fi
# end of 'pip/src/Frame'
fi
if test -f 'pip/src/Label' -a "${1}" != "-c" ; then
echo shar: Will not clobber existing file \"'pip/src/Label'\"
else
echo shar: Extracting \"'pip/src/Label'\" \(182 characters\)
sed "s/^X//" >'pip/src/Label' <<'END_OF_FILE'
X# routines to manage labels
X
Xproc InitSavedLabel {w} {
X bind.simple $w
X
X # do non-tk attributes here
X}
X
Xproc InitRuntimeLabel {w} {
X
X # do non-tk attributes here
X bind.callback $w
X}
END_OF_FILE
if test 182 -ne `wc -c <'pip/src/Label'`; then
echo shar: \"'pip/src/Label'\" unpacked with wrong size!
fi
# end of 'pip/src/Label'
fi
if test -f 'pip/src/ListBox' -a "${1}" != "-c" ; then
echo shar: Will not clobber existing file \"'pip/src/ListBox'\"
else
echo shar: Extracting \"'pip/src/ListBox'\" \(476 characters\)
sed "s/^X//" >'pip/src/ListBox' <<'END_OF_FILE'
X# stuff to implement the scrolling list box thingy
X
Xproc InitSavedListBox {w} {
X set ents [attr.get $w entries]
X set count 0
X
X bind.listbox $w
X
X foreach e $ents {
X puts stdout "$count -- $e"
X $w insert $count $e
X incr count
X }
X
X}
X
Xproc InitNewListbox {w} {
X set ents [attr.get $w entries]
X set count 0
X
X foreach e $ents {
X puts stdout "$count -- $e"
X $w insert $count $e
X incr count
X }
X
X}
X
Xproc InitRuntimeListbox {w} {
X
X # do non-tk attributes here
X bind.callback $w
X}
END_OF_FILE
if test 476 -ne `wc -c <'pip/src/ListBox'`; then
echo shar: \"'pip/src/ListBox'\" unpacked with wrong size!
fi
# end of 'pip/src/ListBox'
fi
if test -f 'pip/src/Message' -a "${1}" != "-c" ; then
echo shar: Will not clobber existing file \"'pip/src/Message'\"
else
echo shar: Extracting \"'pip/src/Message'\" \(189 characters\)
sed "s/^X//" >'pip/src/Message' <<'END_OF_FILE'
X# routines to manage messages
X
Xproc InitSavedMessage {w} {
X bind.simple $w
X
X # do non-tk attributes here
X}
X
Xproc InitRuntimeMessage {w} {
X
X # do non-tk attributes here
X bind.callback $w
X
X}
END_OF_FILE
if test 189 -ne `wc -c <'pip/src/Message'`; then
echo shar: \"'pip/src/Message'\" unpacked with wrong size!
fi
# end of 'pip/src/Message'
fi
if test -f 'pip/src/RadioButton' -a "${1}" != "-c" ; then
echo shar: Will not clobber existing file \"'pip/src/RadioButton'\"
else
echo shar: Extracting \"'pip/src/RadioButton'\" \(201 characters\)
sed "s/^X//" >'pip/src/RadioButton' <<'END_OF_FILE'
X# routines to manage Radio buttons
X
Xproc InitSavedRadioButton {w} {
X bind.simple $w
X
X # do non-tk attributes here
X}
X
Xproc InitRuntimeRadioButton {w} {
X
X # do non-tk attributes here
X bind.callback $w
X}
END_OF_FILE
if test 201 -ne `wc -c <'pip/src/RadioButton'`; then
echo shar: \"'pip/src/RadioButton'\" unpacked with wrong size!
fi
# end of 'pip/src/RadioButton'
fi
if test -f 'pip/src/Scrollbar' -a "${1}" != "-c" ; then
echo shar: Will not clobber existing file \"'pip/src/Scrollbar'\"
else
echo shar: Extracting \"'pip/src/Scrollbar'\" \(194 characters\)
sed "s/^X//" >'pip/src/Scrollbar' <<'END_OF_FILE'
X# routines to manage scrollbars
X
Xproc InitSavedScrollbar {w} {
X bind.simple $w
X
X # do non-tk attributes here
X}
X
Xproc InitRuntimeScrollbar {w} {
X
X # do non-tk attributes here
X bind.callback $w
X}
END_OF_FILE
if test 194 -ne `wc -c <'pip/src/Scrollbar'`; then
echo shar: \"'pip/src/Scrollbar'\" unpacked with wrong size!
fi
# end of 'pip/src/Scrollbar'
fi
if test -f 'pip/src/UIB.Utils' -a "${1}" != "-c" ; then
echo shar: Will not clobber existing file \"'pip/src/UIB.Utils'\"
else
echo shar: Extracting \"'pip/src/UIB.Utils'\" \(46 characters\)
sed "s/^X//" >'pip/src/UIB.Utils' <<'END_OF_FILE'
X#$Id#
X#UIB.Utils -- helpful little functions
X
END_OF_FILE
if test 46 -ne `wc -c <'pip/src/UIB.Utils'`; then
echo shar: \"'pip/src/UIB.Utils'\" unpacked with wrong size!
fi
# end of 'pip/src/UIB.Utils'
fi
if test -f 'pip/src/bind.extra' -a "${1}" != "-c" ; then
echo shar: Will not clobber existing file \"'pip/src/bind.extra'\"
else
echo shar: Extracting \"'pip/src/bind.extra'\" \(934 characters\)
sed "s/^X//" >'pip/src/bind.extra' <<'END_OF_FILE'
X# super duper extra bindings
X
Xproc bind.simple args {
X foreach w $args {
X bind.Move $w
X bind.WidgetMenu $w
X }
X}
X
Xproc bind.listbox args {
X puts stdout "Yo!"
X foreach w $args {
X bind.Move $w
X bind.WidgetMenu $w
X# attr.set $w entries {Listbox}
X# ListBoxInsertEntry $w 0 Listbox
X }
X}
X
X
X# --------------------------------------------------------------
X# FUNCTION -- bind.callback
X#
X# Description
X# For each of the passed widgets, go through its callback
X# attribute and call bind. NOTE: we put a + before the
X# function name so that e.g. one can have taborder AND have
X# a tab key callback.
X#
X# Results:
X#
X# Side effects:
X#
X# --------------------------------------------------------------
X
Xproc bind.callback args {
X
X foreach w $args {
X
X set cbs [attr.get $w callback]
X set num [llength $cbs]
X set i 0
X
X while {$i < $num} {
X bind $w [lindex $cbs $i] +[lindex $cbs [expr {$i + 1}]]
X incr i 2
X }
X
X }
X}
END_OF_FILE
if test 934 -ne `wc -c <'pip/src/bind.extra'`; then
echo shar: \"'pip/src/bind.extra'\" unpacked with wrong size!
fi
# end of 'pip/src/bind.extra'
fi
if test -f 'pip/src/bind.std' -a "${1}" != "-c" ; then
echo shar: Will not clobber existing file \"'pip/src/bind.std'\"
else
echo shar: Extracting \"'pip/src/bind.std'\" \(4785 characters\)
sed "s/^X//" >'pip/src/bind.std' <<'END_OF_FILE'
X#$Id: bind.std,v 1.3 1992/04/13 14:48:14 clarsen Exp $
X
Xsource Attrs
Xsource Callback
X
Xproc bind.entry args {
X global NameMap
X foreach w $args {
X bind $w <Any-KeyPress> {%W insert cursor %A}
X bind $w <2> {puts stdout "character [%W index @%x]"}
X bind $w <Delete> {bs %W}
X bind $w <BackSpace> {bs %W}
X bind $w <Control-h> {bs %W}
X bind $w <1> {%W cursor @%x; focus %W; %W select from @%x}
X bind $w <B1-Motion> {%W select to @%x}
X bind $w <Shift-1> {%W select adjust @%x}
X bind $w <Shift-B1-Motion> {%W select to @%x}
X bind $w <3> {%W scan mark %x}
X bind $w <B3-Motion> {%W scan dragto %x}
X bind $w <Control-d> {%W delete sel.first sel.last}
X bind $w <Control-v> {%W insert cursor [selection get]}
X bind $w <Control-Button-2> {rpl %W}
X bind $w <Control-u> {%W delete 0 end}
X bind $w <Control-u> {%W delete 0 end}
X bind $w <Control-v> {%W insert cursor [selection.get]; view2cursor %W}
X bind $w <Control-Mod1-d> {%W delete sel.first sel.last; view2cursor %W}
X bind $w <Control-d> {%W delete cursor; view2cursor %W}
X bind $w <Control-l> {view2cursor %W}
X bind $w <Control-k> {%W delete cursor end; view2cursor %W}
X bind $w <Control-Mod1-h> {%W delete 0 cursor; %W view cursor}
X bind $w <Control-Mod1-Delete> {%W delete 0 cursor; %W view 0 }
X bind $w <Mod1-Delete> {%W delete 0 cursor; %W view 0 }
X bind $w <Control-Mod1-BackSpace> {%W delete 0 cursor; %W view 0}
X bind $w <Mod1-BackSpace> {%W delete 0 cursor; %W view 0}
X bind $w <Control-e> {%W cursor end; view2cursor %W}
X bind $w <Control-a> {%W cursor 0; %W view 0}
X bind $w <Control-f> {%W cursor [expr [%W index cursor]+1]; view2cursor %W }
X bind $w <Control-b> {%W cursor [expr [%W index cursor]-1]; view2cursor %W }
X bind $w <Right> {%W cursor [expr [%W index cursor]+1]; view2cursor %W }
X bind $w <Left> {%W cursor [expr [%W index cursor]-1]; view2cursor %W }
X bind $w <space> {%W insert cursor " "; view2cursor %W}
X bind $w <Any-Key> {%W insert cursor "%A"; view2cursor %W}
X }
X if [catch {set cbname [GetCallback $w]}]==1 {
X set cbname ""
X }
X if {[string compare $cbname ""]==0} {
X set cbname cberror
X }
X regexp {^(\.[^\.]+)\..*} $w mvar formId
X#XXX: requires knowledge of keyed list form
X set wName "unknown"
X catch {
X foreach pair $NameMap($formId) {
X if {[string compare [lindex $pair 1] $w]==0} {
X set wName [lindex $pair 0]
X break
X }
X }}
X bind $w <Return> "$cbname $formId $wName Return"
X}
X
Xproc view2cursor { win} {
X set left_extent [$win index @0]
X set right_extent [$win index @[winfo width $win]]
X set cursor_position [$win index cursor]
X set entry_length [expr "$right_extent - $left_extent"]
X if {$cursor_position > $left_extent} {
X if {$cursor_position > $right_extent} {
X #handle cursor too far to the right
X $win view [expr "$cursor_position - $entry_length + 1"]
X }
X } {
X #handle cursor too far to the left
X $win view [expr "$cursor_position - 1"]
X }
X}
X
Xproc rpl { win} {
X set x [selection.get]
X $win delete 0 end;
X $win insert cursor $x
X}
X
Xproc selection.get {} {if {[catch {selection get} s]} {return ""} {return $s}}
X
Xproc bind.menu args {
X foreach w $args {
X bind $w <Any-Enter> "$w activate @%y"
X bind $w <Any-Leave> "$w activate none"
X bind $w <Any-Motion> "$w activate @%y"
X bind $w <ButtonRelease-1> "$w invoke active"
X }
X}
X
Xproc bind.menubutton args {
X foreach w $args {
X bind $w <Enter> "$w activate"
X bind $w <B1-Enter> "$w activate; $w config -relief sunken; $w post"
X bind $w <B1-Leave> "$w deactivate; $w config -relief flat"
X bind $w <Shift-B1-Leave> "$w deactivate; $w config -relief flat"
X bind $w <Leave> "$w deactivate"
X bind $w <1> "$w config -relief sunken; $w post"
X bind $w <Shift-1> "$w.m post %X %Y"
X bind $w <ButtonRelease-1> "$w config -relief flat; $w unpost"
X bind $w <Shift-B1-Motion> "$w.m post %X %Y"
X }
X}
X
Xproc bs win {
X set x [expr {[$win index cursor] - 1}]
X if {$x != -1} {$win delete $x}
X view2cursor $win
X}
X
Xproc cberror {formId fieldName eventName} {
X puts stdout "callback: $formId $fieldName $eventName"
X}
X
Xproc bind.button w {
X global NameMap
X set cbname [GetCallback $w]
X if {[string compare $cbname ""]==0} {
X set cbname cberror
X }
X regexp {^(\.[^\.]+)\..*} $w mvar formId
X#XXX: requires knowledge of keyed list form
X set wName "unknown"
X catch {
X foreach pair $NameMap($formId) {
X if {[string compare [lindex $pair 1] $w]==0} {
X set wName [lindex $pair 0]
X break
X }
X }}
X $w config -command "$cbname $formId $wName ButtonPress"
X}
X
END_OF_FILE
if test 4785 -ne `wc -c <'pip/src/bind.std'`; then
echo shar: \"'pip/src/bind.std'\" unpacked with wrong size!
fi
# end of 'pip/src/bind.std'
fi
if test -f 'pip/src/SAMPLE/Palette.CheckButtons.Tcl' -a "${1}" != "-c" ; then
echo shar: Will not clobber existing file \"'pip/src/SAMPLE/Palette.CheckButtons.Tcl'\"
else
echo shar: Extracting \"'pip/src/SAMPLE/Palette.CheckButtons.Tcl'\" \(2434 characters\)
sed "s/^X//" >'pip/src/SAMPLE/Palette.CheckButtons.Tcl' <<'END_OF_FILE'
Xpipsource bind.std
Xpipsource bind.extra
Xkeylset NameMap(.) root .
Xproc Palette.CheckButtons.Create {w} {
X global widgetAttr NameMap
X# wm geometry $w 300x200+111+158
X# wm maxsize $w 1000 1000
X# bind.toplevel $w
X frame $w.Frame59 -borderwidth 2 -geometry 119x27 -relief sunken
X set widgetAttr($w.Frame59) {}
X InitRuntimeFrame $w.Frame59
X pack append $w $w.Frame59 {top frame center}
X frame $w.Frame59.Frame125 -borderwidth 1 -geometry 20x20 -relief sunken
X set widgetAttr($w.Frame59.Frame125) {}
X InitRuntimeFrame $w.Frame59.Frame125
X message $w.Frame59.Message63 -aspect 600 -background #c5b2ff -justify center -padx 17 -pady 1 -relief raised -text "Check Buttons"
X set widgetAttr($w.Frame59.Message63) {}
X InitRuntimeMessage $w.Frame59.Message63
X pack append $w.Frame59 $w.Frame59.Message63 {top frame w fillx} $w.Frame59.Frame125 {top frame center pady 14}
X checkbutton $w.Frame59.Frame125.CheckButton134 -text Raised -variable check2
X set widgetAttr($w.Frame59.Frame125.CheckButton134) {{commandType tcl} {permissionFuncType tcl} {permissionFunc {}} {name raisedcheck}}
X keylset NameMap($w) raisedcheck $w.Frame59.Frame125.CheckButton134
X InitRuntimeCheckButton $w.Frame59.Frame125.CheckButton134
X checkbutton $w.Frame59.Frame125.CheckButton131 -relief flat -text Flat -variable check0
X set widgetAttr($w.Frame59.Frame125.CheckButton131) {{commandType tcl} {permissionFuncType tcl} {permissionFunc {}} {name flatcheck}}
X keylset NameMap($w) flatcheck $w.Frame59.Frame125.CheckButton131
X InitRuntimeCheckButton $w.Frame59.Frame125.CheckButton131
X checkbutton $w.Frame59.Frame125.CheckButton128 -relief sunken -text Sunken -variable check1
X set widgetAttr($w.Frame59.Frame125.CheckButton128) {{commandType tcl} {permissionFuncType tcl} {permissionFunc {}} {name sunkencheck}}
X keylset NameMap($w) sunkencheck $w.Frame59.Frame125.CheckButton128
X InitRuntimeCheckButton $w.Frame59.Frame125.CheckButton128
X pack append $w.Frame59.Frame125 $w.Frame59.Frame125.CheckButton128 {left frame center} $w.Frame59.Frame125.CheckButton131 {left frame center} $w.Frame59.Frame125.CheckButton134 {left frame center}
X}
X
Xproc UIL.Rebuild {w} {
X Palette.CheckButtons.Create $w
X InitSavedFrame $w.Frame59
X InitSavedFrame $w.Frame59.Frame125
X InitSavedCheckButton $w.Frame59.Frame125.CheckButton134
X InitSavedCheckButton $w.Frame59.Frame125.CheckButton131
X InitSavedCheckButton $w.Frame59.Frame125.CheckButton128
X InitSavedMessage $w.Frame59.Message63
X}
END_OF_FILE
if test 2434 -ne `wc -c <'pip/src/SAMPLE/Palette.CheckButtons.Tcl'`; then
echo shar: \"'pip/src/SAMPLE/Palette.CheckButtons.Tcl'\" unpacked with wrong size!
fi
# end of 'pip/src/SAMPLE/Palette.CheckButtons.Tcl'
fi
if test -f 'pip/src/SAMPLE/Palette.Labels.Tcl' -a "${1}" != "-c" ; then
echo shar: Will not clobber existing file \"'pip/src/SAMPLE/Palette.Labels.Tcl'\"
else
echo shar: Extracting \"'pip/src/SAMPLE/Palette.Labels.Tcl'\" \(2009 characters\)
sed "s/^X//" >'pip/src/SAMPLE/Palette.Labels.Tcl' <<'END_OF_FILE'
Xpipsource bind.std
Xpipsource bind.extra
Xkeylset NameMap(.) root .
Xproc Palette.Labels.Create {w} {
X global widgetAttr NameMap
X# wm geometry $w 147x54+97+204
X# wm maxsize $w
X# bind.toplevel $w
X frame $w.Frame17 -borderwidth 2 -geometry 96x30 -relief sunken
X set widgetAttr($w.Frame17) {}
X InitRuntimeFrame $w.Frame17
X pack append $w $w.Frame17 {top frame center}
X frame $w.Frame17.Frame156 -borderwidth 2 -geometry 20x20 -relief sunken
X set widgetAttr($w.Frame17.Frame156) {}
X InitRuntimeFrame $w.Frame17.Frame156
X message $w.Frame17.Message18 -aspect 437 -background #c5b2ff -justify center -padx 17 -pady 1 -relief raised -text Labels
X set widgetAttr($w.Frame17.Message18) {}
X InitRuntimeMessage $w.Frame17.Message18
X pack append $w.Frame17 $w.Frame17.Message18 {top frame n fillx} $w.Frame17.Frame156 {top frame s pady 6 fillx}
X label $w.Frame17.Frame156.Label167 -relief raised -text Raised
X set widgetAttr($w.Frame17.Frame156.Label167) {{name raisedlabel}}
X keylset NameMap($w) raisedlabel $w.Frame17.Frame156.Label167
X InitRuntimeLabel $w.Frame17.Frame156.Label167
X label $w.Frame17.Frame156.Label164 -relief sunken -text Sunken
X set widgetAttr($w.Frame17.Frame156.Label164) {{name sunkenlabel}}
X keylset NameMap($w) sunkenlabel $w.Frame17.Frame156.Label164
X InitRuntimeLabel $w.Frame17.Frame156.Label164
X label $w.Frame17.Frame156.Label161 -text Flat
X set widgetAttr($w.Frame17.Frame156.Label161) {{name flatlabel}}
X keylset NameMap($w) flatlabel $w.Frame17.Frame156.Label161
X InitRuntimeLabel $w.Frame17.Frame156.Label161
X pack append $w.Frame17.Frame156 $w.Frame17.Frame156.Label161 {left frame center} $w.Frame17.Frame156.Label164 {left frame center padx 14} $w.Frame17.Frame156.Label167 {left frame center}
X}
X
Xproc UIL.Rebuild {w} {
X Palette.Labels.Create $w
X InitSavedFrame $w.Frame17
X InitSavedFrame $w.Frame17.Frame156
X InitSavedLabel $w.Frame17.Frame156.Label167
X InitSavedLabel $w.Frame17.Frame156.Label164
X InitSavedLabel $w.Frame17.Frame156.Label161
X InitSavedMessage $w.Frame17.Message18
X}
END_OF_FILE
if test 2009 -ne `wc -c <'pip/src/SAMPLE/Palette.Labels.Tcl'`; then
echo shar: \"'pip/src/SAMPLE/Palette.Labels.Tcl'\" unpacked with wrong size!
fi
# end of 'pip/src/SAMPLE/Palette.Labels.Tcl'
fi
if test -f 'pip/src/SAMPLE/Palette.ListBoxes.Tcl' -a "${1}" != "-c" ; then
echo shar: Will not clobber existing file \"'pip/src/SAMPLE/Palette.ListBoxes.Tcl'\"
else
echo shar: Extracting \"'pip/src/SAMPLE/Palette.ListBoxes.Tcl'\" \(3294 characters\)
sed "s/^X//" >'pip/src/SAMPLE/Palette.ListBoxes.Tcl' <<'END_OF_FILE'
Xpipsource bind.std
Xpipsource bind.extra
Xkeylset NameMap(.) root .
Xproc Palette.ListBoxes.Create {w} {
X global widgetAttr NameMap
X# wm geometry $w 144x129+143+234
X# wm maxsize $w
X# bind.toplevel $w
X frame $w.Frame44 -borderwidth 2 -geometry 82x71 -relief sunken
X set widgetAttr($w.Frame44) {}
X InitRuntimeFrame $w.Frame44
X pack append $w $w.Frame44 {top frame center}
X frame $w.Frame44.Frame198 -borderwidth 2 -geometry 20x20 -relief sunken
X set widgetAttr($w.Frame44.Frame198) {}
X InitRuntimeFrame $w.Frame44.Frame198
X message $w.Frame44.Message51 -aspect 573 -background #c5b2ff -justify center -padx 17 -pady 1 -relief raised -text "List Boxes"
X set widgetAttr($w.Frame44.Message51) {}
X InitRuntimeMessage $w.Frame44.Message51
X pack append $w.Frame44 $w.Frame44.Message51 {top frame n fillx} $w.Frame44.Frame198 {top frame s pady 5}
X frame $w.Frame44.Frame198.Frame208 -borderwidth 3 -relief sunken
X set widgetAttr($w.Frame44.Frame198.Frame208) {{name listboxleftbar}}
X keylset NameMap($w) listboxleftbar $w.Frame44.Frame198.Frame208
X InitRuntimeFrame $w.Frame44.Frame198.Frame208
X frame $w.Frame44.Frame198.Frame203 -borderwidth 3 -relief sunken
X set widgetAttr($w.Frame44.Frame198.Frame203) {{name listboxrightbar}}
X keylset NameMap($w) listboxrightbar $w.Frame44.Frame198.Frame203
X InitRuntimeFrame $w.Frame44.Frame198.Frame203
X pack append $w.Frame44.Frame198 $w.Frame44.Frame198.Frame203 {top frame center pady 8} $w.Frame44.Frame198.Frame208 {top frame center}
X scrollbar $w.Frame44.Frame198.Frame208.Scrollbar210 -command "$w.Frame44.Frame198.Frame208.Listbox209 view"
X set widgetAttr($w.Frame44.Frame198.Frame208.Scrollbar210) {}
X InitRuntimeScrollbar $w.Frame44.Frame198.Frame208.Scrollbar210
X listbox $w.Frame44.Frame198.Frame208.Listbox209 -geometry 10x2 -relief raised -scrollcommand "$w.Frame44.Frame198.Frame208.Scrollbar210 set"
X set widgetAttr($w.Frame44.Frame198.Frame208.Listbox209) {}
X InitRuntimeListbox $w.Frame44.Frame198.Frame208.Listbox209
X pack append $w.Frame44.Frame198.Frame208 $w.Frame44.Frame198.Frame208.Listbox209 {right frame center} $w.Frame44.Frame198.Frame208.Scrollbar210 {left frame center filly}
X scrollbar $w.Frame44.Frame198.Frame203.Scrollbar205 -command "$w.Frame44.Frame198.Frame203.Listbox204 view"
X set widgetAttr($w.Frame44.Frame198.Frame203.Scrollbar205) {}
X InitRuntimeScrollbar $w.Frame44.Frame198.Frame203.Scrollbar205
X listbox $w.Frame44.Frame198.Frame203.Listbox204 -geometry 10x2 -relief raised -scrollcommand "$w.Frame44.Frame198.Frame203.Scrollbar205 set"
X set widgetAttr($w.Frame44.Frame198.Frame203.Listbox204) {}
X InitRuntimeListbox $w.Frame44.Frame198.Frame203.Listbox204
X pack append $w.Frame44.Frame198.Frame203 $w.Frame44.Frame198.Frame203.Listbox204 {left frame center} $w.Frame44.Frame198.Frame203.Scrollbar205 {left frame center filly}
X}
X
Xproc UIL.Rebuild {w} {
X Palette.ListBoxes.Create $w
X InitSavedFrame $w.Frame44
X InitSavedFrame $w.Frame44.Frame198
X InitSavedFrame $w.Frame44.Frame198.Frame208
X InitSavedScrollbar $w.Frame44.Frame198.Frame208.Scrollbar210
X InitSavedListBox $w.Frame44.Frame198.Frame208.Listbox209
X InitSavedFrame $w.Frame44.Frame198.Frame203
X InitSavedScrollbar $w.Frame44.Frame198.Frame203.Scrollbar205
X InitSavedListBox $w.Frame44.Frame198.Frame203.Listbox204
X InitSavedMessage $w.Frame44.Message51
X}
END_OF_FILE
if test 3294 -ne `wc -c <'pip/src/SAMPLE/Palette.ListBoxes.Tcl'`; then
echo shar: \"'pip/src/SAMPLE/Palette.ListBoxes.Tcl'\" unpacked with wrong size!
fi
# end of 'pip/src/SAMPLE/Palette.ListBoxes.Tcl'
fi
if test -f 'pip/src/SAMPLE/Palette.Messages.Tcl' -a "${1}" != "-c" ; then
echo shar: Will not clobber existing file \"'pip/src/SAMPLE/Palette.Messages.Tcl'\"
else
echo shar: Extracting \"'pip/src/SAMPLE/Palette.Messages.Tcl'\" \(2083 characters\)
sed "s/^X//" >'pip/src/SAMPLE/Palette.Messages.Tcl' <<'END_OF_FILE'
Xpipsource bind.std
Xpipsource bind.extra
Xkeylset NameMap(.) root .
Xproc Palette.Messages.Create {w} {
X global widgetAttr NameMap
X# wm geometry $w 120x123+126+266
X# wm maxsize $w
X# bind.toplevel $w
X frame $w.Frame29 -borderwidth 2 -geometry 77x111 -relief sunken
X set widgetAttr($w.Frame29) {}
X InitRuntimeFrame $w.Frame29
X pack append $w $w.Frame29 {top frame center}
X frame $w.Frame29.Frame223 -borderwidth 2 -geometry 20x20 -relief sunken
X set widgetAttr($w.Frame29.Frame223) {}
X InitRuntimeFrame $w.Frame29.Frame223
X message $w.Frame29.Message30 -justify left -padx 5 -pady 12 -text Flat
X set widgetAttr($w.Frame29.Message30) {{name flatmsg}}
X keylset NameMap($w) flatmsg $w.Frame29.Message30
X InitRuntimeMessage $w.Frame29.Message30
X message $w.Frame29.Message33 -aspect 587 -background #c5b2ff -justify center -padx 17 -pady 1 -relief raised -text Messages
X set widgetAttr($w.Frame29.Message33) {}
X InitRuntimeMessage $w.Frame29.Message33
X pack append $w.Frame29 $w.Frame29.Message33 {top frame n fillx} $w.Frame29.Frame223 {top frame center pady 11} $w.Frame29.Message30 {top frame center}
X message $w.Frame29.Frame223.Message229 -justify left -padx 5 -pady 12 -relief sunken -text Sunken
X set widgetAttr($w.Frame29.Frame223.Message229) {{name sunkenmsg}}
X keylset NameMap($w) sunkenmsg $w.Frame29.Frame223.Message229
X InitRuntimeMessage $w.Frame29.Frame223.Message229
X message $w.Frame29.Frame223.Message226 -justify left -padx 5 -pady 12 -relief raised -text Raised
X set widgetAttr($w.Frame29.Frame223.Message226) {{name raisedmsg}}
X keylset NameMap($w) raisedmsg $w.Frame29.Frame223.Message226
X InitRuntimeMessage $w.Frame29.Frame223.Message226
X pack append $w.Frame29.Frame223 $w.Frame29.Frame223.Message226 {left frame center} $w.Frame29.Frame223.Message229 {top frame center}
X}
X
Xproc UIL.Rebuild {w} {
X Palette.Messages.Create $w
X InitSavedFrame $w.Frame29
X InitSavedFrame $w.Frame29.Frame223
X InitSavedMessage $w.Frame29.Frame223.Message229
X InitSavedMessage $w.Frame29.Frame223.Message226
X InitSavedMessage $w.Frame29.Message30
X InitSavedMessage $w.Frame29.Message33
X}
END_OF_FILE
if test 2083 -ne `wc -c <'pip/src/SAMPLE/Palette.Messages.Tcl'`; then
echo shar: \"'pip/src/SAMPLE/Palette.Messages.Tcl'\" unpacked with wrong size!
fi
# end of 'pip/src/SAMPLE/Palette.Messages.Tcl'
fi
if test -f 'pip/src/SAMPLE/Palette.RadioButtons.Tcl' -a "${1}" != "-c" ; then
echo shar: Will not clobber existing file \"'pip/src/SAMPLE/Palette.RadioButtons.Tcl'\"
else
echo shar: Extracting \"'pip/src/SAMPLE/Palette.RadioButtons.Tcl'\" \(1963 characters\)
sed "s/^X//" >'pip/src/SAMPLE/Palette.RadioButtons.Tcl' <<'END_OF_FILE'
Xpipsource bind.std
Xpipsource bind.extra
Xkeylset NameMap(.) root .
Xproc Palette.RadioButtons.Create {w} {
X global widgetAttr NameMap
X# wm geometry $w 300x200+271+214
X# wm maxsize $w 1000 1000
X# bind.toplevel $w
X frame $w.Frame71 -borderwidth 2 -geometry 4x67 -relief sunken
X set widgetAttr($w.Frame71) {}
X InitRuntimeFrame $w.Frame71
X pack append $w $w.Frame71 {top frame center}
X message $w.Frame71.Message75 -aspect 437 -background #c5b2ff -justify center -padx 17 -pady 1 -relief raised -text "Radio Buttons"
X set widgetAttr($w.Frame71.Message75) {}
X InitRuntimeMessage $w.Frame71.Message75
X radiobutton $w.Frame71.RadioButton74 -relief sunken -text Sunken -value sunken
X set widgetAttr($w.Frame71.RadioButton74) {{commandType tcl} {permissionFuncType tcl} {permissionFunc {}} {name sunkenradio}}
X keylset NameMap($w) sunkenradio $w.Frame71.RadioButton74
X InitRuntimeRadioButton $w.Frame71.RadioButton74
X radiobutton $w.Frame71.RadioButton73 -relief flat -text Flat -value flat
X set widgetAttr($w.Frame71.RadioButton73) {{commandType tcl} {permissionFuncType tcl} {permissionFunc {}} {name flatradio}}
X keylset NameMap($w) flatradio $w.Frame71.RadioButton73
X InitRuntimeRadioButton $w.Frame71.RadioButton73
X radiobutton $w.Frame71.RadioButton72 -text Raised -value raised
X set widgetAttr($w.Frame71.RadioButton72) {{commandType tcl} {permissionFuncType tcl} {permissionFunc {}} {name raisedradio}}
X keylset NameMap($w) raisedradio $w.Frame71.RadioButton72
X InitRuntimeRadioButton $w.Frame71.RadioButton72
X pack append $w.Frame71 $w.Frame71.Message75 {top frame center} $w.Frame71.RadioButton74 {top frame sw pady 3} $w.Frame71.RadioButton73 {top frame w} $w.Frame71.RadioButton72 {top frame w}
X}
X
Xproc UIL.Rebuild {w} {
X Palette.RadioButtons.Create $w
X InitSavedFrame $w.Frame71
X InitSavedMessage $w.Frame71.Message75
X InitSavedRadioButton $w.Frame71.RadioButton74
X InitSavedRadioButton $w.Frame71.RadioButton73
X InitSavedRadioButton $w.Frame71.RadioButton72
X}
END_OF_FILE
if test 1963 -ne `wc -c <'pip/src/SAMPLE/Palette.RadioButtons.Tcl'`; then
echo shar: \"'pip/src/SAMPLE/Palette.RadioButtons.Tcl'\" unpacked with wrong size!
fi
# end of 'pip/src/SAMPLE/Palette.RadioButtons.Tcl'
fi
if test -f 'pip/src/SAMPLE/Palette.TopLevel.Tcl' -a "${1}" != "-c" ; then
echo shar: Will not clobber existing file \"'pip/src/SAMPLE/Palette.TopLevel.Tcl'\"
else
echo shar: Extracting \"'pip/src/SAMPLE/Palette.TopLevel.Tcl'\" \(1660 characters\)
sed "s/^X//" >'pip/src/SAMPLE/Palette.TopLevel.Tcl' <<'END_OF_FILE'
Xpipsource bind.std
Xpipsource bind.extra
Xkeylset NameMap(.) root .
Xproc Palette.TopLevel.Create {w} {
X global widgetAttr NameMap
X# wm geometry $w 300x200+194+192
X# wm maxsize $w 1000 1000
X# bind.toplevel $w
X frame $w.Frame91 -borderwidth 1 -geometry 20x20 -relief sunken
X set widgetAttr($w.Frame91) {}
X InitRuntimeFrame $w.Frame91
X pack append $w $w.Frame91 {top frame w fillx}
X frame $w.Frame91.Frame97 -borderwidth 3 -relief sunken
X set widgetAttr($w.Frame91.Frame97) {}
X InitRuntimeFrame $w.Frame91.Frame97
X label $w.Frame91.Label94 -text Palette:
X set widgetAttr($w.Frame91.Label94) {}
X InitRuntimeLabel $w.Frame91.Label94
X pack append $w.Frame91 $w.Frame91.Label94 {left frame nw} $w.Frame91.Frame97 {top frame w}
X scrollbar $w.Frame91.Frame97.Scrollbar98 -command "$w.Frame91.Frame97.Listbox99 view"
X set widgetAttr($w.Frame91.Frame97.Scrollbar98) {}
X InitRuntimeScrollbar $w.Frame91.Frame97.Scrollbar98
X listbox $w.Frame91.Frame97.Listbox99 -geometry 10x4 -relief raised -scrollcommand "$w.Frame91.Frame97.Scrollbar98 set"
X set widgetAttr($w.Frame91.Frame97.Listbox99) {{entries {RadioButtons Messages ListBoxes Labels CheckButtons}} {name paletteList}}
X keylset NameMap($w) paletteList $w.Frame91.Frame97.Listbox99
X InitRuntimeListbox $w.Frame91.Frame97.Listbox99
X pack append $w.Frame91.Frame97 $w.Frame91.Frame97.Listbox99 {left frame center} $w.Frame91.Frame97.Scrollbar98 {left frame center filly}
X}
X
Xproc UIL.Rebuild {w} {
X Palette.TopLevel.Create $w
X InitSavedFrame $w.Frame91
X InitSavedFrame $w.Frame91.Frame97
X InitSavedListBox $w.Frame91.Frame97.Listbox99
X InitSavedScrollbar $w.Frame91.Frame97.Scrollbar98
X InitSavedLabel $w.Frame91.Label94
X}
END_OF_FILE
if test 1660 -ne `wc -c <'pip/src/SAMPLE/Palette.TopLevel.Tcl'`; then
echo shar: \"'pip/src/SAMPLE/Palette.TopLevel.Tcl'\" unpacked with wrong size!
fi
# end of 'pip/src/SAMPLE/Palette.TopLevel.Tcl'
fi
echo shar: End of shell archive.
exit 0
--Case Larsen
ctla...@lbl.gov