X-Git-Url: http://lists.indexdata.dk/cgi-bin?a=blobdiff_plain;f=client.tcl;h=0418f81a8286f04ed312de0c928137fe0b9b9932;hb=e459d736be55fb2aa12cc1d3721c00cda1ad062d;hp=31f724bf6c09a2d09cc93eb93963b4e5c030a104;hpb=6b7704f0e063b05c5817dd4dd8d3d4dedea22499;p=ir-tcl-moved-to-github.git

diff --git a/client.tcl b/client.tcl
index 31f724b..0418f81 100644
--- a/client.tcl
+++ b/client.tcl
@@ -4,7 +4,23 @@
 # Sebastian Hammer, Adam Dickmeiss
 #
 # $Log: client.tcl,v $
-# Revision 1.48  1995-06-20 08:07:23  adam
+# 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
 # New setting: failInfo.
 # Working on better cancel mechanism.
 #
@@ -168,24 +184,27 @@
 # 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 setNo 0
 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 recordSyntax USMARC
 set delayRequest {}
 
 set queryTypes {Simple}
@@ -199,11 +218,16 @@ set setMax 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
+        }
     }
 }
 
@@ -215,7 +239,7 @@ proc set-wrap {m} {
 }
 
 proc dputs {m} {
-    puts $m
+#    puts $m
 }
 
 proc set-display-format {f} {
@@ -231,7 +255,7 @@ 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"
     }
@@ -287,12 +311,12 @@ proc toplevelG {w} {
     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]
@@ -351,9 +375,9 @@ proc cancel-operation {} {
     global busy
     global delayRequest
 
-    set cancelFlag 1
-    set delayRequest {}
     if {$busy} {
+        set cancelFlag 1
+        set delayRequest {}
         show-status Cancel 0 1
     }
 }
