1#!/bin/sh 2# Copyright (c) 1999-2000 Jean-Claude Wippler <jcw@equi4.com> 3# 4# TequiCal - shared yearly event calendar, a demo based on Tequila 5# \ 6exec tclkit "$0" ${1+"$@"} 7 8proc bgerror message { 9 puts "bgerror: message, errorInfo, and errorCode are\ 10 '$message', '$::errorInfo', and '$::errorCode'." 11} 12 13 # present a dialog box asking for a host to connect to 14proc AskSite {{host localhost}} { 15 global as_host as_status 16 set as_host $host 17 toplevel .as 18 wm title .as "Site setup" 19 pack [label .as.l -text "Where is the Tequila server?"] \ 20 [entry .as.e -width 30 -textvariable as_host] \ 21 [button .as.b -text "OK" -command {set as_status 1}] -padx 4 -pady 4 22 bind .as <Return> {.as.b invoke} 23 bind .as <Escape> {exit} 24 wm protocol .as WM_DELETE_WINDOW {exit} 25 update 26 raise .as 27 .as.e selection adjust end 28 focus .as.e 29 vwait as_status 30 destroy .as 31 return $as_host 32} 33 34 # set up the main window and the trace on the global shared array 35proc MainWindow {} { 36 global calendar detail 37 38 wm title . "Tequila Calendar Demo" 39 40 frame .f1 41 scrollbar .f1.sb -command [list .f1.lb yview] 42 listbox .f1.lb -width 50 -height 10 -exportselection 0 \ 43 -yscrollcommand [list .f1.sb set] 44 pack .f1.sb -fill y -side right 45 pack .f1.lb -fill both -expand 1 46 47 frame .f2 48 pack [label .f2.l1 -text "Event:" -anchor e -width 7] -side left 49 pack [entry .f2.e -textvariable detail(e)] -side left -fill x -expand 1 50 51 frame .f3 52 pack [label .f3.l1 -text "Month:" -anchor e -width 7] \ 53 [entry .f3.e1 -textvariable detail(m) -width 3] \ 54 [label .f3.l2 -text " Day:"] \ 55 [entry .f3.e2 -textvariable detail(d) -width 3] \ 56 [label .f3.l3 -text " (clear event to delete)" -anchor w] -side left 57 58 pack .f1 -fill both -expand 1 -padx 4 -pady 4 59 pack .f2 -fill x -padx 4 60 pack .f3 -anchor w -padx 4 -pady 4 61 62 bind .f1.lb <ButtonPress> {ChooseEntry [.f1.lb nearest %y]} 63 .f1.lb insert end "Loading..." 64 65 ChooseEntry end 66 trace variable detail wu {after cancel FixEntry; after 100 FixEntry; #} 67 trace variable calendar wu {after cancel FixList; after 100 FixList; #} 68} 69 70 # this gets called shortly after each change to the calendar array 71proc FixList {} { 72 global calendar 73 .f1.lb delete 0 end 74 foreach k [lsort [array names calendar]] { 75 .f1.lb insert end $k 76 } 77 .f1.lb insert end "(new entry)" 78} 79 80 # this gets called shortly after each editing change 81proc FixEntry {} { 82 global calendar detail 83 84 regexp {..$} "00$detail(m)" m 85 regexp {..$} "00$detail(d)" d 86 set new "$m/$d $detail(e)" 87 88 if {$new == $detail(full)} return 89 90 catch {unset calendar($detail(full))} 91 if {$detail(e) != ""} { 92 set calendar($new) "" 93 } 94 set detail(full) $new 95} 96 97 # called when a list entry has been clicked 98proc ChooseEntry {n} { 99 global detail 100 101 set detail(full) [.f1.lb get $n] 102 if {![regexp {^(..)/(..) (.*)} $detail(full) x \ 103 detail(m) detail(d) detail(e)]} { 104 set now [clock seconds] 105 set detail(m) [clock format $now -format %m] 106 set detail(d) [clock format $now -format %d] 107 set detail(e) "" 108 } 109} 110 111# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - 112# Actual work starts here: connect, set up window/traces, and attach. 113 114source tequila.tcl 115 116 # set up a connection to the central Tequila server 117eval tequila::open [AskSite] 20458 118 119 # layout the main window and show it 120MainWindow 121update 122 123 # setup for a global "calendar" array to be shared 124tequila::attach calendar 125 126 # set some initial data when there is nothing yet 127if {[array size calendar] == 0} { 128 foreach x { 129 "01/01 Happy New Year!" 130 "12/25 Christmas Day" 131 "04/07 Someone's birthday (1989)" 132 } { 133 set calendar($x) "" 134 } 135} 136