iterate.tcl

   1 # $Id: iterate.tcl,v 1.6 1997-04-13 19:00:43 adam Exp $
   2 #
   3 # Small test script which searches for science ...
   4 proc fail-back {} {
   5     puts "Fail"
   6 }
   7
   8 proc connect-response {} {
   9     z callback {init-response}
  10     z init
  11 }
  12 proc init-response {} {
  13     global count
  14
  15     set count 0
  16     puts "In init-response"
  17     do-search
  18 }
  19
  20 proc do-search {} {
  21     global count
  22
  23     incr count
  24     puts $count
  25     catch {rename z.1 {}}
  26     ir-set z.1 z
  27     z callback {search-response}
  28     z.1 preferredRecordSyntax sutrs
  29     z.1 search the
  30 }
  31
  32 proc search-response {} {
  33     set hits [z.1 resultCount]
  34     if {$hits <= 0} {
  35         do-search
  36         return
  37     }
  38     z callback {present-response}
  39     if {$hits < 20} {
  40         z.1 present 1 $hits
  41     } else {
  42         z.1 present 1 20
  43     }
  44 }
  45
  46 proc present-response {} {
  47     do-search
  48 }
  49
  50 ir z
  51 z failback {fail-back}
  52 z databaseNames Default
  53 z callback {connect-response}
  54 z connect localhost:9999
  55 vwait forever