# Sebastian Hammer, Adam Dickmeiss
#
# $Log: client.tcl,v $
-# Revision 1.39 1995-06-14 12:16:22 adam
+# Revision 1.42 1995-06-16 12:28:13 adam
+# Implemented preferredRecordSyntax.
+# Minor changes in diagnostic handling.
+# Record list deleted when connection closes.
+#
+# Revision 1.41 1995/06/14 15:07:59 adam
+# Bug fix in cascade-target-list. Uses yaz-version.h.
+#
+# Revision 1.40 1995/06/14 13:37:17 adam
+# Setting recordType implemented.
+# Setting implementationVersion implemented.
+# Settings implementationId / implementationName edited.
+#
+# Revision 1.39 1995/06/14 12:16:22 adam
# hotTargets, textWrap and displayFormat saved in clientg.tcl.
#
# Revision 1.38 1995/06/14 07:22:45 adam
set lastSetNo 0
set cancelFlag 0
set searchEnable 0
+set scanEnable 0
set fullMarcSeq 0
set displayFormat 1
+set popupMarcdf 0
set textWrap word
set queryTypes {Simple}
{Subject {1=21}} {Any {1=1016}} } }
wm minsize . 0 0
+set setOffset 0
+set setMax 0
+
proc read-formats {} {
global displayFormats
set formats [glob -nocomplain formats/*.tcl]
proc set-display-format {f} {
global displayFormat
global setNo
+ global busy
set displayFormat $f
if {$setNo == 0} {
return
}
- .bot.a.status configure -text "Reformatting"
+ if {!$busy} {
+ .bot.a.status configure -text "Reformatting"
+ }
update idletasks
add-title-lines 0 10000 1
- .bot.a.status configure -text "Done"
+ if {!$busy} {
+ .bot.a.status configure -text "Ready"
+ }
}
proc initBindings {} {
set w Listbox
bind $w <B1-Motion> {}
bind $w <Shift-B1-Motion> {}
+
+ set w Entry
+}
+
+proc post-menu {wbutton wmenu} {
+ $wmenu activate none
+ focus $wmenu
+ $wmenu post [winfo rootx $wbutton] \
+ [expr [winfo rooty $wbutton]+[winfo height $wbutton]]
+
}
proc destroyGW {w} {
set cancelFlag 1
if {$busy} {
- show-status Cancelled 0 {}
+ show-status Canceling 0 {}
}
}
proc show-status {status b sb} {
global busy
global searchEnable
+ global scanEnable
+ global setOffset
+ global setMax
.bot.a.status configure -text "$status"
if {$b == 1} {
if {$sb} {
.top.service configure -state normal
.mid.search configure -state normal
- .mid.scan configure -state normal
- .mid.present configure -state normal
+ if {$scanEnable} {
+ .mid.scan configure -state normal
+ }
+ if {$setOffset > 0 && $setOffset <= $setMax} {
+ .top.service.m enable 1
+ .mid.present configure -state normal
+ } else {
+ .top.service.m disable 1
+ }
if {[winfo exists .scan-window]} {
.scan-window.bot.2 configure -state normal
.scan-window.bot.4 configure -state normal
label $w.top.p.in -text "Implementation name: $i"
set i [z39 implementationId]
label $w.top.p.ii -text "Implementation id: $i"
+ set i [z39 implementationVersion]
+ label $w.top.p.iv -text "Implementation version: $i"
- pack $w.top.p.in $w.top.p.ii -side top -anchor nw
+ pack $w.top.p.in $w.top.p.ii $w.top.p.iv -side top -anchor nw
about-origin-logo 1
bottom-buttons $w [list {Close} [list destroy $w] \
set df $popupMarcdf
} else {
set w .full-marc
- if {[info exists popupMarcdf]} {
- set df $popupMarcdf
- } else {
- set popupMarcdf $df
- }
+ set df $popupMarcdf
}
if {[winfo exists $w]} {
set new 0
set new 1
}
$w.top.record delete 0.0 end
- wm title $w "Record #$no"
+ set recordType [z39.$sno recordType $no]
+ wm title $w "$recordType record #$no"
set ffunc [lindex $displayFormats $df]
set ffunc "display-$ffunc"
proc close-target {} {
global hostid
global cancelFlag
+ global setNo
set cancelFlag 0
+ set setNo 0
+ .bot.a.set configure -text ""
set hostid Default
z39 disconnect
show-target {}
show-status {Not connected} 0 0
+ init-title-lines
show-message {}
.top.target.m disable 1
.top.target.m disable 2
proc init-response {} {
global cancelFlag
+ global scanEnable
if {$cancelFlag} {
close-target
return
}
- show-status {Ready} 0 1
if {![z39 initResult]} {
+ show-status {Ready} 0 1
set u [z39 userInformationField]
close-target
tkerror "Connection rejected by target: $u"
+ } else {
+ if {[lsearch [z39 options] scan] >= 0} {
+ set scanEnable 1
+ } else {
+ set scanEnable 0
+ }
+ show-status {Ready} 0 1
}
}
}
incr setNo
ir-set z39.$setNo z39
+ z39.$setNo preferredRecordSyntax SUTRS
if {[lindex $profile($target) 10] == 1} {
z39.$setNo setName $setNo
}
z39 callback {search-response}
z39.$setNo search $query
- show-status {Search} 1 0
-}
-
-proc scan-focus {w} {
- set oldFocus [focus]
- bind $w <Leave> [list focus $oldFocus]
- focus $w.top.entry
+ show-status {Searching} 1 0
}
proc scan-request {} {
bind $w.top.list <Down> [list scan-down $attr]
}
wm title $w "Scan $title"
-# bind $w.top <Any-Enter> [list scan-focus $w]
z39 callback [list scan-response $attr 0 35]
z39.scan numberOfTermsRequested 5
z39.scan preferredPositionInResponse 1
z39.scan scan "${attr} 0"
- show-status {Scan} 1 0
+ show-status {Scanning} 1 0
}
proc scan-term-h {attr} {
} else {
z39.scan scan "${attr} \{${scanTerm}\}"
}
- show-status {Scan} 1 0
+ show-status {Scanning} 1 0
}
proc scan-response {attr start toget} {
} else {
z39.scan scan "${attr} \{${scanTerm}\}"
}
- show-status {Scan} 1 0
+ show-status {Scanning} 1 0
return
}
set status [z39.scan scanStatus]
puts "down: $q"
z39.scan numberOfTermsRequested 10
z39.scan preferredPositionInResponse 1
- show-status {Scan} 1 0
+ show-status {Scanning} 1 0
puts "${attr} \{$q\}"
z39.scan scan "${attr} \{$q\}"
return
puts "up: $q"
z39.scan numberOfTermsRequested 10
z39.scan preferredPositionInResponse 11
- show-status {Scan} 1 0
+ show-status {Scanning} 1 0
z39.scan scan "${attr} \{$q\}"
return
}
puts "In search-response"
init-title-lines
- show-status {Ready} 0 1
set setMax [z39.$setNo resultCount]
show-message "${setMax} hits"
set l [format "%-4d %7d" $setNo $setMax]
.top.rset.m add command -label $l \
-command [list add-title-lines $setNo 10000 1]
if {$setMax <= 0} {
+ show-status {Ready} 0 1
set status [z39.$setNo responseStatus]
if {[lindex $status 0] == "NSD"} {
set code [lindex $status 1]
set setMax 20
}
set setOffset 1
+ show-status {Ready} 0 1
if {$cancelFlag} {
set cancelFlag 0
return
}
z39 callback {present-response}
z39.$setNo present $setOffset 1
- show-status {Retrieve} 1 0
+ show-status {Retrieving} 1 0
}
proc present-more {number} {
set toGet 3
}
z39.$setNo present $setOffset $toGet
- show-status {Retrieve} 1 0
+ show-status {Retrieving} 1 0
}
proc init-title-lines {} {
}
z39.$setNo present $setOffset $toGet
} else {
- show-status {Finished} 0 1
+ show-status {Ready} 0 1
}
}
proc protocol-setup-delete {target} {
global profile
- set a [alert "Are you you want to delete the target definition $target ?"]
+ set a [alert "Are you sure you want to delete the target \
+definition $target ?"]
if {$a} {
set wno [lindex $profile($target) 12]
set w .setup-${wno}
set wno [lindex $profile($target) 12]
set w .setup-${wno}
-
- foreach i [lsort -decreasing \
- [$w.top.databases.list curselection]] {
- $w.top.databases.list delete $i
+ set l {}
+ foreach i [$w.top.databases.list curselection] {
+ set b [$w.top.databases.list get $i]
+ set l "$l $b"
+ }
+ set a [alert "Are you sure you want to remove the database(s)${l}?"]
+ if {$a} {
+ foreach i [lsort -decreasing \
+ [$w.top.databases.list curselection]] {
+ $w.top.databases.list delete $i
+ }
}
}
.top.target.m.clist delete 0 last
foreach n [array names profile] {
if {$n != "Default"} {
- set nl [string tolower $n]
+ set nl [lindex $profile($n) 12]
if {[llength [lindex $profile($n) 7]] > 1} {
.top.target.m.clist add cascade -label $n \
-menu .top.target.m.clist.$nl
global hotTargets
global textWrap
global displayFormat
+ global popupMarcdf
set windowGeometry(.) [wm geometry .]
puts $f "set hotTargets \{ $hotTargets \}"
puts $f "set textWrap $textWrap"
puts $f "set displayFormat $displayFormat"
+ puts $f "set popupMarcdf $popupMarcdf"
foreach n [array names windowGeometry] {
puts -nonewline $f "set \{windowGeometry($n)\} \{"
puts -nonewline $f $windowGeometry($n)
set newI [.query-add-index.top.index.entry get]
lappend queryInfoTmp [list $newI {}]
- $w.top.index insert end $newI
+ $w.top.index.list insert end $newI
destroy .query-add-index
#destroy $w.top.lines
#frame $w.top.lines -relief ridge -border 2
global queryInfo
global queryButtonsTmp
global queryInfoTmp
+ global queryButtonsFind
+ global queryInfoFind
+
global settingsChanged
set settingsChanged 1
$queryInfoTmp]
set queryButtons [lreplace $queryButtons $queryNo $queryNo \
$queryButtonsTmp]
+ set queryInfoFind $queryInfoTmp
+ set queryButtonsFind $queryButtonsTmp
+
destroy .query-setup
+ index-lines .lines 1 $queryButtonsFind $queryInfoFind activate-index
}
proc activate-e-index {value no i} {
foreach x $queryInfoTmp {
$w.top.index.list insert end [lindex $x 0]
}
- # Ok-cancel
+ # Bottom
bottom-buttons $w [list \
{Ok} [list query-setup-action $queryNo] \
{Add index} [list query-add-index $queryNo] \
pack .data -side top -fill both -expand yes
pack .bot -fill x
-menubutton .top.file -text "File" -underline 0 -menu .top.file.m
+menubutton .top.file -text "File" -menu .top.file.m
menu .top.file.m
.top.file.m add command -label "Save settings" -command {save-settings}
.top.file.m add separator
.top.file.m add command -label "Exit" -command {exit-action}
-menubutton .top.target -text "Target" -underline 0 -menu .top.target.m
+menubutton .top.target -text "Target" -menu .top.target.m
menu .top.target.m
.top.target.m add cascade -label "Connect" -menu .top.target.m.clist
.top.target.m add command -label "Disconnect" -command {close-target}
menu .top.target.m.slist
cascade-target-list
-menubutton .top.service -text "Service" -underline 0 -menu .top.service.m
+menubutton .top.service -text "Service" -menu .top.service.m
menu .top.service.m
.top.service.m add command -label "Database" -command {database-select}
.top.service.m add cascade -label "Present" -menu .top.service.m.present
.top.rset.m add command -label "Load" -command {load-set}
.top.rset.m add separator
-menubutton .top.options -text "Options" -underline 0 -menu .top.options.m
+menubutton .top.options -text "Options" -menu .top.options.m
menu .top.options.m
.top.options.m add cascade -label "Query" -menu .top.options.m.query
.top.options.m add cascade -label "Format" -menu .top.options.m.formats
pack .bot.a.status .bot.a.set .bot.a.message \
-side left -padx 2 -pady 2
-#bind . <Any-Enter> {focus .lines.0.e}
-
ir z39
-#.top.options.m.formats invoke $displayFormat
-
show-logo 1
projects / ir-tcl-moved-to-github.git / blobdiff