X-Git-Url: http://lists.indexdata.dk/cgi-bin?a=blobdiff_plain;f=client.tcl;h=db9a17ed60c79da005fbf6c1ea825a05f45cdab8;hb=a9e94b1c52d13b2a95330b3df5c009b767ebcb36;hp=14783033c85aa8af67aa60f82ee9ecc2c6ffa7df;hpb=c5a9d6829720923f20fb4382d1f89d2a87101136;p=ir-tcl-moved-to-github.git

diff --git a/client.tcl b/client.tcl
index 1478303..db9a17e 100644
--- a/client.tcl
+++ b/client.tcl
@@ -1,6 +1,23 @@
+# IR toolkit for tcl/tk
+# (c) Index Data 1995
+# See the file LICENSE for details.
+# Sebastian Hammer, Adam Dickmeiss
 #
 # $Log: client.tcl,v $
-# Revision 1.31  1995-06-06 16:31:09  adam
+# Revision 1.35  1995-06-12 15:17:31  adam
+# Text widget used in main window (instead of listbox) to support
+# better presentation formats.
+#
+# Revision 1.34  1995/06/12  07:59:07  adam
+# More work on geometry handling.
+#
+# Revision 1.33  1995/06/09  11:17:35  adam
+# Start work on geometry management.
+#
+# Revision 1.32  1995/06/07  09:16:37  adam
+# New presentation format.
+#
+# Revision 1.31  1995/06/06  16:31:09  adam
 # Bug fix: target names couldn't contain blanks.
 # Bug fix: scan.
 #
@@ -110,21 +127,65 @@ set profile(Default) {{} {} {210} {} 16384 8192 tcpip {} 1 {} {} z39v2}
 set hostid Default
 set settingsChanged 0
 set setNo 0
+set lastSetNo 0
 set cancelFlag 0
 set searchEnable 0
 set fullMarcSeq 0
+set displayFormat 1
 
 set queryTypes {Simple}
 set queryButtons { { {I 0} {I 1} {I 2} } }
 set queryInfo { { {Title {1=4}} {Author {1=1}} \
         {Subject {1=21}} {Any {1=1016}} } }
-
 wm minsize . 0 0
 
