# Sebastian Hammer, Adam Dickmeiss
#
# $Log: client.tcl,v $
-# Revision 1.64 1995-08-24 15:33:02 adam
+# Revision 1.71 1995-10-13 15:35:27 adam
+# Relational operators may be used in search entries - changes
+# in proc index-query.
+#
+# Revision 1.70 1995/10/12 14:46:52 adam
+# Better record popup windows. Next/prev buttons in popup record windows.
+# The record position in the raw format is much more visible.
+#
+# Revision 1.69 1995/09/21 13:42:54 adam
+# Bug fixes.
+#
+# Revision 1.68 1995/09/21 13:11:49 adam
+# Support of dynamic loading.
+# Test script uses load command if necessary.
+#
+# Revision 1.67 1995/09/20 14:35:19 adam
+# Minor changes.
+#
+# Revision 1.66 1995/08/29 15:30:13 adam
+# Work on GRS records.
+#
+# Revision 1.65 1995/08/24 15:39:09 adam
+# Minor changes.
+#
+# Revision 1.64 1995/08/24 15:33:02 adam
# Minor changes.
#
# Revision 1.63 1995/08/04 13:20:48 adam
set setNoLast 0
set cancelFlag 0
set scanEnable 0
-set fullMarcSeq 0
set displayFormat 1
set popupMarcdf 0
set textWrap word
proc read-formats {} {
global displayFormats
global libdir
- set formats [glob -nocomplain ${libdir}/formats/*.tcl]
+ if {[catch {set formats [glob -nocomplain ${libdir}/formats/*.tcl]}]} {
+ set formats ./formats/raw.tcl
+ }
foreach f $formats {
if {[file readable $f]} {
source $f
}
proc dputs {m} {
- puts $m
}
proc set-display-format {f} {
proc top-down-ok-cancel {w ok-action g} {
frame $w.bot.left -relief sunken -border 1
- pack $w.bot.left -side left -expand yes -ipadx 2 -ipady 2 -padx 4 -pady 4
- button $w.bot.left.ok -width 5 -text {Ok} \
+ pack $w.bot.left -side left -expand yes -ipadx 2 -ipady 2 -padx 1 -pady 1
+ button $w.bot.left.ok -width 4 -text {Ok} \
-command ${ok-action}
- pack $w.bot.left.ok -expand yes -ipadx 2 -ipady 2 -padx 3 -pady 3
- button $w.bot.cancel -width 6 -text {Cancel} \
+ pack $w.bot.left.ok -expand yes -ipadx 1 -ipady 1 -padx 2 -pady 2
+ button $w.bot.cancel -width 5 -text {Cancel} \
-command [list destroy $w]
pack $w.bot.cancel -side left -expand yes
set l [llength $buttonList]
frame $w.bot.$i -relief sunken -border 1
- pack $w.bot.$i -side left -expand yes -padx 4 -pady 4
+ pack $w.bot.$i -side left -expand yes -padx 2 -pady 2
button $w.bot.$i.ok -text [lindex $buttonList $i] \
-command [lindex $buttonList [expr $i+1]]
- pack $w.bot.$i.ok -expand yes -ipadx 2 -ipady 2 -padx 2 -pady 2 -side left
+ pack $w.bot.$i.ok -expand yes -padx 2 -pady 2 -side left
incr i 2
while {$i < $l} {
button $w.bot.$i -text [lindex $buttonList $i] \
-command [lindex $buttonList [expr $i+1]]
- pack $w.bot.$i -expand yes -ipadx 2 -ipady 2 -padx 2 -pady 2 -side left
+ pack $w.bot.$i -expand yes -padx 2 -pady 2 -side left
incr i 2
}
if {$g} {
proc about-origin {} {
set w .about-origin-w
global libdir
+ global tk_version
if {[winfo exists $w]} {
destroy $w
label $w.top.a.logo -bitmap @${libdir}/bitmaps/book1
pack $w.top.a.irtcl $w.top.a.logo -side left -expand yes
- set i [z39 implementationName]
+ set i unknown
+ catch {set i [z39 implementationName]}
label $w.top.p.in -text "Implementation name: $i"
- set i [z39 implementationId]
+ catch {set i [z39 implementationId]}
label $w.top.p.ii -text "Implementation id: $i"
- set i [z39 implementationVersion]
+ catch {set i [z39 implementationVersion]}
label $w.top.p.iv -text "Implementation version: $i"
+ set i $tk_version
+ label $w.top.p.tk -text "Tk version: $i"
- pack $w.top.p.in $w.top.p.ii $w.top.p.iv -side top -anchor nw
+ pack $w.top.p.in $w.top.p.ii $w.top.p.iv $w.top.p.tk -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 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 {$b == -1} {
+ set b 0
+ while {[winfo exists .full-marc$b]} {
+ incr b
+ }
}
- if {[winfo exists $w]} {
- set new 0
- } else {
-
+ set df $popupMarcdf
+ set w .full-marc$b
+ if {![winfo exists $w]} {
toplevelG $w
wm minsize $w 0 0
$w.top.record tag configure marc-id -foreground black
}
$w.top.record tag configure marc-data -foreground black
- set new 1
- }
- $w.top.record delete 0.0 end
- set recordType [z39.$sno recordType $no]
- wm title $w "$recordType record #$no"
+ $w.top.record tag configure marc-head \
+ -font -Adobe-Times-Medium-R-Normal-*-180-* \
+ -background black -foreground white
- if {$new} {
- bind $w.top.record <Return> {destroy .full-marc}
-
pack $w.top.s -side right -fill y
pack $w.top.record -expand yes -fill both
- if {$b} {
- bottom-buttons $w [list \
- {Close} [list destroy $w]] 0
- } else {
- bottom-buttons $w [list \
- {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
- }
- pack $w.bot.formats -expand yes -ipadx 2 -ipady 2 \
- -padx 3 -pady 3 -side left
- }
+ bottom-buttons $w [list \
+ {Close} [list destroy $w] \
+ {Prev} {} \
+ {Next} {} \
+ {Duplicate} {}] 0
+ menubutton $w.bot.formats -text "Format" -menu $w.bot.formats.m \
+ -relief raised
+ menu $w.bot.formats.m
+ pack $w.bot.formats -expand yes -ipadx 2 -ipady 2 \
+ -padx 3 -pady 3 -side left
} else {
- set i 0
$w.bot.formats.m delete 0 last
- 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
- }
}
+ set i 0
+ foreach f $displayFormats {
+ $w.bot.formats.m add radiobutton -label $f \
+ -variable popupMarcdf -value $i \
+ -command [list popup-marc $sno $no $b 0]
+ incr i
+ }
+ $w.top.record delete 0.0 end
+ set recordType [z39.$sno recordType $no]
+ wm title $w "$recordType record #$no"
+
+ $w.bot.2 configure -command \
+ [list popup-marc $sno [expr $no-1] $b $df]
+ $w.bot.4 configure -command \
+ [list popup-marc $sno [expr $no+1] $b $df]
+ if {$no == 1} {
+ $w.bot.2 configure -state disabled
+ } else {
+ $w.bot.2 configure -state normal
+ }
+ if {[z39.$sno type [expr $no+1]] != "DB"} {
+ $w.bot.4 configure -state disabled
+ } else {
+ $w.bot.4 configure -state normal
+ }
+ $w.bot.6 configure -command [list popup-marc $sno $no -1 0]
set ffunc [lindex $displayFormats $df]
set ffunc "display-$ffunc"
.data.record delete 0.0 end
}
-proc title-press {y setno} {
- show-full-marc $setno [expr 1 + [.data.list nearest $y]] 0
-}
-
proc add-title-lines {setno no offset} {
global displayFormats
global displayFormat
}
# Databases ....
- pack $w.top.databases -side left -pady 4 -padx 4 -expand yes -fill both
+ pack $w.top.databases -side left -pady 2 -padx 2 -expand yes -fill both
label $w.top.databases.label -text "Databases"
button $w.top.databases.add -text "Add" \
button $w.top.databases.delete -text "Delete" \
-command [list delete-database $target]
if {! [tk4]} {
- listbox $w.top.databases.list -geometry 20x6 \
+ listbox $w.top.databases.list -geometry 14x6 \
-yscrollcommand "$w.top.databases.scroll set"
} else {
- listbox $w.top.databases.list -width 20 \
+ listbox $w.top.databases.list -width 14 -height 5\
-yscrollcommand "$w.top.databases.scroll set"
}
scrollbar $w.top.databases.scroll -orient vertical -border 1
}
# Transport ...
- pack $w.top.cs-type -pady 4 -padx 4 -side top -fill x
+ pack $w.top.cs-type -pady 2 -padx 2 -side top -fill x
label $w.top.cs-type.label -text "Transport"
radiobutton $w.top.cs-type.tcpip -text "TCP/IP" -anchor w \
-variable csRadioType -value mosi
pack $w.top.cs-type.label $w.top.cs-type.tcpip $w.top.cs-type.mosi \
- -padx 4 -side top -fill x
+ -padx 2 -side top -fill x
# Protocol ...
- pack $w.top.protocol -pady 4 -padx 4 -side top -fill x
+ pack $w.top.protocol -pady 2 -padx 2 -side top -fill x
label $w.top.protocol.label -text "Protocol"
radiobutton $w.top.protocol.z39v2 -text "Z39.50" -anchor w \
-variable protocolRadioType -value SR
pack $w.top.protocol.label $w.top.protocol.z39v2 $w.top.protocol.sr \
- -padx 4 -side top -fill x
+ -padx 2 -side top -fill x
# Query ...
- pack $w.top.query -pady 4 -padx 4 -side top -fill x
+ pack $w.top.query -pady 2 -padx 2 -side top -fill x
label $w.top.query.label -text "Query support"
checkbutton $w.top.query.c1 -text "RPN query" -anchor w -variable RPNCheck
pack $w.top.query.label -side top
pack $w.top.query.c1 $w.top.query.c2 $w.top.query.c3 \
- -padx 4 -side top -fill x
+ -padx 2 -side top -fill x
# Ok-cancel
bottom-buttons $w [list {Ok} [list protocol-setup-action $target] \
set windowGeometry(.) [wm geometry .]
- set f [open "~/.clientrc.tcl" w]
-
+ if {[catch {set f [open ~/.clientrc.tcl w]}]} {
+ return
+ }
puts $f "set hotTargets \{ $hotTargets \}"
puts $f "set textWrap $textWrap"
puts $f "set displayFormat $displayFormat"
if {$term != ""} {
set attr [lrange [lindex $queryInfoFind [lindex $b 1]] 1 end]
+ set relation ""
+ set len [string length $term]
+ incr len -1
+
+ if {$len > 1} {
+ if {[string index $term 0] == ">"} {
+ if {[string index $term 1] == "=" } {
+ set term [string trim [string range $term 2 $len]]
+ set relation 4
+ } else {
+ set term [string trim [string range $term 1 $len]]
+ set relation 5
+ }
+ } elseif {[string index $term 0] == "<"} {
+ if {[string index $term 1] == "=" } {
+ set term [string trim [string range $term 2 $len]]
+ set relation 2
+ } elseif {[string index $term 1] == ">"} {
+ set term [string trim [string range $term 2 $len]]
+ set relation 6
+ } else {
+ set term [string trim [string range $term 1 $len]]
+ set relation 1
+ }
+ }
+ }
set len [string length $term]
incr len -1
set left 0
} elseif {$left} {
set term "@attr 5=2 ${term}"
}
+ if {$relation != ""} {
+ set term "@attr 2=${relation} ${term}"
+ }
foreach a $attr {
set term "@attr $a ${term}"
}
.top.options.m.syntax add separator
.top.options.m.syntax add radiobutton -label "SUTRS" \
-value SUTRS -variable recordSyntax
+.top.options.m.syntax add separator
+.top.options.m.syntax add radiobutton -label "GRS1" \
+ -value GRS1 -variable recordSyntax
menubutton .top.help -text "Help" -menu .top.help.m
menu .top.help.m
index-lines .lines 1 $queryButtonsFind [lindex $queryInfo 0] activate-index
-button .mid.search -width 7 -text {Search} -command {search-request 0} \
+button .mid.search -text Search -command {search-request 0} \
-state disabled
-button .mid.scan -width 7 -text {Scan} \
+button .mid.scan -text Scan \
-command scan-request -state disabled
-button .mid.present -width 7 -text {Present} -command [list present-more 10] \
+button .mid.present -text {Present} -command [list present-more 10] \
-state disabled
-button .mid.clear -width 7 -text {Clear} -command index-clear
+button .mid.clear -text Clear -command index-clear
pack .mid.search .mid.scan .mid.present .mid.clear -side left \
- -fill y -padx 4 -pady 2
+ -fill y -pady 1
text .data.record -height 2 -width 20 -wrap none \
-yscrollcommand [list .data.scroll set] -wrap $textWrap
.data.record tag configure marc-id -foreground black
}
.data.record tag configure marc-data -foreground black
+.data.record tag configure marc-head \
+ -font -Adobe-Times-Medium-R-Normal-*-180-* \
+ -foreground white -background black
-button .bot.logo -bitmap @${libdir}/bitmaps/book1 -command cancel-operation
+button .bot.logo -bitmap @${libdir}/bitmaps/book1 -command cancel-operation
if {[tk4]} {
.bot.logo configure -takefocus 0
}
frame .bot.a
pack .bot.a -side left -fill x
-pack .bot.logo -side right -padx 2 -pady 2
+pack .bot.logo -side right -padx 2 -pady 2 -ipadx 1
message .bot.a.target -text "" -aspect 1000 -border 1
pack .bot.a.status .bot.a.set .bot.a.message \
-side left -padx 2 -pady 2 -ipadx 1 -ipady 1
-ir z39
-z39 logLevel all
+if {[catch {ir z39}]} {
+ set e [info sharedlibextension]
+ puts -nonewline "Loading irtcl$e ..."
+ load irtcl$e irtcl
+ ir z39
+ puts "ok"
+}
+#z39 logLevel all
show-logo 1
projects / ir-tcl-moved-to-github.git / blobdiff