/[webpac]/openisis/current/tcl/tisis
This is repository of my old source code which isn't updated any more. Go to git.rot13.org for current projects!
ViewVC logotype

Contents of /openisis/current/tcl/tisis

Parent Directory Parent Directory | Revision Log Revision Log


Revision 237 - (show annotations)
Mon Mar 8 17:43:12 2004 UTC (20 years ago) by dpavlin
File size: 10928 byte(s)
initial import of openisis 0.9.0 vendor drop

1 #!/opt/isis/OpenIsis/tcl/bin/wisish
2 # if wisish is in the PATH, but we don't know where, delete this first 2 lines
3 #!/bin/sh
4 # let editor know it's Tcl vim:syntax=tcl
5 # the old Tcl trick of calling wisish regardless where it's installed
6 # sh sees 1 comment line and execs wisish; Tcl joins lines, ignoring exec \
7 exec wisish "$@"
8
9 # load the openIsis.tcl code
10 # if we are NOT the wisish, but a standard wish,
11 # this should also load the dynamic OpenIsis/Tcl lib
12 package require openIsis 0.8
13 namespace import openIsis::isis openIsis::v openIsis::res
14
15
16 # ############################################################
17 # global variables
18 #
19 set isis noserver ;# will give error
20 set mfns {} ;# empty
21 set idx 0
22 set max 0
23 set mfn 0 ;# this is a workaround; record should tell it's mfn
24
25
26 # ############################################################
27 # first define procedures
28 #
29
30
31 # set the global max idx
32 proc max {} {
33 global max mfns
34 # if the list is empty, get max idx
35 if {0 == [set max [llength $mfns]]} {
36 isis maxrow
37 set max [res get {rowid 0}]
38 }
39 }
40
41 # check wether an increment of incr (default 1) would give a legal index
42 proc haveNext {{incr 1}} {
43 global idx max
44 set nidx [expr $idx + $incr]
45 expr 0 < $nidx && $nidx <= $max
46 }
47
48 # get mfn for index i (or current idx, if not given)
49 # if we have a set of mfns, idx is index into this
50 proc mfn {{i ""}} {
51 global idx max mfns
52 if {"" == $i} { set i $idx }
53 if {"" == $mfns} { # direct mfn runs 1..max
54 return $i
55 } else { # list index is 0..max-1
56 return [lindex $mfns [expr $i - 1]]
57 }
58 }
59
60 # get next mfn based on global variable idx (after incrementing by idx)
61 # if we have a set of mfns, idx is index into this
62 proc next {{incr 1}} {
63 global idx max mfns
64 incr idx $incr
65 if {$idx < 1} {
66 set idx 1
67 } elseif {$idx > $max} {
68 set idx $max
69 }
70 mfn
71 }
72
73
74
75 # render all mfns
76 proc all {{from 0}} {
77 global idx max
78 .main.text clear
79 max ;# determine maximum
80 set limit 100
81 for {set idx $from} {[haveNext]} {} {
82 if {! [isis read -rowid [next]]} {
83 puts "no record for idx $idx:"
84 continue
85 }
86 if {[catch {openIsis::Tspr list.tsp}]} {
87 global errorInfo
88 puts stderr "error in list.tsp:\n$errorInfo"
89 break
90 }
91 if [incr limit -1] continue
92 openIsis::puts "<hr><a href=\"/all/$idx\">more</a>"
93 break
94 }
95 } ;# all
96
97 # show detail for index i
98 proc detail {i} {
99 global idx max
100 set idx $i
101 isis read -rowid [mfn]
102 .main.text clear
103 .main.text configure -base /idx/$idx
104 # print application header
105 openIsis::puts "<h3>detail for MFN [v rowid] ($idx of $max)</h3>"
106 if {[haveNext -1]} {
107 set prev [expr $idx-1]
108 openIsis::puts "<a href=\"$prev\">prev ($prev)</a> "
109 }
110 openIsis::puts {<a href="/all">all</a> <a href="/edit">edit</a> }
111 if {[haveNext]} {
112 set next [expr $idx+1]
113 openIsis::puts "<a href=\"$next\">next ($next)</a><br>"
114 }
115 openIsis::puts {<hr>}
116 if {[catch {openIsis::Tspr detail.tsp}]} {
117 global errorInfo
118 puts stderr "error in detail.tsp:\n$errorInfo"
119 }
120 }
121
122
123 # run a query, display results
124 proc runQuery {qry} {
125 global mfns
126 puts "query $qry"
127 isis query -mode 128 -key $qry
128 set mfns [res get {rowid {}}]
129 puts "mfns for '$qry': $mfns"
130 all
131 }
132
133
134 proc showText {} {
135 pack .main.text -side left -expand yes -fill both
136 pack .main.sbar -side right -fill y ;# cuts needed width from right
137 }
138
139 # create the edit dialog toplevel .main.edlg
140 # to edit existing (if mfn != 0) or new record
141 proc editDialog {{mfn 0}} {
142 pack forget .main.text .main.sbar
143 destroy .main.edlg
144 if {$mfn} {
145 if {! [isis read -rowid $mfn]} {
146 tk_messageBox -icon error \
147 -message "could not read $mfn" -type ok
148 return
149 }
150 }
151 frame .main.edlg
152 if {$mfn} {
153 v do tag val {
154 set row [lindex [grid size .main.edlg] 1]
155 label .main.edlg.tag$row -text $tag
156 entry .main.edlg.val$row -width 80
157 .main.edlg.val$row insert 0 $val
158 grid .main.edlg.tag$row .main.edlg.val$row -sticky we
159 }
160 }
161
162 # create a frame for button bar
163 frame .main.edlg.bbar
164 button .main.edlg.bbar.atag -text "add field tag:" -command addNewField
165 entry .main.edlg.bbar.ntag -width 3
166 button .main.edlg.bbar.save -text "save record as MFN:" -command saveRecord
167 entry .main.edlg.bbar.mfn -width 6
168 .main.edlg.bbar.mfn insert 0 $mfn
169 button .main.edlg.bbar.close -text "close" -command closeEdit
170 pack .main.edlg.bbar.atag .main.edlg.bbar.ntag \
171 .main.edlg.bbar.save .main.edlg.bbar.mfn .main.edlg.bbar.close \
172 -side left -fill x -expand yes
173 grid .main.edlg.bbar -columnspan 2 -sticky we
174 # make the first column not stretching, give all space to 2nd
175 grid columnconfigure .main.edlg 0 -weight 0
176 grid columnconfigure .main.edlg 1 -weight 1
177 pack .main.edlg -side left -expand yes -fill both
178 }
179
180 proc addNewField {} {
181 set tag [.main.edlg.bbar.ntag get]
182 if {![string is integer -strict $tag]} {
183 tk_messageBox -icon error \
184 -message "please specify integer tag" -type ok
185 return
186 }
187 set row [lindex [grid size .main.edlg] 1] ;# number of rows in dialog
188 # mv the bar downwards
189 grid configure .main.edlg.bbar -row $row
190 incr row -1
191 label .main.edlg.tag$row -text $tag
192 entry .main.edlg.val$row -width 80
193 grid .main.edlg.tag$row .main.edlg.val$row -row $row -sticky we
194 }
195
196 proc saveRecord {} {
197 # get the mfn from the entry in the button bar
198 set mfn [.main.edlg.bbar.mfn get]
199
200 # prepare new record
201 $openIsis::srv new rec
202 set rows [lindex [grid size .main.edlg] 1] ;# number of rows in dialog
203 incr rows -1 ;# don't count the button bar
204 # get tags and values
205 for {set row 0} {$row < $rows} {incr row} {
206 set tag [.main.edlg.tag$row cget -text]
207 set val [.main.edlg.val$row get]
208 rec add $tag $val
209 }
210
211 set mfn [openIsis::save rec $mfn]
212
213 tk_messageBox -icon info -message "saved as MFN $mfn" -type ok
214 closeEdit
215 }
216
217 proc closeEdit {} {
218 destroy .main.edlg
219 showText
220 }
221
222
223 # ############################################################
224 # procedures called from menu and other interface events
225 #
226
227 # the tsps use openIsis::puts -- have them render to then text widget
228 proc openIsis::puts msg {
229 .main.text parse $msg
230 }
231
232 # a click in the .main.text widget
233 proc htmlclick {x y} {
234 set ref [.main.text href $x $y]
235 if {"" == $ref} return
236 puts "hyperlink: $ref"
237 if {"/all" == $ref} {
238 all
239 } elseif [scan $ref "/all/%d" i] {
240 all $i
241 } elseif [scan $ref "/idx/%d" i] {
242 detail $i
243 } elseif {"/edit" == $ref} {
244 command_edit [mfn]
245 }
246 }
247
248
249 proc command_open {} {
250 puts "command_open"
251 }
252
253 proc command_close {} {
254 puts "hasta la vista"
255 isis close
256 exit
257 }
258
259 proc command_edit {{mfn 0}} {
260 puts "command_edit"
261 editDialog $mfn
262 }
263
264 proc command_search {} {
265 puts "command_search"
266 # open a query dialog in a new toplevel window named .qdlg
267 # TODO for Tk experts: build a guided search dialog with AND,OR,NOT choice
268 destroy .qdlg ;# destroy the toplevel, if existed
269 toplevel .qdlg
270 entry .qdlg.e
271 .qdlg.e insert 0 water
272 button .qdlg.b -text query -command runQueryFromDialog
273 pack .qdlg.e .qdlg.b -fill both
274 focus .qdlg.e
275 }
276
277 # called by the button in the query dialog
278 proc runQueryFromDialog {} {
279 runQuery [.qdlg.e get] ;# what's in the entry widget
280 }
281
282 # called by the button in the menu bar
283 proc runQueryFromMBar {} {
284 runQuery [.mbar.e get] ;# what's in the entry widget
285 }
286
287
288 # ############################################################
289 # configuration
290 #
291
292 # TODO: check the syspar
293 # openIsisRec syspar
294 # set file [open syspar.par]
295 # syspar deserialize [read $file]
296 # close $file
297 # set defaultdb [syspar get 1001]
298
299 # defaults
300 set syspath ../db
301 set encoding ""
302 set defaultdb cds/cds
303
304 # parameters
305 # can't use -v for verbose; TkMain will take it as "-visual"
306 foreach {opt val} $argv {
307 switch -glob -- $opt \
308 -syspath { set syspath $val } \
309 -verbose - -ver { set openIsis::ver 1 } \
310 -encoding { set encoding $val } \
311 -defaultdb - -db { set defaultdb $val } \
312 -* { puts stderr "unknown option '$opt'" } \
313 default {
314 if {"" == $val} { # probably empty last param ?
315 set defaultdb $opt
316 }
317 }
318 }
319
320 # a record to hold menu labels
321 # TODO: we should try to read this from a "message" database
322 openIsisRec menulabels
323 # set fallback values in english
324 # 1: labels for menubar buttons file ...
325 set menubar {file edit}
326 menulabels add 1 File 1 Edit
327 # 2: labels for File menu open close ...
328 set menu(file) {open close}
329 menulabels add 2 Open 2 Close
330 set menu(edit) {edit search}
331 menulabels add 3 Edit 3 Search
332 if {[info exists env(LANG)] && "es_AR" == $env(LANG)} { # we're en Argentina
333 # overwrite main menubar labels:
334 # menulabels set 1 Archivo 1 Edit
335 }
336 puts "menu language:\n[menulabels serialize]"
337
338
339
340 # ############################################################
341 # now we have all procedures defined and the config -- create the windows
342 #
343 # create a frame to hold the menubuttons
344 # remove ;# to give it a raised relief
345 frame .mbar ;# -relief raised -bd 2
346 # create the menubar, looping texts over fields with tag 1
347 set texttag 1
348 foreach button $menubar text [menulabels get $texttag] {
349 puts "creating menu $button labeled $text"
350 # underline the first character as "hotkey"
351 menubutton .mbar.$button -text $text -underline 0 -menu .mbar.$button.menu
352 pack .mbar.$button -side left
353 # create the menu belonging to this button
354 menu .mbar.$button.menu
355 incr texttag ;# next number
356 foreach entry $menu($button) text [menulabels get $texttag] {
357 .mbar.$button.menu add command -label $text -command command_$entry
358 }
359 }
360 # add a quick expert search
361 entry .mbar.e -width 20
362 .mbar.e insert 0 water
363 button .mbar.b -text query -command runQueryFromMBar
364 pack .mbar.b -side right
365 pack .mbar.e -side right -expand yes -fill x
366
367 frame .main ;# yeah, it runs on a mainframe !;)
368
369 # create the html widget
370 html .main.text ;# -relief raised -bd 2
371
372 # add an imagecommand to deliver images for <img> tags
373 # see the TkHtml doku and the tisis example how this works
374 # .main.text configure -imagecommand imgcb
375
376
377 # give it a scrollbar to talk with
378 scrollbar .main.sbar -command ".main.text yview"
379 .main.text configure -yscrollcommand ".main.sbar set"
380 showText
381
382
383 # pack the main frames in our toplevel window
384 pack .mbar -side top -fill x ;# cuts needed height from top
385 pack .main -side left -expand yes -fill both ;# expands to all remaining space
386
387
388 # non-standard event bindings:
389
390 # search on s
391 # bind . <s> command_search
392
393 # activate hyperlinks:
394 # bind a mouse button 1 click on the htmlwidget('s inner window .x)
395 # to call procedure htmlclick with the coordinates
396 bind .main.text.x <1> {htmlclick %x %y}
397
398
399 # ############################################################
400 # we have the windows -- startup
401 #
402 # connect to the "local server", i.e. the builtin request dispatcher
403 # actually the value (command name) will always be openIsisRoot,
404 # but we use a variable so we could switch between servers
405 set openIsis::srv [openIsis]
406
407 # open the default db
408 $openIsis::srv add -syspath $syspath -defaultdb $defaultdb
409 if {"" == $encoding && [string equal cds/cds $defaultdb]} {
410 set encoding cp850
411 }
412 if {"" != $encoding} {
413 $openIsis::srv add -encoding $encoding
414 }
415
416 # Open Isis
417 isis open; all

Properties

Name Value
svn:executable

  ViewVC Help
Powered by ViewVC 1.1.26