"Fossies" - the Fresh Open Source Software Archive

Member "install-tl-20200916/tlpkg/tltcl/lib/tk8.6/demos/rolodex" (17 Mar 2020, 8299 Bytes) of package /windows/misc/install-tl.zip:


As a special service "Fossies" has tried to format the requested source page into HTML format using (guessed) Bash source code syntax highlighting (style: standard) with prefixed line numbers. Alternatively you can here view or download the uninterpreted source code file.

    1 #!/bin/sh
    2 # the next line restarts using wish \
    3 exec wish86 "$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 package require Tk
   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 # DKF - note that this is an old-style menu bar; I just have not yet
   47 # got around to converting the context help code to work with the new
   48 # menu system and its <<MenuSelect>> virtual event.
   49 
   50 frame .menu -relief raised -borderwidth 1
   51 pack .menu -before .frame -side top -fill x
   52 
   53 menubutton .menu.file -text "File" -menu .menu.file.m -underline 0
   54 menu .menu.file.m
   55 .menu.file.m add command -label "Load ..." -command fileAction -underline 0
   56 .menu.file.m add command -label "Exit" -command {destroy .} -underline 0
   57 pack .menu.file -side left
   58 
   59 menubutton .menu.help -text "Help" -menu .menu.help.m -underline 0
   60 menu .menu.help.m
   61 pack .menu.help -side right
   62 
   63 proc deleteAction {} {
   64     if {[tk_dialog .delete {Confirm Action} {Are you sure?} {} 0  Cancel]
   65         == 0} {
   66     clearAction
   67     }
   68 }
   69 .buttons.delete config -command deleteAction
   70 
   71 proc fileAction {} {
   72     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
   73     puts stderr {dummy file name}
   74 }
   75 
   76 #------------------------------------------
   77 # Phase 3: Print contents of card
   78 #------------------------------------------
   79 
   80 proc addAction {} {
   81     global names
   82     foreach i {1 2 3 4 5 6 7} {
   83     puts stderr [format "%-12s %s" [lindex $names $i] [.frame.entry$i get]]
   84     }
   85 }
   86 .buttons.add config -command addAction
   87 
   88 #------------------------------------------
   89 # Phase 4: Miscellaneous other actions
   90 #------------------------------------------
   91 
   92 proc clearAction {} {
   93     foreach i {1 2 3 4 5 6 7} {
   94     .frame.entry$i delete 0 end
   95     }
   96 }
   97 .buttons.clear config -command clearAction
   98 
   99 proc fillCard {} {
  100     clearAction
  101     .frame.entry1 insert 0 "John Ousterhout"
  102     .frame.entry2 insert 0 "CS Division, Department of EECS"
  103     .frame.entry3 insert 0 "University of California"
  104     .frame.entry4 insert 0 "Berkeley, CA 94720"
  105     .frame.entry5 insert 0 "private"
  106     .frame.entry6 insert 0 "510-642-0865"
  107     .frame.entry7 insert 0 "510-642-5775"
  108 }
  109 .buttons.search config -command "addAction; fillCard"
  110 
  111 #----------------------------------------------------
  112 # Phase 5: Accelerators, mnemonics, command-line info
  113 #----------------------------------------------------
  114 
  115 .buttons.clear config -text "Clear    Ctrl+C"
  116 bind . <Control-c> clearAction
  117 .buttons.add config -text "Add    Ctrl+A"
  118 bind . <Control-a> addAction
  119 .buttons.search config -text "Search    Ctrl+S"
  120 bind . <Control-s> "addAction; fillCard"
  121 .buttons.delete config -text "Delete...    Ctrl+D"
  122 bind . <Control-d> deleteAction
  123 
  124 .menu.file.m entryconfig 1 -accel Ctrl+F
  125 bind . <Control-f> fileAction
  126 .menu.file.m entryconfig 2 -accel Ctrl+Q
  127 bind . <Control-q> {destroy .}
  128 
  129 focus .frame.entry1
  130 
  131 #----------------------------------------------------
  132 # Phase 6: help
  133 #----------------------------------------------------
  134 
  135 proc Help {topic {x 0} {y 0}} {
  136     global helpTopics helpCmds
  137     if {$topic == ""} return
  138     while {[info exists helpCmds($topic)]} {
  139     set topic [eval $helpCmds($topic)]
  140     }
  141     if [info exists helpTopics($topic)] {
  142     set msg $helpTopics($topic)
  143     } else {
  144     set msg "Sorry, but no help is available for this topic"
  145     }
  146     tk_dialog .help {Rolodex Help} "Information on $topic:\n\n$msg" \
  147         {} 0 OK
  148 }
  149 
  150 proc getMenuTopic {w x y} {
  151     return $w.[$w index @[expr {$y-[winfo rooty $w]}]]
  152 }
  153 
  154 event add <<Help>> <F1> <Help>
  155 bind .    <<Help>> {Help [winfo containing %X %Y] %X %Y}
  156 bind Menu <<Help>> {Help [winfo containing %X %Y] %X %Y}
  157 
  158 # Help text and commands follow:
  159 
  160 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.}
  161 
  162 set helpCmds(.menu.file.m) {getMenuTopic $topic $x $y}
  163 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}
  164 set helpTopics(.menu.file.m.2) {The "Exit" entry in the "File" menu causes the rolodex application to terminate}
  165 set helpCmds(.menu.file.m.none) {set topic ".menu.file"}
  166 
  167 set helpTopics(.frame.entry1) {In this field of the rolodex entry you should type the person's name}
  168 set helpTopics(.frame.entry2) {In this field of the rolodex entry you should type the first line of the person's address}
  169 set helpTopics(.frame.entry3) {In this field of the rolodex entry you should type the second line of the person's address}
  170 set helpTopics(.frame.entry4) {In this field of the rolodex entry you should type the third line of the person's address}
  171 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}
  172 set helpTopics(.frame.entry6) {In this field of the rolodex entry you should type the person's work phone number}
  173 set helpTopics(.frame.entry7) {In this field of the rolodex entry you should type the phone number for the person's FAX machine}
  174 
  175 set helpCmds(.frame.label1) {set topic .frame.entry1}
  176 set helpCmds(.frame.label2) {set topic .frame.entry2}
  177 set helpCmds(.frame.label3) {set topic .frame.entry3}
  178 set helpCmds(.frame.label4) {set topic .frame.entry4}
  179 set helpCmds(.frame.label5) {set topic .frame.entry5}
  180 set helpCmds(.frame.label6) {set topic .frame.entry6}
  181 set helpCmds(.frame.label7) {set topic .frame.entry7}
  182 
  183 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.}
  184 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.}
  185 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.}
  186 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)"
  187 set helpTopics(version) "This is version $version."
  188 
  189 # Entries in "Help" menu
  190 
  191 .menu.help.m add command -label "On Context..." -command {Help context} \
  192     -underline 3
  193 .menu.help.m add command -label "On Help..." -command {Help help} \
  194     -underline 3
  195 .menu.help.m add command -label "On Window..." -command {Help window} \
  196     -underline 3
  197 .menu.help.m add command -label "On Keys..." -command {Help keys} \
  198     -underline 3
  199 .menu.help.m add command -label "On Version..." -command {Help version}  \
  200     -underline 3
  201 
  202 # Local Variables:
  203 # mode: tcl
  204 # End: