# Sebastian Hammer, Adam Dickmeiss
#
# $Log: client.tcl,v $
-# Revision 1.83 1995-11-28 17:26:36 adam
+# Revision 1.85 1996-01-19 16:22:36 adam
+# New method: apduDump - returns information about last incoming APDU.
+#
+# Revision 1.84 1996/01/11 13:12:10 adam
+# Bug fix.
+#
+# Revision 1.83 1995/11/28 17:26:36 adam
# Removed Carriage return from ir-tcl.c!
# Removed misc. debug logs.
#
set recordSyntax None
set elementSetNames None
set delayRequest {}
+set debugMode 0
set queryTypes {Simple}
set queryButtons { { {I 0} {I 1} {I 2} } }
proc read-formats {} {
global displayFormats
global libdir
- if {[catch {set formats [glob -nocomplain ${libdir}/formats/*.tcl]}]} {
- set formats ./formats/raw.tcl
- }
+
+ set oldDir [pwd]
+ cd ${libdir}/formats
+ set formats [glob {*.[tT][cC][lL]}]
foreach f $formats {
if {[file readable $f]} {
source $f
set l [string length $f]
- set f [string range $f [string length "${libdir}/formats/"] \
- [expr $l - 5]]
+ set f [string tolower [string range $f 0 [expr $l - 5]]]
lappend displayFormats $f
}
}
+ cd $oldDir
}
proc set-wrap {m} {
}
proc dputs {m} {
-# puts $m
+ global debugMode
+ if {$debugMode} {
+ puts $m
+ }
+}
+
+proc apduDump {} {
+ global debugMode
+
+ set w .apdu
+
+ if {$debugMode == 0} return
+ set x [z39 apduInfo]
+
+ set offset [lindex $x 1]
+ set length [lindex $x 0]
+
+ if {![winfo exists $w]} {
+ catch {destroy $w}
+ toplevelG $w
+
+ wm title $w "APDU information"
+
+ wm minsize $w 0 0
+
+ top-down-window $w
+
+ text $w.top.t -width 60 -height 12 -wrap word -relief flat \
+ -borderwidth 0 \
+ -yscrollcommand [list $w.top.s set]
+ scrollbar $w.top.s -command [list $w.top.t yview]
+
+ pack $w.top.s -side right -fill y
+ pack $w.top.t -expand yes -fill both
+
+ bottom-buttons $w [list {Close} [list destroy $w]] 0
+ }
+ $w.top.t insert end "Length: ${length}\n"
+ if {$offset != -1} {
+ $w.top.t insert end "Offset: ${offset}\n"
+ }
+ $w.top.t insert end [lindex $x 2]
+ $w.top.t insert end "---------------------------------\n"
+
}
+
proc set-display-format {f} {
global displayFormat
global setNo
}
proc fail-response {target} {
+ global debugMode
+
set c [lindex [z39 failInfo] 0]
set m [lindex [z39 failInfo] 1]
+ if {$c == 4 || $c == 5} {
+ set debugMode 1
+ apduDump
+ }
close-target
tkerror "$m ($c)"
}
global scanEnable
dputs {init-reponse}
+ apduDump
if {$cancelFlag} {
close-target
return
set w .scan-window
dputs "In scan-response"
+ apduDump
set m [z39.scan numberOfEntriesReturned]
dputs $m
dputs attr=$attr
global delayRequest
global presentChunk
-
+ apduDump
dputs "In search-response"
if {$cancelFlag} {
dputs "Handling cancel"
global presentChunk
dputs "In present-response"
+ apduDump
set no [z39.$setNo numberOfRecordsReturned]
dputs "Returned $no records, setOffset $setOffset"
add-title-lines $setNo $no $setOffset
return
}
if {$hostid != "Default"} {
- puts $f "set hostid $hostid"
+ puts $f "set hostid \{$hostid\}"
set b [z39 databaseNames]
puts $f "set hostbase $b"
}
.top.options.m add cascade -label "Wrap" -menu .top.options.m.wrap
.top.options.m add cascade -label "Syntax" -menu .top.options.m.syntax
.top.options.m add cascade -label "Elements" -menu .top.options.m.elements
+.top.options.m add radiobutton -label "Debug" -variable debugMode -value 1
menu .top.options.m.query
.top.options.m.query add cascade -label "Select" \