@@ -374,17 +398,19 @@ proc show-target {target base} {
 
 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
@@ -395,7 +421,6 @@ proc show-logo {v1} {
         
 proc show-status {status b sb} {
     global busy
-    global searchEnable
     global scanEnable
     global setOffset
     global setMax
@@ -428,7 +453,6 @@ proc show-status {status b sb} {
             .scan-window.bot.2 configure -state normal
             .scan-window.bot.4 configure -state normal
         }
-        set searchEnable 1
     } else {
         .top.service configure -state disabled
         .mid.search configure -state disabled
@@ -439,7 +463,6 @@ proc show-status {status b sb} {
             .scan-window.bot.2 configure -state disabled
             .scan-window.bot.4 configure -state disabled
         }
-        set searchEnable 0
     }
 }
 
@@ -459,6 +482,7 @@ proc insertWithTags {w text args} {
 }
 
 proc popup-license {} {
+    global libdir
     set w .popup-licence
     toplevel $w
 
@@ -475,12 +499,14 @@ proc popup-license {} {
     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
 }
 
@@ -518,6 +544,7 @@ proc about-target {} {
 }
 
 proc about-origin-logo {n} {
+    global libdir
     set w .about-origin-w
     if {![winfo exists $w]} {
         return
@@ -526,12 +553,13 @@ proc about-origin-logo {n} {
     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
@@ -549,7 +577,7 @@ proc about-origin {} {
     
     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]
@@ -614,11 +642,6 @@ proc popup-marc {sno no b df} {
     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}
         
@@ -652,6 +675,10 @@ proc popup-marc {sno no b df} {
             incr i
         }
     }
+    set ffunc [lindex $displayFormats $df]
+    set ffunc "display-$ffunc"
+
+    $ffunc $sno $no $w.top.record 0
 }
 
 proc update-target-hotlist {target base} {
@@ -766,7 +793,6 @@ proc open-target {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
@@ -874,26 +900,27 @@ proc init-response {} {
     }
 }
 
-proc search-request {} {
+proc search-request {bflag} {
     global setNo
     global profile
     global hostid
     global busy
     global cancelFlag
-    global searchEnable
     global delayRequest
+    global recordSyntax
 
     set target $hostid
 
     dputs "search-request"
-    if {$searchEnable < 0} {
-        dputs "searchEnable == 0"
+    show-message {}
+    if {!$bflag && $busy} {
+        dputs "busy: search-request ignored"
         return
     }
     if {$cancelFlag} {
         dputs "cancelFlag"
         show-status {Searching} 1 0
-        set delayRequest search-request
+        set delayRequest {search-request 1}
         return
     }
     set delayRequest {} 
@@ -918,6 +945,9 @@ proc search-request {} {
     if {[lindex $profile($target) 9] == 1} {
         z39.$setNo queryType ccl
     }
+    dputs Setting
+    dputs $recordSyntax
+    z39.$setNo preferredRecordSyntax $recordSyntax
     z39 callback {search-response}
     z39.$setNo search $query
     show-status {Searching} 1 0
@@ -941,6 +971,17 @@ proc scan-request {} {
     global curIndexEntry
     global queryButtonsFind
     global queryInfoFind
+    global cancelFlag
+    global delayRequest
+
+    dputs "scan-request"
+    if {$cancelFlag} {
+        dputs "cancelFlag"
+        show-status {Scanning} 1 0
+        set delayRequest scan-request
+        return
+    }
+    set delayRequest {} 
 
     set target $hostid
     set scanView 0
@@ -1020,6 +1061,7 @@ proc scan-term-h {attr} {
 
 proc scan-response {attr start toget} {
     global cancelFlag
+    global delayRequest
     global scanTerm
     global scanView
 
@@ -1032,8 +1074,15 @@ proc scan-response {attr start toget} {
     dputs toget=$toget
 
     if {![winfo exists .scan-window]} {
+        if {$cancelFlag} {
+            set cancelFlag 0
+            dputs "Handling cancel"
+            if {$delayRequest != ""} {
+                eval $delayRequest
+            }
+            return
+        }
         show-status {Ready} 0 1
-        set cancelFlag 0
         return
     }
     set nScanTerm [$w.top.entry get]
@@ -1075,10 +1124,14 @@ proc scan-response {attr start toget} {
         }
     }
     if {$cancelFlag} {
-        show-status {Ready} 0 1
+        dputs "Handling cancel"
         set cancelFlag 0
+        if {$delayRequest != ""} {
+            eval $delayRequest
+        }
         return
     }
+    set delayRequest {}
     if {$toget > 0 && $m > 1 && $m < $toget} {
         set ntoget [expr $toget - $m + 1]
         dputs ntoget=$ntoget
@@ -1117,6 +1170,17 @@ proc scan-response {attr start toget} {
 
 proc scan-down {attr} {
     global scanView
+    global cancelFlag
+    global delayRequest
+
+    dputs {scan-down}
+    if {$cancelFlag} {
+        dputs "cancelFlag"
+        show-status {Scanning down} 1 0
+        set delayRequest [list scan-down $attr]
+        return
+    }
+    set delayRequest {} 
 
     set w .scan-window
     set scanView [expr $scanView + 5]
@@ -1137,6 +1201,17 @@ proc scan-down {attr} {
 
 proc scan-up {attr} {
     global scanView
+    global cancelFlag
+    global delayRequest
+
+    dputs {scan-up}
+    if {$cancelFlag} {
+        dputs "cancelFlag"
+        show-status {Scanning up} 1 0
+        set delayRequest [list scan-up $attr]
+        return
+    }
+    set delayRequest {} 
 
     set w .scan-window
     set scanView [expr $scanView - 5]
@@ -1166,7 +1241,7 @@ proc search-response {} {
         dputs "Handling cancel"
         set cancelFlag 0
         if {$delayRequest != ""} {
-            $delayRequest
+            eval $delayRequest
         }
         return
     }
@@ -1209,7 +1284,7 @@ proc present-more {number} {
     dputs "present-more"
     if {$cancelFlag} {
         show-status {Retrieving} 1 0
-        set delayRequest [list present-request $number]
+        set delayRequest "present-more $number"
         return
     }
     set delayRequest {}
@@ -1258,7 +1333,7 @@ proc add-title-lines {setno no offset} {
     global displayFormat
     global lastSetNo
 
-    if {$setno == 0} {
+    if {$setno == -1} {
         set setno $lastSetNo
     } else {
         set lastSetNo $setno
@@ -1268,6 +1343,7 @@ proc add-title-lines {setno no offset} {
         .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]
@@ -1293,19 +1369,19 @@ proc present-response {} {
     global cancelFlag
     global delayRequest
 
+    dputs "In present-response"
+    set no [z39.$setNo numberOfRecordsReturned]
+    dputs "Returned $no records, setOffset $setOffset"
+    add-title-lines $setNo $no $setOffset
+    set setOffset [expr $setOffset + $no]
     if {$cancelFlag} {
         dputs "Handling cancel"
         set cancelFlag 0
         if {$delayRequest != ""} {
-            $delayRequest
+            eval $delayRequest
         }
         return
     }
-    dputs "In present-response"
-    set no [z39.$setNo numberOfRecordsReturned]
-    dputs "Returned $no records, setOffset $setOffset"
-    add-title-lines $setNo $no $setOffset
-    set setOffset [expr $setOffset + $no]
     set status [z39.$setNo responseStatus]
     if {[lindex $status 0] == "NSD"} {
         show-status {Ready} 0 1
@@ -1825,15 +1901,17 @@ proc save-geometry {} {
     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)
@@ -1844,12 +1922,16 @@ proc save-geometry {} {
 
 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] {
@@ -2562,7 +2644,7 @@ proc index-lines {w realOp buttonInfo queryInfo handle} {
                 pack $w.$i -side top -fill x -padx 2 -pady 2
                 bind $w.$i.e <Left> [list left-cursor $w.$i.e]
                 bind $w.$i.e <Right> [list right-cursor $w.$i.e]
-                bind $w.$i.e <Return> search-request
+                bind $w.$i.e <Return> {search-request 0}
             }
         } else {
             pack $w.$i.l -side left
@@ -2675,7 +2757,7 @@ menu .top.service.m.present
         -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 "Search" -command {search-request 0}
 .top.service.m add command -label "Scan" -command {scan-request}
 
 .top.service configure -state disabled
@@ -2690,6 +2772,7 @@ 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
+.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" \
@@ -2722,6 +2805,25 @@ menu .top.options.m.wrap
 .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 "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
 
@@ -2734,7 +2836,7 @@ pack .top.help -side right
 
 index-lines .lines 1 $queryButtonsFind [lindex $queryInfo 0] activate-index
 
-button .mid.search -width 7 -text {Search} -command search-request \
+button .mid.search -width 7 -text {Search} -command {search-request 0} \
         -state disabled
 button .mid.scan -width 7 -text {Scan} \
         -command scan-request -state disabled 
@@ -2761,7 +2863,7 @@ if {[tk colormodel .] == "color"} {
 }
 .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