shell.tcl

   1 # $Id: shell.tcl,v 1.1 1995-06-30 12:39:27 adam Exp $
   2 #
   3 source display.tcl
   4
   5 proc target {name database} {
   6     ir z
   7     z failback {puts "Connection failed"}
   8     z callback {connect-response}
   9     z databaseNames $database
  10     z connect $name
  11     return {}
  12 }
  13
  14 proc connect-response {} {
  15     z callback {init-response}
  16     z init
  17 }
  18
  19 proc init-response {} {
  20     puts "Connect and initalized. ok"
  21 }
  22
  23 proc find-response {z} {
  24     set sstatus [$z searchStatus]
  25     if {$sstatus} {
  26         set h [$z resultCount]
  27         puts "Search ok. $h hits"
  28     } else {
  29         puts "Search failed"
  30     }
  31     common-response $z 1
  32 }
  33
  34 proc common-response {z from} {
  35     set status [lindex [$z responseStatus] 0]
  36     switch $status {
  37     NSD {
  38             puts -nonewline "NSD"
  39             puts -nonewline [lindex [$z responseStatus] 1]
  40             puts -nonewline " "
  41             puts -nonewline [lindex [$z responseStatus] 2]
  42             puts -nonewline ": "
  43             puts -nonewline [lindex [$z responseStatus] 3]
  44             puts ""
  45         }
  46     DBOSD {
  47             puts "DBOSD"
  48             for {set i $from} {$i < [$z nextResultSetPosition]} {incr i} {
  49                 if {[$z type $i] == ""} {
  50                     break
  51                 }
  52                 puts "\# $i"
  53                 display $z $i
  54             }
  55         }
  56     }
  57 }
  58
  59 proc show {from number} {
  60     z callback "common-response z.1 $from"
  61     z.1 present $from $number
  62 }
  63
  64 proc find {query} {
  65     ir-set z.1 z
  66     z failback {puts "Connection closed"}
  67     z callback {find-response z.1}
  68     z.1 search $query
  69 }
  70