# Sebastian Hammer, Adam Dickmeiss
#
# $Log: client.tcl,v $
-# Revision 1.49 1995-06-20 14:16:42 adam
+# Revision 1.54 1995-06-27 14:41:03 adam
+# Bug fix in search-response. Didn't always observe non-surrogate diagnostics.
+#
+# Revision 1.53 1995/06/26 12:40:09 adam
+# Client defines its own tkerror.
+# User may specify 'no preferredRecordSyntax'.
+#
+# Revision 1.52 1995/06/22 13:14:59 adam
+# Feature: SUTRS. Setting getSutrs implemented.
+# Work on display formats.
+# Preferred record syntax can be set by the user.
+#
+# Revision 1.51 1995/06/21 11:11:00 adam
+# Bug fix: libdir undefined in about-origin.
+#
+# Revision 1.50 1995/06/21 11:04:48 adam
+# Uses GNU autoconf 2.3.
+# Install procedure implemented.
+# boook bitmaps moved to sub directory bitmaps.
+#
+# Revision 1.49 1995/06/20 14:16:42 adam
# More work on cancel mechanism.
#
# Revision 1.48 1995/06/20 08:07:23 adam
# First presentRequest attempts. Hot-target list.
#
#
+
+set libdir LIBDIR
+if {[file readable clientrc.tcl]} {
+ set libdir .
+}
set hotTargets {}
set hotInfo {}
set busy 0
-set libDir ""
-
set profile(Default) {{} {} {210} {} 16384 8192 tcpip {} 1 {} {} Z39}
set hostid Default
set settingsChanged 0
set displayFormat 1
set popupMarcdf 0
set textWrap word
+set recordSyntax None
set delayRequest {}
set queryTypes {Simple}
set setOffset 0
set setMax 0
+proc tkerror err {
+ set w .tkerrorw
+
+ if {[winfo exists $w]} {
+ destroy $w
+ }
+ toplevel $w
+ wm title $w "Error"
+
+ place-force $w .
+ top-down-window $w
+
+ label $w.top.b -bitmap error
+ message $w.top.t -aspect 300 -text "Error: $err" \
+ -font -Adobe-Helvetica-Bold-R-Normal-*-240-*
+ pack $w.top.b $w.top.t -side left -padx 10 -pady 10
+
+ bottom-buttons $w [list {Close} [list destroy $w]] 0
+}
+
proc read-formats {} {
global displayFormats
- set formats [glob -nocomplain formats/*.tcl]
+ global libdir
+ set formats [glob -nocomplain ${libdir}/formats/*.tcl]
foreach f $formats {
- source $f
- set l [expr [string length $f] - 5]
- lappend displayFormats [string range $f 8 $l]
+ if {[file readable $f]} {
+ source $f
+ set l [string length $f]
+ set f [string range $f [string length "${libdir}/formats/"] \
+ [expr $l - 5]]
+ lappend displayFormats $f
+ }
}
}
}
proc dputs {m} {
- puts $m
+# puts $m
}
proc set-display-format {f} {
.bot.a.status configure -text "Reformatting"
}
update idletasks
- add-title-lines 0 10000 1
+ add-title-lines -1 10000 1
if {!$busy} {
.bot.a.status configure -text "Ready"
}
bind $w <Destroy> [list destroyGW $w]
}
-if {[file readable "clientrc.tcl"]} {
- source "clientrc.tcl"
+if {[file readable "${libdir}/clientrc.tcl"]} {
+ source "${libdir}/clientrc.tcl"
}
-if {[file readable "clientg.tcl"]} {
- source "clientg.tcl"
+if {[file readable "~/.clientrc.tcl"]} {
+ source "~/.clientrc.tcl"
}
set queryButtonsFind [lindex $queryButtons 0]
proc show-logo {v1} {
global busy
+ global libdir
+
if {$busy != 0} {
incr v1
if {$v1==10} {
set v1 1
}
- .bot.logo configure -bitmap @book${v1}
+ .bot.logo configure -bitmap @${libdir}/bitmaps/book${v1}
after 140 [list show-logo $v1]
return
}
while {1} {
- .bot.logo configure -bitmap @book1
+ .bot.logo configure -bitmap @${libdir}/bitmaps/book1
tkwait variable busy
if {$busy} {
show-logo 1
}
proc popup-license {} {
+ global libdir
set w .popup-licence
toplevel $w
pack $w.top.s -side right -fill y
pack $w.top.t -expand yes -fill both
- set f [open "LICENSE" r]
- while {[gets $f buf] != -1} {
- $w.top.t insert end $buf
- $w.top.t insert end "\n"
- }
- close $f
+ if {[file readable "${libdir}/LICENSE"]} {
+ set f [open "${libdir}/LICENSE" r]
+ while {[gets $f buf] != -1} {
+ $w.top.t insert end $buf
+ $w.top.t insert end "\n"
+ }
+ close $f
+ }
bottom-buttons $w [list {Close} [list destroy $w]] 1
}
toplevel $w
wm title $w "About target"
+ place-force $w .
top-down-window $w
frame $w.top.a -relief ridge -border 2
}
proc about-origin-logo {n} {
+ global libdir
set w .about-origin-w
if {![winfo exists $w]} {
return
if {$n==10} {
set n 1
}
- $w.top.a.logo configure -bitmap @book$n
+ $w.top.a.logo configure -bitmap @${libdir}/bitmaps/book$n
after 140 [list about-origin-logo $n]
}
proc about-origin {} {
set w .about-origin-w
+ global libdir
if {[winfo exists $w]} {
destroy $w
label $w.top.a.irtcl -text "IrTcl" \
-font -Adobe-Helvetica-Bold-R-Normal-*-240-*
- label $w.top.a.logo -bitmap @book1
+ 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 recordType [z39.$sno recordType $no]
wm title $w "$recordType record #$no"
- set ffunc [lindex $displayFormats $df]
- set ffunc "display-$ffunc"
-
- $ffunc $sno $no $w.top.record 0
-
if {$new} {
bind $w.top.record <Return> {destroy .full-marc}
incr i
}
}
+ set ffunc [lindex $displayFormats $df]
+ set ffunc "display-$ffunc"
+
+ $ffunc $sno $no $w.top.record 0
}
proc update-target-hotlist {target base} {
show-status Ready 0 {}
return
}
-# z39 options search present scan namedResultSets triggerResourceCtrl
set hostid $target
.top.target.m disable 0
.top.target.m enable 1
global busy
global cancelFlag
global delayRequest
+ global recordSyntax
set target $hostid
if {[lindex $profile($target) 9] == 1} {
z39.$setNo queryType ccl
}
+ dputs Setting
+ dputs $recordSyntax
+ if {$recordSyntax == "None" } {
+ z39.$setNo preferredRecordSyntax {}
+ } else {
+ z39.$setNo preferredRecordSyntax $recordSyntax
+ }
z39 callback {search-response}
z39.$setNo search $query
show-status {Searching} 1 0
set delayRequest {}
init-title-lines
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 msg [lindex $status 2]
- set addinfo [lindex $status 3]
- tkerror "NSD$code: $msg: $addinfo"
- }
+ show-status {Ready} 0 1
+ set status [z39.$setNo responseStatus]
+ if {[lindex $status 0] == "NSD"} {
+ set setOffset 0
+ set code [lindex $status 1]
+ set msg [lindex $status 2]
+ set addinfo [lindex $status 3]
+ tkerror "NSD$code: $msg: $addinfo"
return
}
if {$setMax > 20} {
set setMax 20
}
+ show-message "${setMax} hits"
set setOffset 1
show-status {Ready} 0 1
+ set l [format "%-4d %7d" $setNo $setMax]
+ .top.rset.m add command -label $l \
+ -command [list add-title-lines $setNo 10000 1]
z39 callback {present-response}
z39.$setNo present $setOffset 1
show-status {Retrieving} 1 0
global displayFormat
global lastSetNo
- if {$setno == 0} {
+ if {$setno == -1} {
set setno $lastSetNo
} else {
set lastSetNo $setno
.data.record delete 0.0 end
}
set ffunc [lindex $displayFormats $displayFormat]
+ dputs "ffunc=$ffunc"
set ffunc "display-$ffunc"
for {set i 0} {$i < $no} {incr i} {
set o [expr $i + $offset]
global textWrap
global displayFormat
global popupMarcdf
+ global recordSyntax
set windowGeometry(.) [wm geometry .]
- set f [open "clientg.tcl" w]
+ set f [open "~/.clientrc.tcl" w]
puts $f "set hotTargets \{ $hotTargets \}"
puts $f "set textWrap $textWrap"
puts $f "set displayFormat $displayFormat"
puts $f "set popupMarcdf $popupMarcdf"
+ puts $f "set recordSyntax $recordSyntax"
foreach n [array names windowGeometry] {
puts -nonewline $f "set \{windowGeometry($n)\} \{"
puts -nonewline $f $windowGeometry($n)
proc save-settings {} {
global profile
+ global libdir
global settingsChanged
global queryTypes
global queryButtons
global queryInfo
-
- set f [open "clientrc.tcl" w]
+
+ if {![file writable "${libdir}/clientrc.tcl"]} {
+ return
+ }
+ set f [open "${libdir}/clientrc.tcl" w]
puts $f "# Setup file"
foreach n [array names profile] {
.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
+.top.options.m add cascade -label "Syntax" -menu .top.options.m.syntax
menu .top.options.m.query
.top.options.m.query add cascade -label "Select" \
.top.options.m.wrap add radiobutton -label "None" \
-value none -variable textWrap -command {set-wrap none}
+menu .top.options.m.syntax
+.top.options.m.syntax add radiobutton -label "None" \
+ -value None -variable recordSyntax
+.top.options.m.syntax add separator
+.top.options.m.syntax add radiobutton -label "USMARC" \
+ -value USMARC -variable recordSyntax
+.top.options.m.syntax add radiobutton -label "UNIMARC" \
+ -value UNIMARC -variable recordSyntax
+.top.options.m.syntax add radiobutton -label "UKMARC" \
+ -value UKMARC -variable recordSyntax
+.top.options.m.syntax add radiobutton -label "DANMARC" \
+ -value DANMARC -variable recordSyntax
+.top.options.m.syntax add radiobutton -label "FINMARC" \
+ -value FINMARC -variable recordSyntax
+.top.options.m.syntax add radiobutton -label "NORMARC" \
+ -value NORMARC -variable recordSyntax
+.top.options.m.syntax add radiobutton -label "PICAMARC" \
+ -value PICAMARC -variable recordSyntax
+.top.options.m.syntax add separator
+.top.options.m.syntax add radiobutton -label "SUTRS" \
+ -value SUTRS -variable recordSyntax
+
menubutton .top.help -text "Help" -menu .top.help.m
menu .top.help.m
}
.data.record tag configure marc-data -foreground black
-button .bot.logo -bitmap @book1 -command cancel-operation
+button .bot.logo -bitmap @${libdir}/bitmaps/book1 -command cancel-operation
frame .bot.a
pack .bot.a -side left -fill x
pack .bot.logo -side right -padx 2 -pady 2
projects / ir-tcl-moved-to-github.git / blobdiff