+proc read-formats {} {
+    global displayFormats
+    set formats [glob -nocomplain formats/*.tcl]
+    foreach f $formats {
+        source $f
+        set l [expr [string length $f] - 5]
+ 	lappend displayFormats [string range $f 8 $l]
+    }
+}
+
+proc set-display-format {f} {
+    global displayFormat
+    global setNo
+
+    set displayFormat $f
+    if {$setNo == 0} {
+        return
+    }
+    add-title-lines 0 10000 1
+}
+
+proc destroyG {w} {
+    global windowGeometry
+    set windowGeometry($w) [wm geometry $w]
+    destroy $w
+}
+
+proc toplevelG {w} {
+    global windowGeometry
+
+    toplevel $w
+    if {[info exists windowGeometry($w)]} {
+        set g $windowGeometry($w)
+        if {$g != ""} {
+            wm geometry $w $g
+        }
+    }
+}
+
 if {[file readable "clientrc.tcl"]} {
     source "clientrc.tcl"
 }
 
+if {[file readable "clientg.tcl"]} {
+    source "clientg.tcl"
+}
+
 set queryButtonsFind [lindex $queryButtons 0]
 set queryInfoFind [lindex $queryInfo 0]
 
@@ -143,7 +204,7 @@ proc top-down-ok-cancel {w ok-action g} {
             -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} \
-            -command "destroy $w"
+            -command [list destroy $w]
     pack $w.bot.cancel -side left -expand yes    
 
     if {$g} {
@@ -266,10 +327,9 @@ proc insertWithTags {w text args} {
 proc about-target {} {
     set w .about-target-w
 
-    toplevel $w
+    toplevelG $w
 
     wm title $w "About target"
-    place-force $w .
     top-down-window $w
 
     set i [z39 targetImplementationName]
@@ -283,13 +343,13 @@ proc about-target {} {
 
     pack $w.top.in $w.top.ii $w.top.iv $w.top.op -side top -anchor nw
 
-    bottom-buttons $w [list {Close} [list destroy $w]] 1
+    bottom-buttons $w [list {Close} [list destroyG $w]] 1
 }
 
 proc about-origin {} {
     set w .about-origin-w
 
-    toplevel $w
+    toplevelG $w
 
     wm title $w "About IrTcl"
     place-force $w .
@@ -302,11 +362,13 @@ proc about-origin {} {
 
     pack $w.top.in $w.top.ii -side top -anchor nw
 
-    bottom-buttons $w [list {Close} [list destroy $w]] 1
+    bottom-buttons $w [list {Close} [list destroyG $w]] 1
 }
 
-proc show-full-marc {sno no b} {
+proc popup-marc {sno no b df} {
     global fullMarcSeq
+    global displayFormats
+    global popupMarcOdf
 
     if {[z39.$sno type $no] != "DB"} {
         return
@@ -318,11 +380,10 @@ proc show-full-marc {sno no b} {
         set w .full-marc
     }
     if {[winfo exists $w]} {
-        $w.top.record delete 0.0 end
         set new 0
     } else {
 
-        toplevel $w
+        toplevelG $w
 
         wm minsize $w 0 0
         
@@ -332,48 +393,69 @@ proc show-full-marc {sno no b} {
         pack  $w.top -side top -fill both -expand yes
         pack  $w.bot -fill both
 
-        text $w.top.record -width 60 -height 12 -wrap word \
+        text $w.top.record -width 60 -height 5 -wrap word \
                 -yscrollcommand [list $w.top.s set]
         scrollbar $w.top.s -command [list $w.top.record yview]
 
+        if {[tk colormodel .] == "color"} {
+            $w.top.record tag configure marc-tag -foreground blue
+            $w.top.record tag configure marc-id -foreground red
+        } else {
+            $w.top.record tag configure marc-tag -foreground black
+            $w.top.record tag configure marc-id -foreground black
+        }
+        $w.top.record tag configure marc-data -foreground black
         set new 1
     }
-    set r [z39.$sno getMarc $no list * * *]
+    $w.top.record delete 0.0 end
 
-    $w.top.record tag configure marc-tag -foreground blue
-    $w.top.record tag configure marc-data -foreground black
-    $w.top.record tag configure marc-id -foreground red
+    set ffunc [lindex $displayFormats $df]
+    set ffunc "display-$ffunc"
 
-    foreach line $r {
-        set tag [lindex $line 0]
-        set indicator [lindex $line 1]
-        set fields [lindex $line 2]
+    $ffunc $sno $no  $w.top.record 0
 
-        if {$indicator != ""} {
-            insertWithTags $w.top.record "$tag $indicator" marc-tag
-        } else {
-            insertWithTags $w.top.record "$tag    " marc-tag
-        }
-        foreach field $fields {
-            set id [lindex $field 0]
-            set data [lindex $field 1]
-            if {$id != ""} {
-                insertWithTags $w.top.record " $id " marc-id
-            }
-            set start [$w.top.record index insert]
-            insertWithTags $w.top.record $data {}
-        }
-        $w.top.record insert end "\n"
-    }
     if {$new} {
-        bind $w <Return> {destroy .full-marc}
+        bind $w.top.record <Return> {destroy .full-marc}
         
         pack $w.top.s -side right -fill y
         pack $w.top.record -expand yes -fill both
-
-        bottom-buttons $w [list \
+        
+        if {$b} {
+            bottom-buttons $w [list \
                 {Close} [list destroy $w] \
-                {Duplicate} [list show-full-marc $sno $no 1]] 0
+                {Duplicate} [list popup-marc $sno $no 1 $df]] 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 \
+                        -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
+        } else {
+            bottom-buttons $w [list \
+                {Close} [list destroyG $w] \
+                {Duplicate} [list popup-marc $sno $no 1 $df]] 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 \
+                        -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
+        }
+    } else {
+        set i 0
+        foreach f $displayFormats {
+            $w.bot.formats.m entryconfigure $i \
+                    -command [list display-f $sno $no $w.top.record 0]
+            incr i
+        }
     }
 }
 
@@ -500,8 +582,6 @@ proc load-set-action {} {
     set fname [.load-set.top.filename.entry get]
     destroy .load-set
     if {$fname != ""} {
-        init-title-lines
-
         show-status {Loading} 1 {}
         z39.$setNo loadFile $fname
 
@@ -617,7 +697,7 @@ proc scan-request {attr} {
     ir-scan z39.scan z39
 
     if {![winfo exists $w]} {
-        toplevel $w
+        toplevelG $w
         
         wm title $w "Scan"
         
@@ -630,7 +710,7 @@ proc scan-request {attr} {
         bind $w.top.entry <KeyRelease> [list scan-term-h $attr]
         if {1} {
             listbox $w.top.list -yscrollcommand [list $w.top.scroll set] \
-                    -font fixed -geometry 50x14
+                    -font fixed 
             scrollbar $w.top.scroll -orient vertical -border 1
             pack $w.top.list -side left -fill both -expand yes
             pack $w.top.scroll -side right -fill y
@@ -640,13 +720,14 @@ proc scan-request {attr} {
             pack $w.top.list -side left -fill both -expand yes
         }
         
-        bottom-buttons $w [list {Close} [list destroy $w] \
+        bottom-buttons $w [list {Close} [list destroyG $w] \
                 {Up} [list scan-up $attr] \
                 {Down} [list scan-down $attr]] 0
         bind $w.top.list <Up> [list scan-up $attr]
         bind $w.top.list <Down> [list scan-down $attr]
+
+#       bind $w.top <Any-Enter> [list focus $w.top.entry]
     }
-    focus $w.top.entry
     z39 callback [list scan-response $attr 0 35]
     z39.scan numberOfTermsRequested 5
     z39.scan preferredPositionInResponse 1
@@ -892,7 +973,7 @@ proc present-more {number} {
 }
 
 proc init-title-lines {} {
-    .data.list delete 0 end
+    .data.record delete 0.0 end
 }
 
 proc title-press {y setno} {
@@ -900,28 +981,32 @@ proc title-press {y setno} {
 }
 
 proc add-title-lines {setno no offset} {
+    global displayFormats
+    global displayFormat
+    global lastSetNo
+
+    if {$setno == 0} {
+        set setno $lastSetNo
+    } else {
+        set lastSetNo $setno
+    }
     if {$offset == 1} {
-        .data.list delete 0 end
+        .bot.a.set configure -text $setno
+        .data.record delete 0.0 end
     }
-    bind .data.list <Double-Button-1> [list title-press %y $setno]
+    set ffunc [lindex $displayFormats $displayFormat]
+    set ffunc "display-$ffunc"
     for {set i 0} {$i < $no} {incr i} {
         set o [expr $i + $offset]
         set type [z39.$setno type $o]
-        if {$type == "DB"} {
-            set title [lindex [z39.$setno getMarc $o field 245 * a] 0]
-            set year  [lindex [z39.$setno getMarc $o field 260 * c] 0]
-            set nostr [format "%5d" $o]
-            .data.list insert end "$nostr $title - $year"
-        } elseif {$type == "SD"} {
-            set err [lindex [z39.$setno diag $o] 1]
-            set add [lindex [z39.$setno diag $o] 2]
-            if {$add != {}} {
-                set add " :${add}"
-            }
-            .data.list insert end "Error ${err}${add}"
-        } elseif {$type == ""} {
+        if {$type == ""} {
             break
         }
+        set insert0 [.data.record index insert]
+        $ffunc $setno $o .data.record 1
+        .data.record tag add r$o $insert0 insert
+        .data.record tag bind r$o <1> \
+                [list popup-marc $setno $o 0 $displayFormat]
     }
 }
 
@@ -951,7 +1036,7 @@ proc present-response {} {
         return
     }
     if {$no > 0 && $setOffset <= $setMax} {
-        puts "present from ${setOffset}"
+        puts "present-request from ${setOffset}"
         set toGet [expr $setMax - $setOffset + 1]
         if {$toGet > 3} {
             set toGet 3
@@ -1058,7 +1143,7 @@ proc protocol-setup-action {target} {
 
     cascade-target-list
     puts $profile($target)
-    destroy $w
+    destroyG $w
 }
 
 proc place-force {window parent} {
@@ -1121,7 +1206,6 @@ proc delete-database {target} {
 }
 
 proc protocol-setup {target} {
-
     global profile
     global csRadioType
     global protocolRadioType
@@ -1132,10 +1216,9 @@ proc protocol-setup {target} {
     set wno [lindex $profile($target) 12]
     set w .setup-${wno}
 
-    toplevel $w
+    toplevelG $w
 
     wm title $w "Setup $target"
-    place-force $w .
 
     top-down-window $w
     
@@ -1165,7 +1248,7 @@ proc protocol-setup {target} {
             maximumRecordSize preferredMessageSize} \
             {{Description:} {Host:} {Port:} {Id Authentication:} \
             {Maximum Record Size:} {Preferred Message Size:}} \
-            [list protocol-setup-action $target] [list destroy $w]
+            [list protocol-setup-action $target] [list destroyG $w]
     
     foreach sub {description host port idAuthentication \
             maximumRecordSize preferredMessageSize} {
@@ -1250,7 +1333,8 @@ proc protocol-setup {target} {
             -padx 4 -side top -fill x
 
     # Ok-cancel
-    top-down-ok-cancel $w [list protocol-setup-action $target] 0
+    bottom-buttons $w [list {Ok} [list protocol-setup-action $target] \
+            {Cancel} [list destroyG $w]] 0   
 }
 
 proc database-select-action {} {
@@ -1352,6 +1436,21 @@ proc cascade-query-list {} {
     }
 }
 
+proc save-geometry {} {
+    global windowGeometry
+    
+    set windowGeometry(.) [wm geometry .]
+
+    set f [open "clientg.tcl" w]
+
+    foreach n [array names windowGeometry] {
+        puts -nonewline $f "set \{windowGeometry($n)\} \{"
+        puts -nonewline $f $windowGeometry($n)
+        puts $f "\}"
+    }
+    close $f
+}
+
 proc save-settings {} {
     global hotTargets 
     global profile
@@ -1359,7 +1458,7 @@ proc save-settings {} {
     global queryTypes
     global queryButtons
     global queryInfo
-
+    
     set f [open "clientrc.tcl" w]
     puts $f "# Setup file"
     puts $f "set hotTargets \{ $hotTargets \}"
@@ -1380,7 +1479,6 @@ proc save-settings {} {
     puts -nonewline $f "set queryInfo \{"
     puts -nonewline $f $queryInfo
     puts $f "\}"
-    
     close $f
     set settingsChanged 0
 }
@@ -1412,6 +1510,7 @@ proc alert-action {} {
 proc exit-action {} {
     global settingsChanged
 
+    save-geometry
     if {$settingsChanged} {
         set a [alert "you havent saved your settings. Do you wish to save?"]
         if {$a} {
@@ -1798,6 +1897,15 @@ proc search-fields {w buttondefs} {
     $w.0 configure -background red
 }
 
+if {[info exists windowGeometry(.)]} {
+    set g $windowGeometry(.)
+    if {$g != ""} {
+        wm geometry . $g
+    }
+}    
+
+read-formats
+
 frame .top  -border 1 -relief raised
 frame .lines  -border 1 -relief raised
 frame .mid  -border 1 -relief raised
@@ -1812,8 +1920,6 @@ menu .top.file.m
 .top.file.m add command -label "Save settings" -command {save-settings}
 .top.file.m add separator
 .top.file.m add command -label "Exit" -command {exit-action}
-.top.file.m add separator
-.top.file.m add command -label "About" -command {about-origin}
 
 menubutton .top.target -text "Target" -underline 0 -menu .top.target.m
 menu .top.target.m
@@ -1857,17 +1963,25 @@ menu .top.options.m
 .top.options.m add cascade -label "Choose query" -menu .top.options.m.clist
 .top.options.m add command -label "Define query" -command {new-query-dialog}
 .top.options.m add cascade -label "Edit query" -menu .top.options.m.slist
-menu .top.options.m.clist
+.top.options.m add cascade -label "Format" -menu .top.options.m.formats
+
 menu .top.options.m.slist
+menu .top.options.m.clist
+menu .top.options.m.formats
 cascade-query-list
+set i 0
+foreach f $displayFormats {
+    .top.options.m.formats add radiobutton -label $f \
+            -command [list set-display-format $i]
+    incr i
+}
 
 menubutton .top.help -text "Help" -menu .top.help.m
 menu .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 "About" \
-        -command {tkerror "About not available. Sorry"}
+.top.help.m add command -label "About" -command {about-origin}
 
 pack .top.file .top.target .top.service .top.rset .top.options -side left
 pack .top.help -side right
@@ -1885,11 +1999,20 @@ button .mid.clear -width 7 -text {Clear} -command index-clear
 pack .mid.search .mid.scan .mid.present .mid.clear -side left \
         -fill y -padx 5 -pady 3
 
-listbox .data.list -yscrollcommand {.data.scroll set} -font fixed -geometry 20x2
-scrollbar .data.scroll -orient vertical -border 1
-pack .data.list -side left -fill both -expand yes
+text .data.record -height 2 -width 20 -wrap none \
+        -yscrollcommand [list .data.scroll set]
+scrollbar .data.scroll -command [list .data.record yview]
 pack .data.scroll -side right -fill y
-.data.scroll config -command {.data.list yview}
+pack .data.record -expand yes -fill both
+
+if {[tk colormodel .] == "color"} {
+    .data.record tag configure marc-tag -foreground blue
+    .data.record tag configure marc-id -foreground red
+} else {
+    .data.record tag configure marc-tag -foreground black
+    .data.record tag configure marc-id -foreground black
+}
+.data.record tag configure marc-data -foreground black
 
 button .bot.logo  -bitmap @book1 -command cancel-operation
 frame .bot.a
@@ -1900,7 +2023,7 @@ message .bot.a.target -text "" -aspect 1000 -border 1
 
 label .bot.a.status -text "Not connected" -width 15 -relief \
         sunken -anchor w -border 1
-label .bot.a.set -textvariable setNo -width 5 -relief \
+label .bot.a.set -text "" -width 5 -relief \
         sunken -anchor w -border 1
 label .bot.a.message -text "" -width 15 -relief \
         sunken -anchor w -border 1
@@ -1909,7 +2032,11 @@ pack .bot.a.target -side top -anchor nw -padx 2 -pady 2
 pack .bot.a.status .bot.a.set .bot.a.message \
         -side left -padx 2 -pady 2
 
+#bind . <Any-Enter> {focus .lines.0.e}
+
 ir z39
 
+.top.options.m.formats invoke $displayFormat
+    
 show-logo 1