# Sebastian Hammer, Adam Dickmeiss
#
# $Log: client.tcl,v $
-# Revision 1.38 1995-06-14 07:22:45 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
# Target definitions can be deleted.
# Listbox used in the query definition dialog.
#
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}
set queryButtons { { {I 0} {I 1} {I 2} } }
{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-wrap {m} {
+ global textWrap
+
+ set textWrap $m
+ .data.record configure -wrap $m
+}
+
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] \
proc popup-marc {sno no b df} {
global fullMarcSeq
global displayFormats
- global popupMarcOdf
+ global popupMarcdf
if {[z39.$sno type $no] != "DB"} {
return
if {$b} {
set w .full-marc-$fullMarcSeq
incr fullMarcSeq
+ set df $popupMarcdf
} else {
set w .full-marc
+ 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"
if {$b} {
bottom-buttons $w [list \
- {Close} [list destroy $w] \
- {Duplicate} [list popup-marc $sno $no 1 $df]] 0
- menubutton $w.bot.formats -text "Format" -menu $w.bot.formats.m
- menu $w.bot.formats.m
- set i 0
- foreach f $displayFormats {
- $w.bot.formats.m add radiobutton -label $f \
- -command [list display-$f $sno $no $w.top.record 0]
- incr i
- }
- pack $w.bot.formats -expand yes -ipadx 2 -ipady 2 \
- -padx 3 -pady 3 -side left
+ {Close} [list destroy $w]] 0
} else {
bottom-buttons $w [list \
- {Close} [list destroy $w] \
- {Duplicate} [list popup-marc $sno $no 1 $df]] 0
+ {Close} [list destroy $w] \
+ {Duplicate} [list popup-marc $sno $no 1 0]] 0
menubutton $w.bot.formats -text "Format" -menu $w.bot.formats.m
menu $w.bot.formats.m
set i 0
foreach f $displayFormats {
$w.bot.formats.m add radiobutton -label $f \
+ -variable popupMarcdf -value $i \
-command [list display-$f $sno $no $w.top.record 0]
incr i
}
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
+ show-status {Searching} 1 0
}
proc scan-request {} {
foreach a [lrange [lindex $queryInfoFind [lindex $b 1]] 1 end] {
set attr "@attr $a $attr"
}
+ set title [lindex [lindex $queryInfoFind [lindex $b 1]] 0]
ir-scan z39.scan z39
if {![winfo exists $w]} {
toplevelG $w
- wm title $w "Scan"
-
wm minsize $w 0 0
top-down-window $w
{Down} [list scan-down $attr]] 0
bind $w.top.list <Up> [list scan-up $attr]
bind $w.top.list <Down> [list scan-down $attr]
-
-# bind $w.top <Any-Enter> [list focus $w.top.entry]
}
+ wm title $w "Scan $title"
+
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 {} {
.data.record tag add r$o $insert0 insert
.data.record tag bind r$o <1> \
[list popup-marc $setno $o 0 0]
+ update idletasks
}
}
}
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
proc save-geometry {} {
global windowGeometry
+ global hotTargets
+ global textWrap
+ global displayFormat
+ global popupMarcdf
set windowGeometry(.) [wm geometry .]
set f [open "clientg.tcl" w]
+ 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)
}
proc save-settings {} {
- global hotTargets
global profile
global settingsChanged
global queryTypes
set f [open "clientrc.tcl" w]
puts $f "# Setup file"
- puts $f "set hotTargets \{ $hotTargets \}"
foreach n [array names profile] {
puts -nonewline $f "set \{profile($n)\} \{"
top-down-window $w
label $w.top.warning -bitmap warning
- message $w.top.message -text $ask -aspect 200
+ message $w.top.message -text $ask -aspect 200 \
+ -font -Adobe-Times-Medium-R-Normal-*-180-*
pack $w.top.warning $w.top.message -side left -pady 5 -padx 10 -expand yes
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} {
}
}
}
+ if {[winfo exists $w]} {
+ destroy $w
+ }
toplevelG $w
set n [lindex $attr 0]
proc query-edit-index {queryNo} {
global queryInfoTmp
+ set w .query-setup
- set i [lindex [.query-setup.top.index curselection] 0]
+ set i [lindex [$w.top.index.list curselection] 0]
if {$i == ""} {
return
}
global queryButtonsTmp
set w .query-setup
- set i [lindex [$w.top.index curselection] 0]
+ set i [lindex [$w.top.index.list curselection] 0]
if {$i == ""} {
return
}
set queryInfoTmp [lreplace $queryInfoTmp $i $i]
index-lines $w.top.lines 0 $queryButtonsTmp $queryInfoTmp activate-e-index
- $w.top.index delete $i
+ $w.top.index.list delete $i
}
proc query-setup {queryNo} {
set queryInfoTmp [lindex $queryInfo $queryNo]
set queryButtonsTmp [lindex $queryButtons $queryNo]
- toplevel $w
+ toplevelG $w
wm minsize $w 0 0
wm title $w "Query setup $queryName"
frame $w.top.lines -relief ridge -border 2
+ pack $w.top.lines -side left -pady 6 -padx 6 -fill y
+
# Index Lines
index-lines $w.top.lines 0 $queryButtonsTmp $queryInfoTmp activate-e-index
- pack $w.top.lines -side left -pady 6 -padx 6 -fill y
+ button $w.top.lines.add -text "Add" \
+ -command [list query-add-line $queryNo]
+ button $w.top.lines.del -text "Remove" \
+ -command [list query-del-line $queryNo]
+
+ pack $w.top.lines.del -fill x -side bottom
+ pack $w.top.lines.add -fill x -pady 10 -side bottom
# Indexes
- listbox $w.top.index -yscrollcommand [list $w.top.scroll set]
- scrollbar $w.top.scroll -orient vertical -border 1 \
- -command [list $w.top.index yview]
+ frame $w.top.index -relief ridge -border 2
+ pack $w.top.index -pady 6 -padx 6 -side right -fill y
- pack $w.top.index -side left -fill both -expand yes -padx 2 -pady 2
- pack $w.top.scroll -side right -fill y -padx 2 -pady 2
+ listbox $w.top.index.list -yscrollcommand [list $w.top.index.scroll set]
+ scrollbar $w.top.index.scroll -orient vertical -border 1 \
+ -command [list $w.top.index.list yview]
+ bind $w.top.index.list <2> [list query-edit-index $queryNo]
- $w.top.index select from 0
- $w.top.index select to 0
+ pack $w.top.index.list -side left -fill both -expand yes -padx 2 -pady 2
+ pack $w.top.index.scroll -side right -fill y -padx 2 -pady 2
+
+ $w.top.index.list select from 0
+ $w.top.index.list select to 0
foreach x $queryInfoTmp {
- $w.top.index insert end [lindex $x 0]
+ $w.top.index.list insert end [lindex $x 0]
}
- # Ok-cancel
+ # Bottom
bottom-buttons $w [list \
{Ok} [list query-setup-action $queryNo] \
- {Add line} [list query-add-line $queryNo] \
- {Delete line} [list query-del-line $queryNo] \
{Add index} [list query-add-index $queryNo] \
{Edit index} [list query-edit-index $queryNo] \
{Delete index} [list query-delete-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 "Query type" -menu .top.service.m.querytype
-menu .top.service.m.querytype
-.top.service.m.querytype add radiobutton -label "RPN"
-.top.service.m.querytype add radiobutton -label "CCL"
.top.service.m add cascade -label "Present" -menu .top.service.m.present
menu .top.service.m.present
-.top.service.m.present add command -label "More" \
+.top.service.m.present add command -label "10 More" \
-command [list present-more 10]
.top.service.m.present add command -label "All" \
-command [list present-more {}]
+.top.service.m add command -label "Search" -command {search-request}
+.top.service.m add command -label "Scan" -command {scan-request}
+
.top.service configure -state disabled
menubutton .top.rset -text "Set" -menu .top.rset.m
.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
+.top.options.m add cascade -label "Wrap" -menu .top.options.m.wrap
menu .top.options.m.query
.top.options.m.query add cascade -label "Select" \
incr i
}
+menu .top.options.m.wrap
+.top.options.m.wrap add radiobutton -label "Character" \
+ -value char -variable textWrap -command {set-wrap char}
+.top.options.m.wrap add radiobutton -label "Word" \
+ -value word -variable textWrap -command {set-wrap word}
+.top.options.m.wrap add radiobutton -label "None" \
+ -value none -variable textWrap -command {set-wrap none}
+
menubutton .top.help -text "Help" -menu .top.help.m
menu .top.help.m
-fill y -padx 5 -pady 3
text .data.record -height 2 -width 20 -wrap none \
- -yscrollcommand [list .data.scroll set]
+ -yscrollcommand [list .data.scroll set] -wrap $textWrap
scrollbar .data.scroll -command [list .data.record yview]
pack .data.scroll -side right -fill y
pack .data.record -expand yes -fill both
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