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