3 # Revision 1.1 1995-03-09 16:15:07 adam
4 # First presentRequest attempts. Hot-target list.
9 if {[file readable "~/.tk-c"]} {
13 proc show-target {target} {
14 .bot.target configure -text "$target"
17 proc show-status {status} {
18 .bot.status configure -text "$status"
21 proc show-message {msg} {
22 .bot.message configure -text "$msg"
25 proc update-target-hotlist {target} {
28 set len [llength $hotTargets]
30 .top.target.m delete 5 [expr 5+[llength $hotTargets]]
32 set indx [lsearch $hotTargets $target]
34 set hotTargets [lreplace $hotTargets $indx $indx]
36 set hotTargets [linsert $hotTargets 0 $target]
40 proc set-target-hotlist {} {
44 foreach target $hotTargets {
45 .top.target.m add command -label $target -command \
46 "menu-open-target $target"
54 proc menu-open-target {target} {
56 update-target-hotlist $target
59 proc open-target-action {} {
60 set host [.target-connect.top.host.entry get]
61 set port [.target-connect.top.port.entry get]
69 open-target "${host}:${port}"
70 update-target-hotlist ${host}:${port}
71 destroy .target-connect
74 proc open-target {target} {
77 z39 comstack ${csRadioType}
84 proc init-request {} {
87 z39 callback {init-response}
89 show-status {Initializing}
93 proc init-response {} {
95 pack .mid.searchlabel .mid.searchentry -side left
96 bind .mid.searchentry <Return> search-request
97 focus .mid.searchentry
100 proc search-request {} {
106 z39 callback {search-response}
107 z39.${set-no} search [.mid.searchentry get]
111 proc search-response {} {
115 show-message "[z39.${set-no} resultCount] hits"
116 z39 callback {present-response}
117 z39.${set-no} present
118 show-status {Retrieve}
121 proc present-response {} {
122 show-status {Finished}
125 proc bind-fields {list returnAction escapeAction} {
127 set max [expr [llength $list]-1]
129 bind [lindex $list $i] <Return> $returnAction
130 bind [lindex $list $i] <Escape> $escapeAction
131 bind [lindex $list $i] <Tab> [list focus [lindex $list [expr $i+1]]]
134 bind [lindex $list $i] <Return> $returnAction
135 bind [lindex $list $i] <Escape> $escapeAction
136 bind [lindex $list $i] <Tab> [list focus [lindex $list 0]]
137 focus [lindex $list 0]
140 proc entry-fields {parent list tlist returnAction escapeAction} {
143 foreach field $list {
144 set label ${parent}.${field}.label
145 set entry ${parent}.${field}.entry
146 label $label -text [lindex $tlist $i] -anchor e
147 entry $entry -width 30 -relief sunken
148 pack $label -side left
149 pack $entry -side right
153 bind-fields $alist $returnAction $escapeAction
156 proc open-target-dialog {} {
157 set w .target-connect
163 frame $w.top -relief sunken -border 1
164 frame $w.bot -relief sunken -border 1
166 pack $w.top $w.bot -side top -fill both -expand yes
171 pack $w.top.host $w.top.port \
172 -side top -anchor e -pady 2
174 entry-fields $w.top {host port } \
175 {{Hostname:} {Port number:}} \
176 {open-target-action} {destroy .target-connect}
178 frame $w.bot.left -relief sunken -border 1
179 pack $w.bot.left -side left -expand yes -padx 5 -pady 5
180 button $w.bot.left.ok -width 6 -text {Ok} \
181 -command {open-target-action}
182 pack $w.bot.left.ok -expand yes -padx 3 -pady 3
183 button $w.bot.cancel -width 6 -text {Cancel} \
184 -command {destroy .target-connect}
185 pack $w.bot.cancel -side left -expand yes
192 proc close-target {} {
193 pack forget .mid.searchlabel .mid.searchentry
196 show-status {Not connected}
200 proc protocol-setup-action {} {
201 destroy .protocol-setup
205 proc place-force {window parent} {
206 set g [wm geometry $parent]
208 set p1 [string first + $g]
209 set p2 [string last + $g]
211 set x [expr 40+[string range $g [expr $p1 +1] [expr $p2 -1]]]
212 set y [expr 60+[string range $g [expr $p2 +1] end]]
213 wm geometry $window +${x}+${y}
216 proc protocol-setup {} {
217 set w .protocol-setup
223 frame $w.top -relief sunken -border 1
224 frame $w.bot -relief sunken -border 1
226 pack $w.top $w.bot -side top -fill both -expand yes
228 frame $w.top.description
229 frame $w.top.idAuthentification
230 frame $w.top.maximumMessageSize
231 frame $w.top.preferredMessageSize
232 frame $w.top.cs-type -relief ridge -border 2
233 frame $w.top.query -relief ridge -border 2
235 # Maximum/preferred/idAuth ...
236 pack $w.top.description \
237 $w.top.idAuthentification $w.top.maximumMessageSize \
238 $w.top.preferredMessageSize -side top -anchor e -pady 2
240 entry-fields $w.top {description idAuthentification maximumMessageSize \
241 preferredMessageSize} \
242 {{Description:} {Id Authentification:} {Maximum Message Size:}
243 {Preferred Message Size:}} \
244 {protocol-setup-action} {destroy .protocol-setup}
247 pack $w.top.cs-type -side left -pady 2 -padx 2
251 label $w.top.cs-type.label -text "Transport" -anchor e
252 radiobutton $w.top.cs-type.tcpip -text "TCP/IP" \
253 -command {puts tcp/ip} -variable csRadioType -value tcpip
254 radiobutton $w.top.cs-type.mosi -text "MOSI" \
255 -command {puts mosi} -variable csRadioType -value mosi
257 pack $w.top.cs-type.label $w.top.cs-type.tcpip $w.top.cs-type.mosi \
258 -padx 4 -side top -fill x
261 pack $w.top.query -side right -pady 2 -padx 2 -expand yes
263 label $w.top.query.label -text "Query support" -anchor e
264 checkbutton $w.top.query.c1 -text "CCL query"
265 checkbutton $w.top.query.c2 -text "RPN query"
266 checkbutton $w.top.query.c3 -text "Result sets"
268 pack $w.top.query.label -side top -anchor w
269 pack $w.top.query.c1 $w.top.query.c2 $w.top.query.c3 \
270 -padx 4 -side left -fill x
273 frame $w.bot.left -relief sunken -border 1
274 pack $w.bot.left -side left -expand yes -padx 5 -pady 5
275 button $w.bot.left.ok -width 6 -text {Ok} \
276 -command {protocol-setup-action}
277 pack $w.bot.left.ok -expand yes -padx 3 -pady 3
278 button $w.bot.cancel -width 6 -text {Cancel} \
279 -command "destroy $w"
280 pack $w.bot.cancel -side left -expand yes
289 proc database-select-action {} {
290 z39 databaseNames [.database-select.top.database.entry get]
291 destroy .database-select
294 proc database-select {} {
295 set w .database-select
301 frame $w.top -relief sunken -border 1
302 frame $w.bot -relief sunken -border 1
304 pack $w.top $w.bot -side top -fill both -expand yes
306 frame $w.top.database
309 pack $w.top.database -side top -anchor e -pady 2
311 entry-fields $w.top {database} \
313 {database-select-action} {destroy .database-select}
316 frame $w.bot.left -relief sunken -border 1
317 pack $w.bot.left -side left -expand yes -padx 5 -pady 5
318 button $w.bot.left.ok -width 6 -text {Ok} \
319 -command {protocol-setup-action}
320 pack $w.bot.left.ok -expand yes -padx 3 -pady 3
321 button $w.bot.cancel -width 6 -text {Cancel} \
322 -command "destroy $w"
323 pack $w.bot.cancel -side left -expand yes
331 proc save-settings {} {
334 set f [open "~/.tk-c" w]
335 puts $f "# Setup file"
336 puts $f "set hotTargets \{ $hotTargets \}"
340 frame .top -border 1 -relief raised
341 frame .mid -border 1 -relief raised
342 frame .data -border 1 -relief raised
343 frame .bot -border 1 -relief raised
344 pack .top .mid -side top -fill x
345 pack .data -side top -fill both -expand yes
348 menubutton .top.file -text "File" -menu .top.file.m
350 .top.file.m add command -label "Save settings" -command {save-settings}
351 .top.file.m add command -label "Exit" -command {destroy .}
353 menubutton .top.target -text "Target" -menu .top.target.m
355 .top.target.m add command -label "Connect" -command {open-target-dialog}
356 .top.target.m add command -label "Disconnect" -command {close-target}
357 .top.target.m add command -label "Initialize" -command {init-request}
358 .top.target.m add command -label "Setup" -command {protocol-setup}
359 .top.target.m add separator
362 menubutton .top.database -text "Database" -menu .top.database.m
364 .top.database.m add command -label "Select ..." -command {database-select}
365 .top.database.m add command -label "Add ..." -command {puts "Add"}
367 menubutton .top.help -text "Help" -menu .top.help.m
369 .top.help.m add command -label "Help on help" -command {puts "Help on help"}
370 .top.help.m add command -label "About" -command {puts "About"}
372 pack .top.file .top.target .top.database -side left
373 pack .top.help -side right
375 label .mid.searchlabel -text {Search:}
376 entry .mid.searchentry -width 50 -relief sunken
378 listbox .data.list -geometry 50x10
379 scrollbar .data.scroll -orient vertical -border 1
380 pack .data.list -side left -fill both -expand yes
381 pack .data.scroll -side right -fill y
383 message .bot.target -text "None" -aspect 1000 -relief sunken -border 1
384 label .bot.status -text "Not connected" -width 12 -relief \
385 sunken -anchor w -border 1
386 label .bot.message -text "" -width 20 -relief \
387 sunken -anchor w -border 1
388 pack .bot.target .bot.status .bot.message -anchor nw -side left -padx 2 -pady 2
392 set csRadioType [z39 comstack]