X-Git-Url: http://git.indexdata.com/?a=blobdiff_plain;f=client.tcl;h=2403c2e634ce641c1fb5720bd286f88fd698f1d9;hb=d026c3e06f6e19e5ed4174ab1a504a4b5af79183;hp=9d8ff83b2538133915aa118e76e023ceec3621f4;hpb=03dae994ae05a36d5c8bb443f5f59dbb396ca80c;p=ir-tcl-moved-to-github.git

diff --git a/client.tcl b/client.tcl
index 9d8ff83..2403c2e 100644
--- a/client.tcl
+++ b/client.tcl
@@ -1,10 +1,31 @@
 # IR toolkit for tcl/tk
-# (c) Index Data 1995-1998
+# (c) Index Data 1995-2001
 # See the file LICENSE for details.
 # Sebastian Hammer, Adam Dickmeiss
 #
 # $Log: client.tcl,v $
-# Revision 1.104  1998-02-12 13:32:41  adam
+# Revision 1.111  2001-12-03 18:52:06  adam
+# Configure no longer searches for Tk. Removed references to SR.
+#
+# Revision 1.110  2000/10/11 12:26:47  adam
+# Using yaz.m4 for aclocal.m4.
+#
+# Revision 1.109  1999/12/12 00:25:59  adam
+# Updated list of preconfigure targets.
+#
+# Revision 1.108  1999/11/30 14:05:58  adam
+# Updated for new location of YAZ headers.
+#
+# Revision 1.107  1999/02/11 11:30:08  adam
+# Updated for WIN32.
+#
+# Revision 1.106  1998/06/10 13:22:47  adam
+# Minor changes.
+#
+# Revision 1.105  1998/06/10 13:00:45  adam
+# Added ir-version command.
+#
+# Revision 1.104  1998/02/12 13:32:41  adam
 # Updated configuration system.
 #
 # Revision 1.103  1998/01/30 13:30:50  adam
@@ -356,6 +377,7 @@
 #
 #
 
+
 # Procedure tk4 is defined - returns 0 if tk 3.6 - returns 1 otherwise
 if {$tk_version == "3.6"} {
     proc tk4 {} {
@@ -496,8 +518,8 @@ set debugMode 0
 
 set queryTypes {Simple}
 set queryButtons { { {I 0} {I 1} {I 2} } }
-set queryInfo { { {Title {1=4 4=1}} {Author {1=1}} \
-        {Subject {1=21}} {Any {1=1016}} } }
+set queryInfo {{{Title {1=4}} {Author {1=1003}} \
+        {Subject {1=21}} {Any {1=1016}} {Abstract {1=62}}}}
 wm minsize . 0 0
 
 set setOffset 0
@@ -743,6 +765,21 @@ proc post-menu {wbutton wmenu} {
 
 }
 
+# Procedure place-force {window parent}
+#  window      new top level widget
+#  parent      parent widget used as base
+# Sets geometry of $window relative to $parent window.
+proc place-force {window parent} {
+    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]]
+    wm geometry $window +${x}+${y}
+}
+
 # Procedure destroyGW {w}
 #   w     top level widget
 # Saves geometry of widget w in windowGeometry array. This
