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

diff --git a/client.tcl b/client.tcl
index 7f95380..db9a17e 100644
--- a/client.tcl
+++ b/client.tcl
@@ -1,6 +1,20 @@
+# 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.32  1995-06-07 09:16:37  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
@@ -113,22 +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 nice
+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]
 
@@ -147,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} {
@@ -270,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]
@@ -287,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 .
@@ -306,139 +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
-}
-
-proc display-raw {sno no w} {
-    $w delete 0.0 end
-    set r [z39.$sno getMarc $no list * * *]
-    foreach line $r {
-        set tag [lindex $line 0]
-        set indicator [lindex $line 1]
-        set fields [lindex $line 2]
-        
-        if {$indicator != ""} {
-            insertWithTags $w "$tag $indicator" marc-tag
-        } else {
-            insertWithTags $w "$tag    " marc-tag
-        }
-        foreach field $fields {
-            set id [lindex $field 0]
-            set data [lindex $field 1]
-            if {$id != ""} {
-                insertWithTags $w " $id " marc-id
-            }
-            set start [$w index insert]
-            insertWithTags $w $data {}
-        }
-        $w insert end "\n"
-    }
+    bottom-buttons $w [list {Close} [list destroyG $w]] 1
 }
 
-proc display-nice {sno no w} {
-    $w delete 0.0 end
-    set i [z39.$sno getMarc $no field 245 * a]
-    if {$i != ""} {
-        set i [lindex $i 0]
-        insertWithTags $w "Title:      " marc-tag
-        insertWithTags $w $i marc-data
-        set i [z39.$sno getMarc $no field 245 * b]
-        if {$i != ""} {
-            insertWithTags $w [lindex $i 0] marc-data
-        }
-        $w insert end "\n"
-    }
-    set i [z39.$sno getMarc $no field 700 * a]
-    if {$i == ""} {
-        set i [z39.$sno getMarc $no field 100 * a]
-    }
-    if {$i != ""} {
-        if {[llength $i] > 1} {
-            insertWithTags $w "Authors:    " marc-tag
-        } else {
-            insertWithTags $w "Author:     " marc-tag
-        }
-        foreach x $i {
-            insertWithTags $w $x marc-data
-        }
-        $w insert end "\n"
-    }
-    set i [z39.$sno getMarc $no field 110 * *]
-    if {$i != ""} {
-        insertWithTags $w "Co-Author:  " marc-tag
-        foreach x $i {
-            insertWithTags $w $x marc-data
-        }
-        $w insert end "\n"
-    }
-
-    set i [z39.$sno getMarc $no field 650 * *]
-    if {$i != ""} {
-        set n 0
-        insertWithTags $w "Keywords:   " marc-tag
-        foreach x $i {
-            if {$n > 0} {
-                $w insert end ", "
-            }
-            insertWithTags $w $x marc-data
-            incr n
-        }
-        $w insert end "\n"
-    }
-    set i [concat [z39.$sno getMarc $no field 260 * a] \
-            [z39.$sno getMarc $no field 260 * b]]
-    if {$i != ""} {
-        insertWithTags $w "Publisher:  " marc-tag
-        foreach x $i {
-            insertWithTags $w $x marc-data
-        }
-        $w insert end "\n"
-    }
-    set i [z39.$sno getMarc $no field 020 * a]
-    if {$i != ""} {
-        insertWithTags $w "ISBN:       " marc-tag
-        foreach x $i {
-            insertWithTags $w $x marc-data
-        }
-        $w insert end "\n"
-    }
-    set i [z39.$sno getMarc $no field 022 * a]
-    if {$i != ""} {
-        insertWithTags $w "ISSN:       " marc-tag
-        foreach x $i {
-            insertWithTags $w $x marc-data
-        }
-        $w insert end "\n"
-    }
-    set i [z39.$sno getMarc $no field 030 * a]
-    if {$i != ""} {
-        insertWithTags $w "CODEN:      " marc-tag
-        foreach x $i {
-            insertWithTags $w $x marc-data
-        }
-        $w insert end "\n"
-    }
-    set i [z39.$sno getMarc $no field 015 * a]
-    if {$i != ""} {
-        insertWithTags $w "Ctl number: " marc-tag
-        foreach x $i {
-            insertWithTags $w $x marc-data
-        }
-        $w insert end "\n"
-    }
-    set i [z39.$sno getMarc $no field 010 * a]
-    if {$i != ""} {
-        insertWithTags $w "LC number:  " marc-tag
-        foreach x $i {
-            insertWithTags $w $x marc-data
-        }
-        $w insert end "\n"
-    }
-}
-
-proc show-full-marc {sno no b} {
+proc popup-marc {sno no b df} {
     global fullMarcSeq
-    global displayFormat
+    global displayFormats
+    global popupMarcOdf
 
     if {[z39.$sno type $no] != "DB"} {
         return
@@ -453,7 +383,7 @@ proc show-full-marc {sno no b} {
         set new 0
     } else {
 
-        toplevel $w
+        toplevelG $w
 
         wm minsize $w 0 0
         
@@ -463,34 +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
     }
-    $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
+    $w.top.record delete 0.0 end
+
+    set ffunc [lindex $displayFormats $df]
+    set ffunc "display-$ffunc"
+
+    $ffunc $sno $no  $w.top.record 0
 
-    if {$displayFormat == "nice"} {
-        display-nice $sno $no $w.top.record
-    } else {
-        display-raw $sno $no $w.top.record
-    }
     if {$new} {
         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] \
-                {Raw} [list display-raw $sno $no $w.top.record] \
-                {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 {
-        $w.bot.2 configure -command [list display-raw $sno $no $w.top.record]
-        $w.bot.4 configure -command [list show-full-marc $sno $no 1]
+        set i 0
+        foreach f $displayFormats {
+            $w.bot.formats.m entryconfigure $i \
+                    -command [list display-f $sno $no $w.top.record 0]
+            incr i
+        }
     }
 }
 
@@ -732,7 +697,7 @@ proc scan-request {attr} {
     ir-scan z39.scan z39
 
     if {![winfo exists $w]} {
-        toplevel $w
+        toplevelG $w
         
         wm title $w "Scan"
         
@@ -745,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
@@ -755,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
@@ -1007,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} {
@@ -1015,30 +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} {
         .bot.a.set configure -text $setno
-        .data.list delete 0 end
+        .data.record delete 0.0 end
     }
-    bind .data.list <Double-Button-1> [list title-press %y $setno]
-    bind .data.list <Button-2> [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]
     }
 }
 
@@ -1068,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
@@ -1175,7 +1143,7 @@ proc protocol-setup-action {target} {
 
     cascade-target-list
     puts $profile($target)
-    destroy $w
+    destroyG $w
 }
 
 proc place-force {window parent} {
@@ -1238,7 +1206,6 @@ proc delete-database {target} {
 }
 
 proc protocol-setup {target} {
-
     global profile
     global csRadioType
     global protocolRadioType
@@ -1249,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
     
@@ -1282,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} {
@@ -1367,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 {} {
@@ -1469,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
@@ -1476,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 \}"
@@ -1497,7 +1479,6 @@ proc save-settings {} {
     puts -nonewline $f "set queryInfo \{"
     puts -nonewline $f $queryInfo
     puts $f "\}"
-    
     close $f
     set settingsChanged 0
 }
@@ -1529,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} {
@@ -1915,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
@@ -1929,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
@@ -1974,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
@@ -2002,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
@@ -2026,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