1 |
dpavlin |
237 |
#!/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 |
|
|
|