X-Git-Url: http://lists.indexdata.com/cgi-bin?a=blobdiff_plain;f=client.tcl;h=74db9a05cfc9efd7f8ac7c627a8f7225ac3ea6ce;hb=a15a80e995220dc483d5c997e74ec0fb4ec4a225;hp=7b528c9dc1a8dbac85f9f344119c9e1837da05b6;hpb=c52211bb982f629d7902a3d85cbd098d93c9a003;p=ir-tcl-moved-to-github.git diff --git a/client.tcl b/client.tcl index 7b528c9..74db9a0 100644 --- a/client.tcl +++ b/client.tcl @@ -4,7 +4,18 @@ # Sebastian Hammer, Adam Dickmeiss # # $Log: client.tcl,v $ -# Revision 1.70 1995-10-12 14:46:52 adam +# Revision 1.73 1995-10-17 10:58:06 adam +# More work on presentation formats. +# +# Revision 1.72 1995/10/16 17:00:52 adam +# New setting: elementSetNames. +# Various client improvements. Medium presentation format looks better. +# +# Revision 1.71 1995/10/13 15:35:27 adam +# Relational operators may be used in search entries - changes +# in proc index-query. +# +# Revision 1.70 1995/10/12 14:46:52 adam # Better record popup windows. Next/prev buttons in popup record windows. # The record position in the raw format is much more visible. # @@ -313,6 +324,7 @@ set displayFormat 1 set popupMarcdf 0 set textWrap word set recordSyntax None +set elementSetNames None set delayRequest {} set queryTypes {Simple} @@ -774,6 +786,16 @@ proc popup-marc {sno no b df} { -font -Adobe-Times-Medium-R-Normal-*-180-* \ -background black -foreground white + $w.top.record tag configure marc-pref \ + -font -Adobe-Times-Medium-R-Normal-*-180-* \ + -foreground blue + $w.top.record tag configure marc-text \ + -font -Adobe-Times-Medium-R-Normal-*-180-* \ + -foreground black + $w.top.record tag configure marc-it \ + -font -Adobe-Times-Medium-I-Normal-*-180-* \ + -foreground black + pack $w.top.s -side right -fill y pack $w.top.record -expand yes -fill both @@ -1073,6 +1095,7 @@ proc search-request {bflag} { global cancelFlag global delayRequest global recordSyntax + global elementSetNames set target $hostid @@ -1118,6 +1141,11 @@ proc search-request {bflag} { } else { z39.$setNo preferredRecordSyntax $recordSyntax } + if {$elementSetNames == "None" } { + z39.$setNo elementSetNames {} + } else { + z39.$setNo elementSetNames $elementSetNames + } z39 callback {search-response} z39.$setNo search $query show-status Searching 1 0 @@ -1774,9 +1802,17 @@ proc protocol-setup {target} { global RPNCheck global CCLCheck global ResultSetCheck - - set wno [lindex $profile($target) 12] - set w .setup-${wno} + + if {1} { + set wno [lindex $profile($target) 12] + set w .setup-${wno} + } else { + set b 0 + while {[winfo exists .setup-$b]} { + incr b + } + set w .setup-$b + } toplevelG $w @@ -2093,7 +2129,8 @@ proc save-geometry {} { global displayFormat global popupMarcdf global recordSyntax - + global elementSetNames + set windowGeometry(.) [wm geometry .] if {[catch {set f [open ~/.clientrc.tcl w]}]} { @@ -2104,6 +2141,7 @@ proc save-geometry {} { puts $f "set displayFormat $displayFormat" puts $f "set popupMarcdf $popupMarcdf" puts $f "set recordSyntax $recordSyntax" + puts $f "set elementSetNames $elementSetNames" foreach n [array names windowGeometry] { puts -nonewline $f "set \{windowGeometry($n)\} \{" puts -nonewline $f $windowGeometry($n) @@ -2573,6 +2611,14 @@ proc index-setup {attr queryNo indexNo} { set completenessTmpValue 0 set useTmpValue 0 + catch {destroy $w} + toplevelG $w + + set n [lindex $attr 0] + wm title $w "Index setup $n" + + top-down-window $w + set len [llength $attr] for {set i 1} {$i < $len} {incr i} { set q [lindex $attr $i] @@ -2596,15 +2642,6 @@ proc index-setup {attr queryNo indexNo} { } } } - if {[winfo exists $w]} { - destroy $w - } - toplevelG $w - - set n [lindex $attr 0] - wm title $w "Index setup $n" - - top-down-window $w frame $w.top.use -relief ridge -border 2 frame $w.top.relation -relief ridge -border 2 @@ -2753,7 +2790,7 @@ proc query-setup {queryNo} { listbox $w.top.index.list -yscrollcommand [list $w.top.index.scroll set] scrollbar $w.top.index.scroll -orient vertical -border 1 \ -command [list $w.top.index.list yview] - bind $w.top.index.list <2> [list query-edit-index $queryNo] + bind $w.top.index.list [list query-edit-index $queryNo] pack $w.top.index.list -side left -fill both -expand yes -padx 2 -pady 2 pack $w.top.index.scroll -side right -fill y -padx 2 -pady 2 @@ -2769,13 +2806,14 @@ proc query-setup {queryNo} { foreach x $queryInfoTmp { $w.top.index.list insert end [lindex $x 0] } + # Bottom bottom-buttons $w [list \ - {Ok} [list query-setup-action $queryNo] \ - {Add index} [list query-add-index $queryNo] \ - {Edit index} [list query-edit-index $queryNo] \ - {Delete index} [list query-delete-index $queryNo] \ - {Cancel} [list destroy $w]] 0 + Ok [list query-setup-action $queryNo] \ + Add [list query-add-index $queryNo] \ + Edit [list query-edit-index $queryNo] \ + Delete [list query-delete-index $queryNo] \ + Cancel [list destroy $w]] 0 } proc index-clear {} { @@ -2800,6 +2838,32 @@ proc index-query {} { if {$term != ""} { set attr [lrange [lindex $queryInfoFind [lindex $b 1]] 1 end] + set relation "" + set len [string length $term] + incr len -1 + + if {$len > 1} { + if {[string index $term 0] == ">"} { + if {[string index $term 1] == "=" } { + set term [string trim [string range $term 2 $len]] + set relation 4 + } else { + set term [string trim [string range $term 1 $len]] + set relation 5 + } + } elseif {[string index $term 0] == "<"} { + if {[string index $term 1] == "=" } { + set term [string trim [string range $term 2 $len]] + set relation 2 + } elseif {[string index $term 1] == ">"} { + set term [string trim [string range $term 2 $len]] + set relation 6 + } else { + set term [string trim [string range $term 1 $len]] + set relation 1 + } + } + } set len [string length $term] incr len -1 set left 0 @@ -2820,6 +2884,9 @@ proc index-query {} { } elseif {$left} { set term "@attr 5=2 ${term}" } + if {$relation != ""} { + set term "@attr 2=${relation} ${term}" + } foreach a $attr { set term "@attr $a ${term}" } @@ -3002,6 +3069,7 @@ menu .top.options.m .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 +.top.options.m add cascade -label "Elements" -menu .top.options.m.elements menu .top.options.m.query .top.options.m.query add cascade -label "Select" \ @@ -3059,6 +3127,14 @@ menu .top.options.m.syntax .top.options.m.syntax add radiobutton -label "GRS1" \ -value GRS1 -variable recordSyntax +menu .top.options.m.elements +.top.options.m.elements add radiobutton -label "Unspecified" \ + -value None -variable elementSetNames +.top.options.m.elements add radiobutton -label "Full" \ + -value F -variable elementSetNames +.top.options.m.elements add radiobutton -label "Brief" \ + -value B -variable elementSetNames + menubutton .top.help -text "Help" -menu .top.help.m menu .top.help.m @@ -3102,8 +3178,18 @@ if {! $monoFlag} { } .data.record tag configure marc-data -foreground black .data.record tag configure marc-head \ - -font -Adobe-Times-Medium-R-Normal-*-180-* \ - -foreground white -background black + -font -Adobe-Times-Medium-R-Normal-*-140-* \ + -foreground brown -relief raised -borderwidth 1 +.data.record tag configure marc-small-head -foreground brown +.data.record tag configure marc-pref \ + -font -Adobe-Times-Medium-R-Normal-*-140-* \ + -foreground blue +.data.record tag configure marc-text \ + -font -Adobe-Times-Medium-R-Normal-*-140-* \ + -foreground black +.data.record tag configure marc-it \ + -font -Adobe-Times-Medium-I-Normal-*-140-* \ + -foreground black button .bot.logo -bitmap @${libdir}/bitmaps/book1 -command cancel-operation if {[tk4]} {