client2/formats/line.tcl

   1 # IR toolkit for tcl/tk
   2 # (c) Index Data 1995
   3 # See the file LICENSE for details.
   4 # Sebastian Hammer, Adam Dickmeiss
   5 #
   6 # $Log: line.tcl,v $
   7 # Revision 1.2  1999-03-17 09:24:11  perhans
   8 # Explain now also finds Gils attributes.
   9 # Support for search with Gils attributes added.
  10 # Stop button added.
  11 # The medium format extended and cleaned up (kommas between termes).
  12 # Lots of minor but fixes.
  13 #
  14 # Revision 1.1  1998/09/30 10:53:54  perhans
  15 # New client with better Explain support and nice icons.
  16
  17 proc display-grs-line {w r i} {
  18     global tagSet
  19
  20     set head Untitled
  21     foreach e $r {
  22         set ttype [lindex $e 0]
  23         set tval [lindex $e 2]
  24             if {$ttype == 2 && $tval == 1} {
  25                 if {[lindex $e 3] == "subtree"} {
  26                     set f [lindex $e 4]
  27                         foreach e $f {
  28                             if {[lindex $e 0] == 1 && [lindex $e 2] == 19} {
  29                                     break
  30                             }
  31                         }
  32                 }
  33                 if {[lindex $e 3] == "string"} {
  34                 set head [lindex $e 4]
  35                 }
  36             break
  37             }
  38     }
  39     insertWithTags $w $head marc-text
  40     insertWithTags $w "\n"
  41     if {[tk4]} {
  42         $w tag configure indent$i -lmargin1 [expr $i * 10] \
  43             -lmargin2 [expr $i * 10 + 5]
  44         $w tag add indent$i $start insert
  45     }
  46 }
  47
  48 # Procedure display-line {sno no w hflag}
  49 #  sno    result set number (integer)
  50 #  no     record position (integer)
  51 #  w      text widget in which the record should be displayed.
  52 #  hflag  header flag. If true a header showing the record position
  53 #         should be displayed.
  54 # This procedure attempts to display records in a line-per-line format.
  55 proc display-line {sno no w hflag} {
  56     set type [z39.$sno type $no]
  57     if {$hflag} {
  58         $w tag bind r$no <Any-Enter> \
  59             [list $w tag configure r$no -background black -foreground white]
  60         $w tag bind r$no <Any-Leave> \
  61             [list $w tag configure r$no -background {} -foreground {}]
  62     } else {
  63         $w delete 0.0 end
  64     }
  65     if {$hflag} {
  66         set nostr [format "%5d " $no]
  67         insertWithTags $w $nostr marc-small-head
  68     }
  69     if {$type == "DB"} {
  70         set rtype [z39.$sno recordType $no]
  71         if {$rtype == "SUTRS"} {
  72             insertWithTags $w [join [z39.$sno getSutrs $no]]
  73         } elseif {$rtype == "GRS-1"} {
  74             display-grs-line $w [z39.$sno getGrs $no] 0
  75         } else {
  76             if {[catch {
  77                 set title [lindex [z39.$sno getMarc $no field 245 * a] 0]
  78                 set year  [lindex [z39.$sno getMarc $no field 260 * c] 0]
  79                 insertWithTags $w "$title" marc-text
  80                 insertWithTags $w "$year\n" marc-it
  81             }]} {
  82                 insertWithTags $w "Unknown record type: $rtype\n" marc-id
  83             }
  84         }
  85     } elseif {$type == "SD"} {
  86         set err [lindex [z39.$sno diag $no] 1]
  87         set add [lindex [z39.$sno diag $no] 2]
  88         if {$add != {}} {
  89             set add " :${add}"
  90         }
  91         insertWithTags $w "Error ${err}${add}\n" marc-id
  92     }
  93 }