mingw/lib/tk8.4/demos/rolodex

   1 #!/bin/sh
   2 # the next line restarts using wish \
   3 exec wish "$0" ${1+"$@"}
   4
   5 # rolodex --
   6 # This script was written as an entry in Tom LaStrange's rolodex
   7 # benchmark.  It creates something that has some of the look and
   8 # feel of a rolodex program, although it's lifeless and doesn't
   9 # actually do the rolodex application.
  10 #
  11 # RCS: @(#) $Id: rolodex,v 1.4 2001/11/05 10:13:53 dkf Exp $
  12
  13 foreach i [winfo child .] {
  14     catch {destroy $i}
  15 }
  16
  17 set version 1.2
  18
  19 #------------------------------------------
  20 # Phase 0: create the front end.
  21 #------------------------------------------
  22
  23 frame .frame -relief flat
  24 pack .frame -side top -fill y -anchor center
  25
  26 set names {{} Name: Address: {} {} {Home Phone:} {Work Phone:} Fax:}
  27 foreach i {1 2 3 4 5 6 7} {
  28     label .frame.label$i -text [lindex $names $i] -anchor e
  29     entry .frame.entry$i -width 35
  30     grid .frame.label$i .frame.entry$i -sticky ew -pady 2 -padx 1
  31 }
  32
  33 frame .buttons
  34 pack .buttons -side bottom -pady 2 -anchor center
  35 button .buttons.clear -text Clear
  36 button .buttons.add -text Add
  37 button .buttons.search -text Search
  38 button .buttons.delete -text "Delete ..."
  39 pack .buttons.clear .buttons.add .buttons.search .buttons.delete \
  40         -side left -padx 2
  41
  42 #------------------------------------------
  43 # Phase 1: Add menus, dialog boxes
  44 #------------------------------------------
  45
  46 frame .menu -relief raised -borderwidth 1
  47 pack .menu -before .frame -side top -fill x
  48
  49 menubutton .menu.file -text "File" -menu .menu.file.m -underline 0
  50 menu .menu.file.m
  51 .menu.file.m add command -label "Load ..." -command fileAction -underline 0
  52 .menu.file.m add command -label "Exit" -command {destroy .} -underline 0
  53 pack .menu.file -side left
  54
  55 menubutton .menu.help -text "Help" -menu .menu.help.m -underline 0
  56 menu .menu.help.m
  57 pack .menu.help -side right
  58
  59 proc deleteAction {} {
  60     if {[tk_dialog .delete {Confirm Action} {Are you sure?} {} 0  Cancel]
  61             == 0} {
  62         clearAction
  63     }
  64 }
  65 .buttons.delete config -command deleteAction
  66
  67 proc fileAction {} {
  68     tk_dialog .fileSelection {File Selection} {This is a dummy file selection dialog box, which is used because there isn't a good file selection dialog built into Tk yet.} {} 0 OK
  69     puts stderr {dummy file name}
  70 }
  71
  72 #------------------------------------------
  73 # Phase 3: Print contents of card
  74 #------------------------------------------
  75
  76 proc addAction {} {
  77     global names
  78     foreach i {1 2 3 4 5 6 7} {
  79         puts stderr [format "%-12s %s" [lindex $names $i] [.frame.entry$i get]]
  80     }
  81 }
  82 .buttons.add config -command addAction
  83
  84 #------------------------------------------
  85 # Phase 4: Miscellaneous other actions
  86 #------------------------------------------
  87
  88 proc clearAction {} {
  89     foreach i {1 2 3 4 5 6 7} {
  90         .frame.entry$i delete 0 end
  91     }
  92 }
  93 .buttons.clear config -command clearAction
  94
  95 proc fillCard {} {
  96     clearAction
  97     .frame.entry1 insert 0 "John Ousterhout"
  98     .frame.entry2 insert 0 "CS Division, Department of EECS"
  99     .frame.entry3 insert 0 "University of California"
 100     .frame.entry4 insert 0 "Berkeley, CA 94720"
 101     .frame.entry5 insert 0 "private"
 102     .frame.entry6 insert 0 "510-642-0865"
 103     .frame.entry7 insert 0 "510-642-5775"
 104 }
 105 .buttons.search config -command "addAction; fillCard"
 106
 107 #----------------------------------------------------
 108 # Phase 5: Accelerators, mnemonics, command-line info
 109 #----------------------------------------------------
 110
 111 .buttons.clear config -text "Clear    Ctrl+C"
 112 bind . <Control-c> clearAction
 113 .buttons.add config -text "Add    Ctrl+A"
 114 bind . <Control-a> addAction
 115 .buttons.search config -text "Search    Ctrl+S"
 116 bind . <Control-s> "addAction; fillCard"
 117 .buttons.delete config -text "Delete...    Ctrl+D"
 118 bind . <Control-d> deleteAction
 119
 120 .menu.file.m entryconfig 1 -accel Ctrl+F
 121 bind . <Control-f> fileAction
 122 .menu.file.m entryconfig 2 -accel Ctrl+Q
 123 bind . <Control-q> {destroy .}
 124
 125 focus .frame.entry1
 126
 127 #----------------------------------------------------
 128 # Phase 6: help
 129 #----------------------------------------------------
 130
 131 proc Help {topic {x 0} {y 0}} {
 132     global helpTopics helpCmds
 133     if {$topic == ""} return
 134     while {[info exists helpCmds($topic)]} {
 135         set topic [eval $helpCmds($topic)]
 136     }
 137     if [info exists helpTopics($topic)] {
 138         set msg $helpTopics($topic)
 139     } else {
 140         set msg "Sorry, but no help is available for this topic"
 141     }
 142     tk_dialog .help {Rolodex Help} "Information on $topic:\n\n$msg" \
 143             {} 0 OK
 144 }
 145
 146 proc getMenuTopic {w x y} {
 147     return $w.[$w index @[expr {$y-[winfo rooty $w]}]]
 148 }
 149
 150 event add <<Help>> <F1> <Help>
 151 bind .    <<Help>> {Help [winfo containing %X %Y] %X %Y}
 152 bind Menu <<Help>> {Help [winfo containing %X %Y] %X %Y}
 153
 154 # Help text and commands follow:
 155
 156 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.}
 157
 158 set helpCmds(.menu.file.m) {getMenuTopic $topic $x $y}
 159 set helpTopics(.menu.file.m.1) {The "Load" entry in the "File" menu posts a dialog box that you can use to select a rolodex file}
 160 set helpTopics(.menu.file.m.2) {The "Exit" entry in the "File" menu causes the rolodex application to terminate}
 161 set helpCmds(.menu.file.m.none) {set topic ".menu.file"}
 162
 163 set helpTopics(.frame.entry1) {In this field of the rolodex entry you should type the person's name}
 164 set helpTopics(.frame.entry2) {In this field of the rolodex entry you should type the first line of the person's address}
 165 set helpTopics(.frame.entry3) {In this field of the rolodex entry you should type the second line of the person's address}
 166 set helpTopics(.frame.entry4) {In this field of the rolodex entry you should type the third line of the person's address}
 167 set helpTopics(.frame.entry5) {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}
 168 set helpTopics(.frame.entry6) {In this field of the rolodex entry you should type the person's work phone number}
 169 set helpTopics(.frame.entry7) {In this field of the rolodex entry you should type the phone number for the person's FAX machine}
 170
 171 set helpCmds(.frame.label1) {set topic .frame.entry1}
 172 set helpCmds(.frame.label2) {set topic .frame.entry2}
 173 set helpCmds(.frame.label3) {set topic .frame.entry3}
 174 set helpCmds(.frame.label4) {set topic .frame.entry4}
 175 set helpCmds(.frame.label5) {set topic .frame.entry5}
 176 set helpCmds(.frame.label6) {set topic .frame.entry6}
 177 set helpCmds(.frame.label7) {set topic .frame.entry7}
 178
 179 set helpTopics(context) {Unfortunately, this application doesn't support context-sensitive help in the usual way, because when this demo was written Tk didn't 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.}
 180 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.}
 181 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.}
 182 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)"
 183 set helpTopics(version) "This is version $version."
 184
 185 # Entries in "Help" menu
 186
 187 .menu.help.m add command -label "On Context..." -command {Help context} \
 188         -underline 3
 189 .menu.help.m add command -label "On Help..." -command {Help help} \
 190         -underline 3
 191 .menu.help.m add command -label "On Window..." -command {Help window} \
 192         -underline 3
 193 .menu.help.m add command -label "On Keys..." -command {Help keys} \
 194         -underline 3
 195 .menu.help.m add command -label "On Version..." -command {Help version}  \
 196         -underline 3