@@ -765,7 +802,7 @@ proc toplevelG {w} {
     toplevel $w
     if {[info exists windowGeometry($w)]} {
         set g $windowGeometry($w)
-        if {$g != ""} {
+        if {[string length $g]} {
             wm geometry $w $g
         }
     }
@@ -783,6 +820,14 @@ proc top-down-window {w} {
     pack  $w.bot -fill both
 }
 
+# Init: The geometry information for the main window is set - either
+# to a default value or to the value in windowGeometry(.)
+if {[catch {set g $windowGeometry(.)}]} {
+    wm geometry . 420x340+20+20
+} else {
+    wm geometry . $g
+}
+
 # Procedure top-down-ok-cancel {w ok-action g}
 #  w          top level widget with $w.bot-frame
 #  ok-action  ok script
@@ -1087,17 +1132,12 @@ proc about-origin {} {
     label $w.top.a.logo -bitmap @${libdir}/bitmaps/book1 
     pack $w.top.a.irtcl $w.top.a.logo -side left -expand yes
 
-    set i unknown
-    catch {set i [z39 implementationName]}
-    label $w.top.p.in -text "Implementation name: $i"
-    catch {set i [z39 implementationId]}
-    label $w.top.p.ii -text "Implementation id: $i"
-    catch {set i [z39 implementationVersion]}
-    label $w.top.p.iv -text "Implementation version: $i"
-    set i $tk_version
-    label $w.top.p.tk -text "Tk version: $i"
+    label $w.top.p.irtcl -text "IrTcl version: [lindex [ir-version] 0]"
+    label $w.top.p.yaz -text "Yaz version: [lindex [ir-version] 1]"
+
+    label $w.top.p.tk -text "Tk version: $tk_version"
 
-    pack $w.top.p.in $w.top.p.ii $w.top.p.iv $w.top.p.tk -side top -anchor nw
+    pack $w.top.p.irtcl $w.top.p.yaz $w.top.p.tk -side top -anchor nw
 
     about-origin-logo 1
     bottom-buttons $w [list {Close} [list destroy $w] \
@@ -1530,6 +1570,7 @@ proc explain-crash {target base} {
     global profile settingsChanged
     
     set profile($target,timeLastInit) [clock seconds]
+    set profile($target,timeLastExplain) {}
     set settingsChanged 1
 
     show-message {}
@@ -1964,7 +2005,7 @@ proc scan-up {attr} {
 
 # Procedure search-response
 # This procedure handles search-responses. If the search is successful
-# this procedure will try to retrieve a total of 20 records from the target;
+# this procedure will try to retrieve a total of 50 records from the target;
 # however not more than $presentChunk records at a time. This procedure
 # affects the following globals:
 #   $setOffset        current record position offset
@@ -2011,8 +2052,8 @@ proc search-response {} {
     set l [format "%-4d %7d" $setNo $setMax]
     .top.rset.m add command -label $l \
             -command [list recall-set $setNo]
-    if {$setMax > 20} {
-        set setMax 20
+    if {$setMax > 50} {
+        set setMax 50
     }
     set no [z39.$setNo numberOfRecordsReturned]
     dputs "Returned $no records, setOffset $setOffset"
@@ -2319,6 +2360,7 @@ proc protocol-setup-action {target w} {
     set dataBases {}
     set settingsChanged 1
 
+    puts "protocol-setup-action"
     set timedef $profile($target,timeDefine)
     if {![string length $timedef]} {
         set timedef [clock seconds]
@@ -2341,21 +2383,6 @@ proc protocol-setup-action {target w} {
     destroy $w
 }
 
-# Procedure place-force {window parent}
-#  window      new top level widget
-#  parent      parent widget used as base
-# Sets geometry of $window relative to $parent window.
-proc place-force {window parent} {
-    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]]
-    wm geometry $window +${x}+${y}
-}
-
 # Procedure add-database-action {target w}
 #  target      target to be defined
 #  w           top level widget for the target definition
@@ -2909,6 +2936,9 @@ proc save-geometry {} {
     puts $f "set recordSyntax $recordSyntax"
     puts $f "set elementSetNames $elementSetNames"
     foreach n [array names windowGeometry] {
+        dputs "set [list windowGeometry($n)] "
+        dputs [list $windowGeometry($n)]
+
         puts -nonewline $f "set [list windowGeometry($n)] "
         puts $f [list $windowGeometry($n)]
     }
@@ -3367,6 +3397,7 @@ proc use-attr {init} {
         {Host item}                    1033 
         {Content type}                 1034 
         {Anywhere}                     1035 
+        {Author-Title-Subject}         1036 
     }
     set w .index-setup
     global useTmpValue
@@ -3908,14 +3939,6 @@ proc search-fields {w buttondefs} {
     $w.0 configure -background red
 }
 
-# Init: The geometry information for the main window is set - either
-# to a default value or to the value in windowGeometry(.)
-if {[catch {set g $windowGeometry(.)}]} {
-    wm geometry . 420x340
-} else {
-    wm geometry . $g
-}
-
 # Init: Presentation formats are read.
 read-formats
 
@@ -3960,8 +3983,8 @@ irmenu .top.service.m
 .top.service.m add cascade -label Database -menu .top.service.m.dblist
 .top.service.m add cascade -label Present -menu .top.service.m.present
 irmenu .top.service.m.present
-.top.service.m.present add command -label {10 More} \
-        -command [list present-more 10]
+.top.service.m.present add command -label {50 More} \
+        -command [list present-more 50]
 .top.service.m.present add command -label All \
         -command [list present-more {}]
 .top.service.m add command -label Search -command {search-request 0}
@@ -4062,8 +4085,6 @@ irmenu .top.options.m.elements
 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 "About" -command {about-origin}
 
 # Init: Pack menu bar items.
@@ -4077,7 +4098,7 @@ button .mid.search -text Search -command {search-request 0} \
         -state disabled
 button .mid.scan -text Scan \
         -command scan-request -state disabled 
-button .mid.present -text {Present} -command [list present-more 10] \
+button .mid.present -text {Present} -command [list present-more 50] \
         -state disabled
 
 button .mid.clear -text Clear -command index-clear
@@ -4143,14 +4164,24 @@ pack .bot.a.status .bot.a.set .bot.a.message \
 
 # Init: Determine if the IrTcl extension is already there. If
 #  not, then dynamically load the IrTcl extension.
-if {[catch {ir z39}]} {
+set logLevel all
+if {[catch {ir-version}]} {
     set e [info sharedlibextension]
-    puts -nonewline "Loading irtcl$e ..."
-    load ${libdir}/irtcl$e irtcl
-    ir z39
-    puts "ok"
+    catch {load ${libdir}/irtcl$e irtcl}
+    if {[catch {ir-version}]} {
+	catch {load irtcl$e irtcl}
+    }
+}
+
+if $debugMode {	
+	ir-log-init all {} irtcl.log
+} else {
+	ir-log-init none {} {}
 }
 
+# Create Z Assocation
+ir z39
+
 if {[file exists ${libdir}/explain.tcl]} {
     source ${libdir}/explain.tcl
 }
@@ -4159,15 +4190,12 @@ if {[file exists ${libdir}/setup.tcl]} {
     source ${libdir}/setup.tcl
 }
 
-# Init: Uncomment this line if you wan't to enable logging.
-ir-log-init all irtcl irtcl.log
+after 10 activateMainWindow
 
-# Init: If hostid is a valid target, a new connection will be established
-# immediately.
-if {[string compare $hostid Default]} {
-    catch {open-target $hostid $hostbase}
+proc activateMainWindow {} {
+    global hostid hostbase
+    if {[string compare $hostid Default]} {
+	catch {open-target $hostid $hostbase}
+    }
+    show-logo 1
 }
-
-# Init: Enable the logo.
-show-logo 1
-