/[webpac]/openisis/current/tcl/test/test4.087.tk
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/test/test4.087.tk

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: 4953 byte(s)
initial import of openisis 0.9.0 vendor drop

1 #!/opt/openisis/tcl/tkbuild/wish
2 #
3 # openisis - an open implementation of the ISIS database
4 # Version 0.8.x (microversion see file Version)
5 # Copyright (C) 2003 by Erik Grziwotz, erik@openisis.org
6 #
7 # This library is free software; you can redistribute it and/or
8 # modify it under the terms of the GNU Lesser General Public
9 # License as published by the Free Software Foundation; either
10 # version 2.1 of the License, or (at your option) any later version.
11 #
12 # This library is distributed in the hope that it will be useful,
13 # but WITHOUT ANY WARRANTY; without even the implied warranty of
14 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
15 # Lesser General Public License for more details.
16 #
17 # You should have received a copy of the GNU Lesser General Public
18 # License along with this library; if not, write to the Free Software
19 # Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
20 #
21 # This software is dedicated to the memory of Eckart Dietrich.
22 #
23 # This software is inspired by (but contains no code of) the iAPI
24 # Copyright (C) 2000 by Robert Janusz, rj@jezuici.krakow.pl.
25 # See iAPI.txt for what it contains.
26 #
27 # $Id: test4.087.tk,v 1.1 2003/03/06 16:01:47 mawag Exp $
28 # test script for tk-binding of openisis
29
30 entry .fsele
31 .fsele insert 0 /opt/openisis/db/cds/cds
32
33 frame .bbar
34 button .bbar.open -text Open -command {dbOpen [.fsele get]}
35 button .bbar.exit -text Exit -command dbExit
36
37 pack configure .bbar.open .bbar.exit -side left
38 pack .fsele .bbar
39
40 wm title . TkIsis
41
42 # globals:
43 # Session0
44 # MaxIndex
45 # Db$index(session,dbid,dbname,title)
46
47 openIsisLog v
48 set Session0 [openIsisInit]
49 set MaxIndex -1
50
51 # openIsisOpen
52 # ########################################################################
53
54 proc dbOpen fname {
55 global ses0 errorInfo
56 set i1 [string last / $fname]
57 set i2 [string last . $fname]
58 if {0 <= $i2 && $i1 < $i2} {
59 set fname [string range $fname 0 [expr $i2 - 1]]
60 }
61 if [catch {dbNew $fname}] {
62 # set i3 [string first "while executing" $errorInfo]
63 set i3 -1
64 if {0 <= $i3} {
65 set msg [string range $errorInfo 0 [expr $i3 - 1]]
66 } {
67 set msg $errorInfo
68 }
69 toplevel .erropen
70 message .erropen.msg -text "$msg\n$fname"
71 button .erropen.ok -text Ok -command {destroy .erropen}
72 pack .erropen.msg .erropen.ok
73 }
74 }
75
76 proc dbExit {} {
77 global MaxIndex
78 for {set j 0} {$MaxIndex >= $j} {incr j} {
79 catch {
80 upvar #0 Db$j db
81 $db(dbid) close
82 puts "$db(dbid) closed"
83 }
84 }
85 exit 0
86 }
87
88 # db
89 # ########################################################################
90
91 proc dbNew dbname {
92 global Session0 MaxIndex
93 set sid [$Session0 new]
94 set dbid [openIsisOpen $dbname]
95 set idx [string range $sid 5 end]
96 puts "dbNew $idx $sid $dbid"
97 if {$MaxIndex < $idx} {
98 set MaxIndex $idx
99 }
100 set i1 [string last / $dbname]
101 if {0 <= $i1} {
102 set title [string range $dbname [incr i1] end]
103 } {
104 set title $dbname
105 }
106
107 upvar #0 Db$idx db
108 set db(dbid) $dbid
109 set db(session) $sid
110 set db(dbname) $dbname
111 set db(title) $title
112
113 toplevel .top$idx
114 wm title .top$idx $title
115
116 frame .top$idx.menu
117 button .top$idx.menu.search -text Search -command "dbSearchCb $idx"
118 button .top$idx.menu.close -text Close -command "dbCloseCb $idx"
119 label .top$idx.lbl1 -text $dbname
120 label .top$idx.lbl2 -text "maxrow = [$dbid maxrowid]"
121
122 pack .top$idx.menu.search .top$idx.menu.close -side left
123
124 pack .top$idx.menu .top$idx.lbl1 .top$idx.lbl2 -anchor w
125 }
126
127 proc dbCloseCb idx {
128 upvar #0 Db$idx db
129 $db(dbid) close
130 unset db
131 destroy .top$idx
132 }
133
134 proc dbSearchCb idx {
135 if [catch {
136 upvar #0 Db$idx db
137
138 toplevel .ts$idx
139 wm title .ts$idx Search
140 entry .ts$idx.key
141 button .ts$idx.ok -text Ok -command "dbDoTheQuery $idx"
142 button .ts$idx.cancel -text Cancel -command "destroy .ts$idx"
143
144 pack .ts$idx.key .ts$idx.ok .ts$idx.cancel -side left
145 }] {
146 global errorInfo
147 puts $errorInfo
148 }
149 }
150
151 proc dbDoTheQuery idx {
152 if [catch {
153 upvar #0 Db$idx db
154
155 set key [.ts$idx.key get]
156 set res [$db(dbid) query $key -session $db(session)]
157
158 toplevel .tr$idx$key
159 wm title .tr$idx$key "$db(title): $key"
160
161 frame .tr$idx$key.frm
162 listbox .tr$idx$key.frm.lst -yscrollcommand ".tr$idx$key.frm.sy set" \
163 -xscrollcommand ".tr$idx$key.sx set"
164 scrollbar .tr$idx$key.frm.sy -command ".tr$idx$key.frm.lst yview"
165 scrollbar .tr$idx$key.sx -command ".tr$idx$key.frm.lst xview" \
166 -orient horizontal
167 button .tr$idx$key.close -text Close -command "destroy .tr$idx$key"
168
169 set rids [$res list]
170 set num [llength $rids]
171 for {set j 0} {$num > $j} {incr j} {
172 set rec [$res get $j]
173 .tr$idx$key.frm.lst insert end \
174 [concat \
175 [lindex $rids $j] "| " \
176 [lindex $rec 0] "| " \
177 [lindex $rec 1]
178 ]
179 }
180
181 $res close
182 destroy .ts$idx
183
184 pack .tr$idx$key.frm.lst -side left -fill both -expand 1
185 pack .tr$idx$key.frm.sy -side right -fill y
186 pack .tr$idx$key.frm -fill both -expand 1
187 pack .tr$idx$key.sx -fill x
188 pack .tr$idx$key.close
189 }] {
190 global errorInfo
191 puts $errorInfo
192 }
193 }
194

Properties

Name Value
svn:executable

  ViewVC Help
Powered by ViewVC 1.1.26