Made the width of the query buttons dependable of the text width.
Extended get-attributeDetails so that it also gets information on Gils attributes.
wm title . "IrTcl Client"
wm title . "IrTcl Client"
-wm iconname . "IrTcl Client"
+#wm iconname . "IrTcl Client"
+proc debug-window {} {
+ set w .debug-window
+ toplevel $w
+
+ wm title $w "Debug Window"
+
+ frame $w.top -relief raised -border 1
+ frame $w.bot -relief raised -border 1
+ pack $w.top -side top -fill both -expand yes
+ pack $w.bot -fill both
+ scrollbar $w.top.s -command [list $w.top.t yview]
+ text $w.top.t -width 60 -height 10 -wrap word -relief flat -borderwidth 0 \
+ -font fixed -yscroll [list $w.top.s set]
+ pack $w.top.s -side right -fill y
+ pack $w.top.t -expand yes -fill both -expand y
+}
+debug-window
+
# Procedure configure-enable-e {w n}
# w is a menu
# Procedure configure-enable-e {w n}
# w is a menu
# If the bitmaps sub directory is present with a bitmap we assume
# the client is run from the source directory in which case we
# set libdir the current directory.
# If the bitmaps sub directory is present with a bitmap we assume
# the client is run from the source directory in which case we
# set libdir the current directory.
-if {[file readable bitmaps/book2]} {
+if {[file readable [file join bitmaps book2]]} {
set libdir .
}
# Make a final check to see if libdir was set ok.
set libdir .
}
# Make a final check to see if libdir was set ok.
-if {! [file readable ${libdir}/bitmaps/book2]} {
+if {! [file readable [file join $libdir bitmaps book2]]} {
puts "Cannot locate system files in ${libdir}. You must either run this"
puts "program from the source directory root of ir-tcl or you must assure"
puts "that it is installed - normally in /usr/local/lib/irtcl"
puts "Cannot locate system files in ${libdir}. You must either run this"
puts "program from the source directory root of ir-tcl or you must assure"
puts "that it is installed - normally in /usr/local/lib/irtcl"
}
# Read tag set file (if present)
}
# Read tag set file (if present)
-if {[file readable "${libdir}/tagsets.tcl"]} {
- source "${libdir}/tagsets.tcl"
+if {[file readable [file join $libdir tagsets.tcl]]} {
+ source [file join $libdir tagsets.tcl]
}
# Read the global target configuration file.
}
# Read the global target configuration file.
-if {[file readable "${libdir}/irtdb.tcl"]} {
- source "${libdir}/irtdb.tcl"
+if {[file readable [file join $libdir irtdb.tcl]]} {
+# source "${libdir}/irtdb.tcl"
+ source [file join $libdir irtdb.tcl]
}
# Read the local target configuration file.
if {[file readable "irtdb.tcl"]} {
}
# Read the local target configuration file.
if {[file readable "irtdb.tcl"]} {
}
# Read the user configuration file.
}
# Read the user configuration file.
-if {[file readable "${libdir}/.clientrc.tcl"]} {
- source "${libdir}/.clientrc.tcl"
+if {[file readable [file join $libdir .clientrc.tcl]]} {
+# source "${libdir}/.clientrc.tcl"
+ source [file join $libdir .clientrc.tcl]
global libdir
set oldDir [pwd]
global libdir
set oldDir [pwd]
+ cd [file join $libdir formats]
set formats [glob {*.[tT][cC][lL]}]
foreach f $formats {
if {[file readable $f]} {
set formats [glob {*.[tT][cC][lL]}]
foreach f $formats {
if {[file readable $f]} {
-# Procedure post-menu {wbutton wmenu}
-# wbutton button widget
-# wmenu menu widget
-# Post menu near button. Note: not used.
-proc post-menu {wbutton wmenu} {
- $wmenu activate none
- focus $wmenu
- $wmenu post [winfo rootx $wbutton] \
- [expr [winfo rooty $wbutton]+[winfo height $wbutton]]
-
-}
-
# Procedure destroyGW {w}
# w top level widget
# Saves geometry of widget w in windowGeometry array. This
# Procedure destroyGW {w}
# w top level widget
# Saves geometry of widget w in windowGeometry array. This
frame $w.bot.$i -relief sunken -border 1
pack $w.bot.$i -side left -expand yes -padx 2 -pady 2
button $w.bot.$i.ok -text [lindex $buttonList $i] \
frame $w.bot.$i -relief sunken -border 1
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]]
+ -command [lindex $buttonList [expr $i + 1]]
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] \
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]]
+ -command [lindex $buttonList [expr $i + 1]]
pack $w.bot.$i -expand yes -padx 2 -pady 2 -side left
incr i 2
}
pack $w.bot.$i -expand yes -padx 2 -pady 2 -side left
incr i 2
}
if {$v1==10} {
set v1 1
}
if {$v1==10} {
set v1 1
}
- .bot.logo configure -bitmap @${libdir}/bitmaps/book${v1}
+ .bot.logo configure -bitmap @[file join $libdir bitmaps book${v1}]
after 140 [list show-logo $v1]
return
}
while {1} {
after 140 [list show-logo $v1]
return
}
while {1} {
- .bot.logo configure -bitmap @${libdir}/bitmaps/book1
+ .bot.logo configure -bitmap @[file join $libdir bitmaps book1]
tkwait variable busy
if {$busy} {
show-logo 1
tkwait variable busy
if {$busy} {
show-logo 1
pack $w.top.s -side right -fill y
pack $w.top.t -expand yes -fill both
pack $w.top.s -side right -fill y
pack $w.top.t -expand yes -fill both
- if {[file readable "${libdir}/LICENSE"]} {
- set f [open "${libdir}/LICENSE" r]
+ if {[file readable [file join $libdir LICENSE]]} {
+ set f [open [file join $libdir LICENSE] r]
while {[gets $f buf] != -1} {
$w.top.t insert end $buf
$w.top.t insert end "\n"
while {[gets $f buf] != -1} {
$w.top.t insert end $buf
$w.top.t insert end "\n"
- $w.top.a.logo configure -bitmap @${libdir}/bitmaps/book$n
+ $w.top.a.logo configure -bitmap @[file join $libdir bitmaps book$n]
after 140 [list about-origin-logo $n]
}
after 140 [list about-origin-logo $n]
}
pack $w.top.a $w.top.p -side top -fill x
label $w.top.a.irtcl -text "IrTcl" -font $font(bb,bold)
pack $w.top.a $w.top.p -side top -fill x
label $w.top.a.irtcl -text "IrTcl" -font $font(bb,bold)
- label $w.top.a.logo -bitmap @${libdir}/bitmaps/book1
+ label $w.top.a.logo -bitmap @[file join $libdir bitmaps book1]
pack $w.top.a.irtcl $w.top.a.logo -side left -expand yes
set i unknown
pack $w.top.a.irtcl $w.top.a.logo -side left -expand yes
set i unknown
+# tkerror "$m ($c)"
+ bgerror "$m ($c)"
}
# Procedure connect-response {target base}
}
# Procedure connect-response {target base}
} errorMessage]
if {$err} {
set hostid Default
} errorMessage]
if {$err} {
set hostid Default
+# tkerror $errorMessage
+ bgerror $errorMessage
show-status "Not connected" 0 {}
show-target {} {}
return
show-status "Not connected" 0 {}
show-target {} {}
return
show-status Initializing 1 {}
set err [catch {z39 init} errorMessage]
if {$err} {
show-status Initializing 1 {}
set err [catch {z39 init} errorMessage]
if {$err} {
+# tkerror $errorMessage
+ bgerror $errorMessage
show-status Ready 0 {}
}
}
show-status Ready 0 {}
}
}
if {![z39 initResult]} {
set u [z39 userInformationField]
close-target
if {![z39 initResult]} {
set u [z39 userInformationField]
close-target
- tkerror "Connection rejected by target: $u"
+# tkerror "Connection rejected by target: $u"
+ bgerror "Connection rejected by target: $u"
} else {
z39 failback [list explain-crash $target $base]
explain-check $target [list ready-response $base] $base
} else {
z39 failback [list explain-crash $target $base]
explain-check $target [list ready-response $base] $base
#This procedure take care of all the actions that should start if connect is succesfull.
proc ready-response-actions {target base} {
global profile queryAuto
#This procedure take care of all the actions that should start if connect is succesfull.
proc ready-response-actions {target base} {
global profile queryAuto
-# get-attributeDetails $target $base
- changeQueryButtons $target $base
+# changeQueryButtons $target $base
configureOptionsSyntax $target $base
if {[info exists profile($target,AttributeDetails,$base,Bib1Use)] && $queryAuto == 1} {
changeQueryButtons $target $base
change-queryInfo $target $base
query-select 2
.top.options.m.query.slist entryconfigure 2 -state normal
configureOptionsSyntax $target $base
if {[info exists profile($target,AttributeDetails,$base,Bib1Use)] && $queryAuto == 1} {
changeQueryButtons $target $base
change-queryInfo $target $base
query-select 2
.top.options.m.query.slist entryconfigure 2 -state normal
} else {
query-select 0
.top.options.m.query.slist entryconfigure 2 -state disabled
} else {
query-select 0
.top.options.m.query.slist entryconfigure 2 -state disabled
}
set status [z39.scan scanStatus]
if {$status == 6} {
}
set status [z39.scan scanStatus]
if {$status == 6} {
+# tkerror "Scan fail"
+ bgerror "Scan fail"
show-status Ready 0 1
set cancelFlag 0
return
show-status Ready 0 1
set cancelFlag 0
return
set code [lindex $status 1]
set msg [lindex $status 2]
set addinfo [lindex $status 3]
set code [lindex $status 1]
set msg [lindex $status 2]
set addinfo [lindex $status 3]
- tkerror "NSD$code: $msg: $addinfo"
+# tkerror "NSD$code: $msg: $addinfo"
+ bgerror "NSD$code: $msg: $addinfo"
return
}
show-message "${setMax} hits"
return
}
show-message "${setMax} hits"
set code [lindex $status 1]
set msg [lindex $status 2]
set addinfo [lindex $status 3]
set code [lindex $status 1]
set msg [lindex $status 2]
set addinfo [lindex $status 3]
- tkerror "NSD$code: $msg: $addinfo"
+# tkerror "NSD$code: $msg: $addinfo"
+ bgerror "NSD$code: $msg: $addinfo"
return
}
if {$no > 0 && $setOffset <= $setMax} {
return
}
if {$no > 0 && $setOffset <= $setMax} {
set g [wm geometry $parent]
set p1 [string first + $g]
set p2 [string last + $g]
set g [wm geometry $parent]
set p1 [string first + $g]
set p2 [string last + $g]
- set x [expr 40+[string range $g [expr $p1 +1] [expr $p2 -1]]]
- set y [expr 60+[string range $g [expr $p2 +1] end]]
+ set x [expr 40+[string range $g [expr {$p1 + 1}] [expr {$p2 -1}]]]
+ set y [expr 60+[string range $g [expr {$p2 + 1}] end]]
wm geometry $window +${x}+${y}
}
wm geometry $window +${x}+${y}
}
.top.target.m.clist delete 0 last
foreach nn [lsort [array names profile *,host]] {
if {[string length $profile($nn)]} {
.top.target.m.clist delete 0 last
foreach nn [lsort [array names profile *,host]] {
if {[string length $profile($nn)]} {
- set ll [expr [string length $nn] - 6]
+ set ll [expr {[string length $nn] - 6}]
set n [string range $nn 0 $ll]
set nl $profile($n,windowNumber)
set n [string range $nn 0 $ll]
set nl $profile($n,windowNumber)
}
.top.target.m.slist delete 0 last
foreach nn [lsort [array names profile *,host]] {
}
.top.target.m.slist delete 0 last
foreach nn [lsort [array names profile *,host]] {
- set ll [expr [string length $nn] - 6]
+ set ll [expr {[string length $nn] - 6}]
set n [string range $nn 0 $ll]
.top.target.m.slist add command -label $n -command [list protocol-setup $n]
}
set n [string range $nn 0 $ll]
.top.target.m.slist add command -label $n -command [list protocol-setup $n]
}
proc save-settings {} {
global profile libdir settingsChanged queryTypes queryButtons queryInfo queryAuto
proc save-settings {} {
global profile libdir settingsChanged queryTypes queryButtons queryInfo queryAuto
- if {[file writable "${libdir}/irtdb.tcl"]} {
- set f [open "${libdir}/irtdb.tcl" w]
+ if {[file writable [file join $libdir irtdb.tcl]]} {
+ set f [open [file join $libdir irtdb.tcl] w]
} else {
set f [open "irtdb.tcl" w]
}
} else {
set f [open "irtdb.tcl" w]
}
# user user argument to the $handle function
# Makes an extended listbutton.
proc listbuttonx {button no names handle user} {
# user user argument to the $handle function
# Makes an extended listbutton.
proc listbuttonx {button no names handle user} {
+ set width 10
+ foreach name $names {
+ set buttonName [lindex $name 0]
+ if {[string length $buttonName] > $width} {
+ set width [string length $buttonName]
+ }
+ }
if {[winfo exists $button]} {
if {[winfo exists $button]} {
- $button configure -text [lindex [lindex $names $no] 0]
+ $button configure -width $width -text [lindex [lindex $names $no] 0]
${button}.m delete 0 last
} else {
menubutton $button -text [lindex [lindex $names $no] 0] \
${button}.m delete 0 last
} else {
menubutton $button -text [lindex [lindex $names $no] 0] \
- -width 15 -menu ${button}.m -relief raised -border 1
+ -width $width -menu ${button}.m -relief raised -border 1
irmenu ${button}.m
${button}.m configure -tearoff off
}
irmenu ${button}.m
${button}.m configure -tearoff off
}
proc listbuttonv-action {button var names i} {
global $var
proc listbuttonv-action {button var names i} {
global $var
- set $var [lindex $names [expr $i+1]]
+ set $var [lindex $names [expr {$i+1}]]
$button configure -text [lindex $names $i]
}
$button configure -text [lindex $names $i]
}
set l [llength $names]
for {set i 1} {$i < $l} {incr i 2} {
if {$val == [lindex $names $i]} {
set l [llength $names]
for {set i 1} {$i < $l} {incr i 2} {
if {$val == [lindex $names $i]} {
$w.top.use.list yview $s
} else {
set lno [lindex [$w.top.use.list curselection] 0]
$w.top.use.list yview $s
} else {
set lno [lindex [$w.top.use.list curselection] 0]
- set i [expr $lno+$lno+1]
+ set i [expr {$lno+$lno+1}]
set useTmpValue [lindex $attr $i]
dputs "useTmpValue=$useTmpValue"
}
set useTmpValue [lindex $attr $i]
dputs "useTmpValue=$useTmpValue"
}
set q [lindex $attr $i]
set l [string first = $q]
if {$l > 0} {
set q [lindex $attr $i]
set l [string first = $q]
if {$l > 0} {
- set t [string range $q 0 [expr $l - 1]]
- set v [string range $q [expr $l + 1] end]
+ set t [string range $q 0 [expr {$l - 1}]]
+ set v [string range $q [expr {$l + 1}] end]
switch $t {
1
{ set useTmpValue $v }
switch $t {
1
{ set useTmpValue $v }
set right 0
if {[string index $term $len] == "?"} {
set right 1
set right 0
if {[string index $term $len] == "?"} {
set right 1
- set term [string range $term 0 [expr $len - 1]]
+ set term [string range $term 0 [expr {$len - 1}]]
}
if {[string index $term 0] == "?"} {
set left 1
}
if {[string index $term 0] == "?"} {
set left 1
# w index frame
# i index number
# This procedure handles <FocusIn> events. A red border is drawed
# w index frame
# i index number
# This procedure handles <FocusIn> events. A red border is drawed
-# around the active search entry field when tk3.6 is used (tk4.X
-# makes a black focus border itself).
+# around the active search entry field.
proc index-focus-in {w i} {
global curIndexEntry
$w.$i configure -background red
proc index-focus-in {w i} {
global curIndexEntry
$w.$i configure -background red
set j 0
incr i -1
while {$j < $i} {
set j 0
incr i -1
while {$j < $i} {
bind $w.$j.e <Tab> "focus $w.$k.e"
set j $k
}
bind $w.$j.e <Tab> "focus $w.$k.e"
set j $k
}
if {$activate == 0} {
$w invoke $i
set recordSyntax $syntax
if {$activate == 0} {
$w invoke $i
set recordSyntax $syntax
-# .debug-window.top.t insert end $recordSyntax\n
-# .debug-window.top.t insert end $syntax
set activate 1
}
} else {
set activate 1
}
} else {
menubutton .top.help -text "Help" -menu .top.help.m
irmenu .top.help.m
menubutton .top.help -text "Help" -menu .top.help.m
irmenu .top.help.m
-.top.help.m add command -label "Help on help" \
- -command {tkerror "Help on help not available. Sorry"}
+#.top.help.m add command -label "Help on help" -command {tkerror "Help on help not available. Sorry"}
+.top.help.m add command -label "Help on help" -command {bgerror "Help on help not available. Sorry"}
.top.help.m add command -label "About" -command {about-origin}
# Init: Pack menu bar items.
.top.help.m add command -label "About" -command {about-origin}
# Init: Pack menu bar items.
# Init: Define query area.
index-lines .lines 1 $queryButtonsFind [lindex $queryInfo 0] activate-index
# Init: Define query area.
index-lines .lines 1 $queryButtonsFind [lindex $queryInfo 0] activate-index
-image create photo scan -file ${libdir}/bitmaps/a-z.gif
-image create photo clear -file ${libdir}/bitmaps/trash.gif
-image create photo present -file ${libdir}/bitmaps/page.gif
-image create photo search -file ${libdir}/bitmaps/search.gif
+image create photo scan -file [file join $libdir bitmaps a-z.gif]
+image create photo clear -file [file join $libdir bitmaps trash.gif]
+image create photo present -file [file join $libdir bitmaps page.gif]
+image create photo search -file [file join $libdir bitmaps search.gif]
button .mid.search -image search -command {search-request 0} -state disabled -relief flat
button .mid.scan -image scan -command scan-request -state disabled -relief flat
button .mid.present -image present -command [list present-more 10] -state disabled -relief flat
button .mid.search -image search -command {search-request 0} -state disabled -relief flat
button .mid.scan -image scan -command scan-request -state disabled -relief flat
button .mid.present -image present -command [list present-more 10] -state disabled -relief flat
.data.record tag configure marc-it -font $font(n,normal) -foreground black
# Init: Define logo.
.data.record tag configure marc-it -font $font(n,normal) -foreground black
# Init: Define logo.
-button .bot.logo -bitmap @${libdir}/bitmaps/book1 -command cancel-operation
+button .bot.logo -bitmap @[file join $libdir bitmaps book1] -command cancel-operation
.bot.logo configure -takefocus 0
# Init: Define status information fields at the bottom.
.bot.logo configure -takefocus 0
# Init: Define status information fields at the bottom.
if {[catch {ir z39}]} {
set e [info sharedlibextension]
puts -nonewline "Loading irtcl$e ..."
if {[catch {ir z39}]} {
set e [info sharedlibextension]
puts -nonewline "Loading irtcl$e ..."
- load ${libdir}/irtcl$e irtcl
+ load [file join $libdir irtcl$e] irtcl
-if {[file exists ${libdir}/explain.tcl]} {
- source ${libdir}/explain.tcl
+if {[file exists [file join $libdir explain.tcl]]} {
+ source [file join $libdir explain.tcl]
}
#if {[file exists ${libdir}/setup.tcl]}
}
#if {[file exists ${libdir}/setup.tcl]}
- source ${libdir}/setup.tcl
+ source [file join $libdir setup.tcl]
# Init: Uncomment this line if you wan't to enable logging.
# Init: Uncomment this line if you wan't to enable logging.
-proc debug-window {} {
- set w .debug-window
- toplevel $w
-
- wm title $w "Debug Window"
-
- top-down-window $w
- scrollbar $w.top.s -command [list $w.top.t yview]
- text $w.top.t -width 60 -height 10 -wrap word -relief flat -borderwidth 0 \
- -font fixed -yscroll [list $w.top.s set]
- pack $w.top.s -side right -fill y
- pack $w.top.t -expand yes -fill both -expand y
-}
-debug-window
-
#Procedure get-attributeDetails
#If the target supports explain the Attribute Details are extracted here.
#Procedure get-attributeDetails
#If the target supports explain the Attribute Details are extracted here.
-#The number 1.2.840.10003.3.1 is Bib1 and 1.2.840.10003.3.2 is Gils.
+#The number 1.2.840.10003.3.1 is Bib1, 1.2.840.10003.3.2 is Explain and 1.2.840.10003.3.5 is Gils.
proc get-attributeDetails {target base} {
global profile
set index 1
proc get-attributeDetails {target base} {
global profile
set index 1
+ } elseif {[lindex [lindex $tagset 0] 1] == "1.2.840.10003.3.5"} {
+# .debug-window.top.t insert end Gils\n
+ foreach attributeType [lindex $tagset 1] {
+# .debug-window.top.t insert end [lindex $tagset 1]
+ if {[lindex [lindex $attributeType 0] 1] == 1} {
+ foreach attributeValues [lrange [lindex $attributeType 2] 1 end] {
+ lappend profile($target,AttributeDetails,$db,Gils) [lindex [lindex [lindex $attributeValues 0] 1] 1]
+# .debug-window.top.t insert end [lindex [lindex [lindex $attributeValues 0] 1] 1]\n
+ }
+ }
+ }
set profile(BIBSYS,targetInfoName) {}
set profile(BIBSYS,timeDefine) 878567355
set profile(BIBSYS,timeLastExplain) {}
set profile(BIBSYS,targetInfoName) {}
set profile(BIBSYS,timeDefine) 878567355
set profile(BIBSYS,timeLastExplain) {}
-set profile(BIBSYS,timeLastInit) 908185845
+set profile(BIBSYS,timeLastInit) 908265242
set profile(BIBSYS,welcomeMessage) {}
set profile(BIBSYS,windowNumber) 3
set profile(Bagel:210,AttributeDetails,gils,Bib1Use) {1012 1019 1007 62 1005 4}
set profile(BIBSYS,welcomeMessage) {}
set profile(BIBSYS,windowNumber) 3
set profile(Bagel:210,AttributeDetails,gils,Bib1Use) {1012 1019 1007 62 1005 4}
+set profile(Bagel:210,AttributeDetails,gils,Gils) {1012 1019 1007 62 1005 4 2032 2029 2067 2026 2025 2024 2023 2005 2066 2018 2016 2014 2011 2000 2008 2007 2006 2045 2041 2040 2039 2038 2059}
set profile(Bagel:210,AttributeDetails,marc,Bib1Use) {1005 30 1018 1006 59 4 1003 1004}
set profile(Bagel:210,RecordSyntaxes,gils) {SUTRS GRS1 USMARC}
set profile(Bagel:210,authentication) {}
set profile(Bagel:210,AttributeDetails,marc,Bib1Use) {1005 30 1018 1006 59 4 1003 1004}
set profile(Bagel:210,RecordSyntaxes,gils) {SUTRS GRS1 USMARC}
set profile(Bagel:210,authentication) {}
set profile(Bagel:210,smallSetUpperBound) 0
set profile(Bagel:210,targetInfoName) Zebra
set profile(Bagel:210,timeDefine) {}
set profile(Bagel:210,smallSetUpperBound) 0
set profile(Bagel:210,targetInfoName) Zebra
set profile(Bagel:210,timeDefine) {}
-set profile(Bagel:210,timeLastExplain) 908184800
-set profile(Bagel:210,timeLastInit) 908184800
+set profile(Bagel:210,timeLastExplain) 908206139
+set profile(Bagel:210,timeLastInit) 908206139
set profile(Bagel:210,welcomeMessage) {}
set profile(Bagel:210,windowNumber) 1
set {profile(Bell Laboratories Library Network,authentication)} {}
set profile(Bagel:210,welcomeMessage) {}
set profile(Bagel:210,windowNumber) 1
set {profile(Bell Laboratories Library Network,authentication)} {}