git.zerfleddert.de Git - micropolis/blob - src/tk/library/demos/rolodex

   1 #!/usr/local/bin/wish -f
   2 #
   3 # This script was written as an entry in Tom LaStrange's rolodex
   4 # benchmark.  It creates something that has some of the look and
   5 # feel of a rolodex program, although it's lifeless and doesn't
   6 # actually do the rolodex application.
   7
   8 foreach i [winfo child .] {
   9     catch {destroy $i}
  10 }
  11
  12 proc tkerror err {
  13     global errorInfo
  14     puts stdout "$errorInfo"
  15 }
  16
  17 #------------------------------------------
  18 # Phase 0: create the front end.
  19 #------------------------------------------
  20
  21 frame .frame -relief flat
  22 pack append . .frame {top filly frame center}
  23
  24 set names {{} Name: Address: {} {} {Home Phone:} {Work Phone:} Fax:}
  25 foreach i {1 2 3 4 5 6 7} {
  26     frame .frame.$i
  27     pack append .frame .frame.$i {top pady 4 frame e}
  28
  29     label .frame.$i.label -text [lindex $names $i] -anchor e
  30     entry .frame.$i.entry -width 30 -relief sunken
  31     pack append .frame.$i .frame.$i.entry right .frame.$i.label right
  32 }
  33
  34 frame .buttons
  35 pack append . .buttons {bottom pady 4 frame center}
  36 button .buttons.clear -text Clear
  37 button .buttons.add -text Add
  38 button .buttons.search -text Search
  39 button .buttons.delete -text "Delete ..."
  40 pack append .buttons .buttons.clear {left padx 4} \
  41     .buttons.add {left padx 4} .buttons.search {left padx 4} \
  42     .buttons.delete {left padx 4}
  43
  44 #------------------------------------------
  45 # Phase 1: Add menus, dialog boxes
  46 #------------------------------------------
  47
  48 frame .menu -relief raised -borderwidth 1
  49 pack before .frame .menu {top fillx}
  50
  51 menubutton .menu.file -text "File" -menu .menu.file.m
  52 menu .menu.file.m
  53 .menu.file.m add command -label "Load ..." -command fileAction
  54 .menu.file.m add command -label "Exit" -command {destroy .}
  55
  56 menubutton .menu.help -text "Help" -menu .menu.help.m
  57 menu .menu.help.m
  58
  59 pack append .menu .menu.file left .menu.help right
  60
  61 # The mkDialog procedure below was pirated from the widget demo.  It
  62 # was not written fresh for this benchmark.
  63
  64 # Create a dialog box.  Takes three or more arguments.  The first is
  65 # the name of the window to use for the dialog box.  The second is a set
  66 # of arguments for use in creating the message of the dialog box.  The
  67 # third and following arguments consist of two-element lists, each
  68 # describing one button.  The first element gives the text to be displayed
  69 # in the button, the second gives the command to be invoked when the
  70 # button is invoked.
  71
  72 proc mkDialog {w msgArgs args} {
  73     catch {destroy $w}
  74     toplevel $w -class Dialog
  75     set oldFocus [focus]
  76
  77     # Create two frames in the main window. The top frame will hold the
  78     # message and the bottom one will hold the buttons.  Arrange them
  79     # one above the other, with any extra vertical space split between
  80     # them.
  81
  82     frame $w.top -relief raised -border 1
  83     frame $w.bot -relief raised -border 1
  84     pack append $w $w.top {top fill expand} $w.bot {top fill expand}
  85
  86     # Create the message widget and arrange for it to be centered in the
  87     # top frame.
  88
  89     eval message $w.top.msg -justify center \
  90             -font -Adobe-times-medium-r-normal--*-180* $msgArgs
  91     pack append $w.top $w.top.msg {top expand padx 5 pady 5}
  92
  93     # Create as many buttons as needed and arrange them from left to right
  94     # in the bottom frame.  Embed the left button in an additional sunken
  95     # frame to indicate that it is the default button, and arrange for that
  96     # button to be invoked as the default action for clicks and returns in
  97     # the dialog.
  98
  99     if {[llength $args] > 0} {
 100         set arg [lindex $args 0]
 101         frame $w.bot.0 -relief sunken -border 1
 102         pack append $w.bot $w.bot.0 {left expand padx 20 pady 20}
 103         button $w.bot.0.button -text [lindex $arg 0] \
 104                 -command "[lindex $arg 1]; destroy $w; focus $oldFocus"
 105         pack append $w.bot.0 $w.bot.0.button {expand padx 12 pady 12}
 106         bind $w.top <Enter> "$w.bot.0.button activate"
 107         bind $w.top.msg <Enter> "$w.bot.0.button activate"
 108         bind $w.bot <Enter> "$w.bot.0.button activate"
 109         bind $w.top <Leave> "$w.bot.0.button deactivate"
 110         bind $w.top.msg <Leave> "$w.bot.0.button deactivate"
 111         bind $w.bot <Leave> "$w.bot.0.button deactivate"
 112         bind $w <1> "$w.bot.0.button config -relief sunken"
 113         bind $w <ButtonRelease-1> \
 114                 "[lindex $arg 1]; $w.bot.0.button deactivate; destroy $w; focus $oldFocus"
 115         bind $w <Return> "[lindex $arg 1]; destroy $w; focus $oldFocus"
 116         focus $w
 117
 118         set i 1
 119         foreach arg [lrange $args 1 end] {
 120             button $w.bot.$i -text [lindex $arg 0] \
 121                     -command "[lindex $arg 1]; destroy $w; focus $oldFocus"
 122             pack append $w.bot $w.bot.$i {left expand padx 20}
 123             set i [expr $i+1]
 124         }
 125     }
 126     wm geometry $w +300+350
 127 }
 128
 129 proc deleteAction {} {
 130     mkDialog .delete {-text "Are you sure?" -aspect 10000} \
 131             "OK clearAction" "Cancel {}"
 132 }
 133 .buttons.delete config -command deleteAction
 134
 135 proc fileAction {} {
 136     mkDialog .fileSelection {-text "This is a dummy file selection dialog box, which is used because there isn't a good file selection dialog built into Tk yet." -aspect 400} "OK {puts stderr {dummy file name}}"
 137 }
 138
 139 #------------------------------------------
 140 # Phase 3: Print contents of card
 141 #------------------------------------------
 142
 143 proc addAction {} {
 144     global names
 145     foreach i {1 2 3 4 5 6 7} {
 146         puts stderr [format "%-12s %s" [lindex $names $i] [.frame.$i.entry get]]
 147     }
 148 }
 149 .buttons.add config -command addAction
 150
 151 #------------------------------------------
 152 # Phase 4: Miscellaneous other actions
 153 #------------------------------------------
 154
 155 proc clearAction {} {
 156     foreach i {1 2 3 4 5 6 7} {
 157         .frame.$i.entry delete 0 end
 158     }
 159 }
 160 .buttons.clear config -command clearAction
 161
 162 proc fillCard {} {
 163     clearAction
 164     .frame.1.entry insert 0 "John Ousterhout"
 165     .frame.2.entry insert 0 "CS Division, Department of EECS"
 166     .frame.3.entry insert 0 "University of California"
 167     .frame.4.entry insert 0 "Berkeley, CA 94720"
 168     .frame.5.entry insert 0 "private"
 169     .frame.6.entry insert 0 "510-642-0865"
 170     .frame.7.entry insert 0 "510-642-5775"
 171 }
 172 .buttons.search config -command "addAction; fillCard"
 173
 174 #----------------------------------------------------
 175 # Phase 5: Accelerators, mnemonics, command-line info
 176 #----------------------------------------------------
 177
 178 .buttons.clear config -text "Clear    Ctrl+C"
 179 bind Entry <Control-c> clearAction
 180 .buttons.add config -text "Add    Ctrl+A"
 181 bind Entry <Control-a> addAction
 182 .buttons.search config -text "Search    Ctrl+S"
 183 bind Entry <Control-s> "addAction; fillCard"
 184 .buttons.delete config -text "Delete...    Ctrl+D"
 185 bind Entry <Control-d> deleteAction
 186
 187 .menu.file.m entryconfig 0 -accel Ctrl+F
 188 bind Entry <Control-f> fileAction
 189 .menu.file.m entryconfig 1 -accel Ctrl+Q
 190 bind Entry <Control-q> {destroy .}
 191
 192 focus .frame.1.entry
 193
 194 #----------------------------------------------------
 195 # Phase 6: help
 196 #----------------------------------------------------
 197
 198 proc Help {topic {x 0} {y 0}} {
 199     global helpTopics helpCmds
 200     if {$topic == ""} return
 201     while {[info exists helpCmds($topic)]} {
 202         set topic [eval $helpCmds($topic)]
 203     }
 204     if [info exists helpTopics($topic)] {
 205         set msg $helpTopics($topic)
 206     } else {
 207         set msg "Sorry, but no help is available for this topic"
 208     }
 209     mkDialog .help "-text {Information on $topic:\n\n$msg} -justify left -aspect 300" "OK {}"
 210 }
 211
 212 proc getMenuTopic {w x y} {
 213     return $w.[$w index @[expr $y-[winfo rooty $w]]]
 214 }
 215
 216 bind Entry <Any-F1> {Help [winfo containing %X %Y] %X %Y}
 217 bind Entry <Any-Help> {Help [winfo containing %X %Y] %X %Y}
 218
 219 # Help text and commands follow:
 220
 221 set helpTopics(.menu.file) {This is the "file" menu.  It can be used to invoke some overall operations on the rolodex applications, such as loading a file or exiting.}
 222
 223 set helpCmds(.menu.file.m) {getMenuTopic $topic $x $y}
 224 set helpTopics(.menu.file.m.0) {The "Load" entry in the "File" menu posts a dialog box that you can use to select a rolodex file}
 225 set helpTopics(.menu.file.m.1) {The "Exit" entry in the "File" menu causes the rolodex application to terminate}
 226 set helpCmds(.menu.file.m.none) {set topic ".menu.file"}
 227
 228 set helpTopics(.frame.1.entry) {In this field of the rolodex entry you should type the person's name}
 229 set helpTopics(.frame.2.entry) {In this field of the rolodex entry you should type the first line of the person's address}
 230 set helpTopics(.frame.3.entry) {In this field of the rolodex entry you should type the second line of the person's address}
 231 set helpTopics(.frame.4.entry) {In this field of the rolodex entry you should type the third line of the person's address}
 232 set helpTopics(.frame.5.entry) {In this field of the rolodex entry you should type the person's home phone number, or "private" if the person doesn't want his or her number publicized}
 233 set helpTopics(.frame.6.entry) {In this field of the rolodex entry you should type the person's work phone number}
 234 set helpTopics(.frame.7.entry) {In this field of the rolodex entry you should type the phone number for the person's FAX machine}
 235
 236 set helpCmds(.frame.1.label) {set topic .frame.1.entry}
 237 set helpCmds(.frame.2.label) {set topic .frame.2.entry}
 238 set helpCmds(.frame.3.label) {set topic .frame.3.entry}
 239 set helpCmds(.frame.4.label) {set topic .frame.4.entry}
 240 set helpCmds(.frame.5.label) {set topic .frame.5.entry}
 241 set helpCmds(.frame.6.label) {set topic .frame.6.entry}
 242 set helpCmds(.frame.7.label) {set topic .frame.7.entry}
 243
 244 set helpTopics(context) {Unfortunately, this application doesn't support context-sensitive help in the usual way, because Tk doesn't yet have a grab mechanism and this is needed for context-sensitive help.  Instead, you can achieve much the same effect by simply moving the mouse over the window you're curious about and pressing the Help or F1 keys.  You can do this anytime.}
 245 set helpTopics(help) {This application provides only very crude help.  Besides the entries in this menu, you can get help on individual windows by moving the mouse cursor over the window and pressing the Help or F1 keys.}
 246 set helpTopics(window) {This window is a dummy rolodex application created as part of Tom LaStrange's toolkit benchmark.  It doesn't really do anything useful except to demonstrate a few features of the Tk toolkit.}
 247 set helpTopics(keys) "The following accelerator keys are defined for this application (in addition to those already available for the entry windows):\n\nCtrl+A:\t\tAdd\nCtrl+C:\t\tClear\nCtrl+D:\t\tDelete\nCtrl+F:\t\tEnter file name\nCtrl+Q:\t\tExit application (quit)\nCtrl+S:\t\tSearch (dummy operation)"
 248 set helpTopics(version) {This is version 1.0.}
 249
 250 # Entries in "Help" menu
 251
 252 .menu.help.m add command -label "On Context..." -command {Help context}
 253 .menu.help.m add command -label "On Help..." -command {Help help}
 254 .menu.help.m add command -label "On Window..." -command {Help window}
 255 .menu.help.m add command -label "On Keys..." -command {Help keys}
 256 .menu.help.m add command -label "On Version..." -command {Help version}