2 # the next line restarts using wish \
3 exec wish
"$0" ${1+"$@"}
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.
11 # RCS: @(#) $Id: rolodex,v 1.5 2003/09/30 14:54:30 dkf Exp $
15 foreach i
[winfo child .
] {
21 #------------------------------------------
22 # Phase 0: create the front end.
23 #------------------------------------------
25 frame .frame
-relief flat
26 pack .frame
-side top
-fill y
-anchor center
28 set names
{{} Name
: Address
: {} {} {Home Phone
:} {Work Phone
:} Fax
:}
29 foreach i
{1 2 3 4 5 6 7} {
30 label .frame.label
$i -text [lindex
$names $i] -anchor e
31 entry .frame.entry
$i -width 35
32 grid .frame.label
$i .frame.entry
$i -sticky ew
-pady 2 -padx 1
36 pack .buttons
-side bottom
-pady 2 -anchor center
37 button .buttons.
clear -text Clear
38 button .buttons.add
-text Add
39 button .buttons.search
-text Search
40 button .buttons.delete
-text "Delete ..."
41 pack .buttons.
clear .buttons.add .buttons.search .buttons.delete \
44 #------------------------------------------
45 # Phase 1: Add menus, dialog boxes
46 #------------------------------------------
48 # DKF - note that this is an old-style menu bar; I just have not yet
49 # got around to converting the context help code to work with the new
50 # menu system and its <<MenuSelect>> virtual event.
52 frame .menu
-relief raised
-borderwidth 1
53 pack .menu
-before .frame
-side top
-fill x
55 menubutton .menu.
file -text "File" -menu .menu.
file.m
-underline 0
57 .menu.
file.m add
command -label "Load ..." -command fileAction
-underline 0
58 .menu.
file.m add
command -label "Exit" -command {destroy .
} -underline 0
59 pack .menu.
file -side left
61 menubutton .menu.
help -text "Help" -menu .menu.
help.m
-underline 0
63 pack .menu.
help -side right
65 proc deleteAction
{} {
66 if {[tk_dialog .delete
{Confirm Action
} {Are you sure?
} {} 0 Cancel
]
71 .buttons.delete config
-command deleteAction
74 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
75 puts stderr {dummy file name}
78 #------------------------------------------
79 # Phase 3: Print contents of card
80 #------------------------------------------
84 foreach i {1 2 3 4 5 6 7} {
85 puts stderr [format "%-12s %s" [lindex $names $i] [.frame.entry$i get]]
88 .buttons.add config -command addAction
90 #------------------------------------------
91 # Phase 4: Miscellaneous other actions
92 #------------------------------------------
95 foreach i {1 2 3 4 5 6 7} {
96 .frame.entry$i delete 0 end
99 .buttons.clear config -command clearAction
103 .frame.entry1 insert 0 "John Ousterhout"
104 .frame.entry2 insert 0 "CS Division, Department of EECS"
105 .frame.entry3 insert 0 "University of California"
106 .frame.entry4 insert 0 "Berkeley, CA 94720"
107 .frame.entry5 insert 0 "private"
108 .frame.entry6 insert 0 "510-642-0865"
109 .frame.entry7 insert 0 "510-642-5775"
111 .buttons.search config -command "addAction; fillCard"
113 #----------------------------------------------------
114 # Phase 5: Accelerators, mnemonics, command-line info
115 #----------------------------------------------------
117 .buttons.clear config -text "Clear Ctrl+C"
118 bind . <Control-c> clearAction
119 .buttons.add config -text "Add Ctrl+A"
120 bind . <Control-a> addAction
121 .buttons.search config -text "Search Ctrl+S"
122 bind . <Control-s> "addAction; fillCard"
123 .buttons.delete config -text "Delete... Ctrl+D"
124 bind . <Control-d> deleteAction
126 .menu.file.m entryconfig 1 -accel Ctrl+F
127 bind . <Control-f> fileAction
128 .menu.file.m entryconfig 2 -accel Ctrl+Q
129 bind . <Control-q> {destroy .}
133 #----------------------------------------------------
135 #----------------------------------------------------
137 proc Help {topic {x 0} {y 0}} {
138 global helpTopics helpCmds
139 if {$topic == ""} return
140 while {[info exists helpCmds($topic)]} {
141 set topic [eval $helpCmds($topic)]
143 if [info exists helpTopics($topic)] {
144 set msg $helpTopics($topic)
146 set msg "Sorry, but no help is available for this topic"
148 tk_dialog .help {Rolodex Help} "Information on $topic:\n\n$msg" \
152 proc getMenuTopic {w x y} {
153 return $w.[$w index @[expr {$y-[winfo rooty $w]}]]
156 event add <<Help>> <F1> <Help>
157 bind . <<Help>> {Help [winfo containing %X %Y] %X %Y}
158 bind Menu <<Help>> {Help [winfo containing %X %Y] %X %Y}
160 # Help text and commands follow:
162 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.}
164 set helpCmds(.menu.file.m) {getMenuTopic $topic $x $y}
165 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}
166 set helpTopics(.menu.file.m.2) {The "Exit" entry in the "File" menu causes the rolodex application to terminate}
167 set helpCmds(.menu.file.m.none) {set topic ".menu.file"}
169 set helpTopics(.frame.entry1) {In this field of the rolodex entry you should type the person's name
}
170 set helpTopics
(.frame.entry2
) {In this field of the rolodex entry you should
type the first line of the person
's address}
171 set helpTopics(.frame.entry3) {In this field of the rolodex entry you should type the second line of the person's address
}
172 set helpTopics
(.frame.entry4
) {In this field of the rolodex entry you should
type the third line of the person
's address}
173 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}
174 set helpTopics(.frame.entry6) {In this field of the rolodex entry you should type the person's work phone number
}
175 set helpTopics
(.frame.entry7
) {In this field of the rolodex entry you should
type the phone number
for the person
's FAX machine}
177 set helpCmds(.frame.label1) {set topic .frame.entry1}
178 set helpCmds(.frame.label2) {set topic .frame.entry2}
179 set helpCmds(.frame.label3) {set topic .frame.entry3}
180 set helpCmds(.frame.label4) {set topic .frame.entry4}
181 set helpCmds(.frame.label5) {set topic .frame.entry5}
182 set helpCmds(.frame.label6) {set topic .frame.entry6}
183 set helpCmds(.frame.label7) {set topic .frame.entry7}
185 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.
}
186 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.
}
187 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.
}
188 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)"
189 set helpTopics
(version
) "This is version $version."
191 # Entries in "Help" menu
193 .menu.
help.m add
command -label "On Context..." -command {Help context
} \
195 .menu.
help.m add
command -label "On Help..." -command {Help
help} \
197 .menu.
help.m add
command -label "On Window..." -command {Help window
} \
199 .menu.
help.m add
command -label "On Keys..." -command {Help keys
} \
201 .menu.
help.m add
command -label "On Version..." -command {Help version
} \