client.tcl

   1 #
   2 # $Log: client.tcl,v $
   3 # Revision 1.3  1995-03-12 19:31:52  adam
   4 # Pattern matching implemented when retrieving MARC records. More
   5 # diagnostic functions.
   6 #
   7 # Revision 1.2  1995/03/10  18:00:15  adam
   8 # Actual presentation in line-by-line format. RPN query support.
   9 #
  10 # Revision 1.1  1995/03/09  16:15:07  adam
  11 # First presentRequest attempts. Hot-target list.
  12 #
  13 #
  14 set hotTargets {}
  15 set hotInfo {}
  16 set busy 0
  17
  18 wm minsize . 360 200
  19 wm maxsize . 800 800
  20
  21 if {[file readable "~/.tk-c"]} {
  22     source "~/.tk-c"
  23 }
  24
  25 proc show-target {target} {
  26     .bot.target configure -text "$target"
  27 }
  28
  29 proc show-busy {v1 v2} {
  30     global busy
  31     if {$busy != 0} {
  32         .bot.status configure -fg $v1
  33         after 200 [list show-busy $v2 $v1]
  34     }
  35 }
  36
  37 proc show-status {status b} {
  38     global busy
  39     global statusbg
  40     .bot.status configure -text "$status"
  41     .bot.status configure -fg black
  42     if {$b != 0} {
  43         if {$busy == 0} {
  44             set busy $b
  45             show-busy red blue
  46         }
  47         #        . config -cursor {watch black white}
  48     } else {
  49         #        . config -cursor {top_left_arrow black white}
  50         puts "Normal"
  51     }
  52     set busy $b
  53 }
  54
  55 proc show-message {msg} {
  56     .bot.message configure -text "$msg"
  57 }
  58
  59 proc update-target-hotlist {target} {
  60     global hotTargets
  61
  62     set len [llength $hotTargets]
  63     if {$len > 0} {
  64         .top.target.m delete 5 [expr 5+[llength $hotTargets]]
  65     }
  66     set indx [lsearch $hotTargets $target]
  67     if {$indx >= 0} {
  68         set hotTargets [lreplace $hotTargets $indx $indx]
  69     }
  70     set hotTargets [linsert $hotTargets 0 $target]
  71     set-target-hotlist
  72 }
  73
  74 proc set-target-hotlist {} {
  75     global hotTargets
  76
  77     set i 1
  78     foreach target $hotTargets {
  79         .top.target.m add command -label $target -command \
  80             "menu-open-target $target"
  81         incr i
  82         if {$i > 8} {
  83              break
  84         }
  85     }
  86 }
  87
  88 proc menu-open-target {target} {
  89     open-target $target
  90     update-target-hotlist $target
  91 }
  92
  93 proc open-target-action {} {
  94     set host [.target-connect.top.host.entry get]
  95     set port [.target-connect.top.port.entry get]
  96
  97     if {$host == ""} {
  98         return
  99     }
 100     if {$port == ""} {
 101         set port 210
 102     }
 103     open-target "${host}:${port}"
 104     update-target-hotlist ${host}:${port}
 105     destroy .target-connect
 106 }
 107
 108 proc open-target {target} {
 109     z39 disconnect
 110     global csRadioType
 111     z39 comstack ${csRadioType}
 112     show-target $target
 113     z39 connect $target
 114
 115     init-request
 116 }
 117
 118 proc init-request {} {
 119     global SetNo
 120
 121     z39 callback {init-response}
 122     z39 init
 123     show-status {Initializing} 1
 124     set SetNo 0
 125 }
 126
 127 proc init-response {} {
 128     show-status {Ready} 0
 129     pack .mid.searchlabel .mid.searchentry -side left
 130     bind .mid.searchentry <Return> search-request
 131     focus .mid.searchentry
 132 }
 133
 134 proc search-request {} {
 135     global SetNo
 136
 137     incr SetNo
 138     ir-set z39.$SetNo
 139
 140     z39 callback {search-response}
 141     z39.$SetNo search [.mid.searchentry get]
 142     show-status {Search} 1
 143 }
 144
 145 proc search-response {} {
 146     global SetNo
 147     global setOffset
 148     global setMax
 149
 150     .data.list delete 0 end
 151     show-status {Ready} 0
 152     show-message "[z39.$SetNo resultCount] hits"
 153     set setMax [z39.$SetNo resultCount]
 154     puts $setMax
 155     if {$setMax > 16} {
 156         set setMax 16
 157     }
 158     z39 callback {present-response}
 159     set setOffset 1
 160     z39.$SetNo present 1 $setMax
 161     show-status {Retrieve} 1
 162 }
 163
 164 proc present-response {} {
 165     global SetNo
 166     global setOffset
 167     global setMax
 168
 169     puts "In present-response"
 170     set no [z39.$SetNo numberOfRecordsReturned]
 171     puts "Returned $no records, setOffset $setOffset"
 172     for {set i 0} {$i < $no} {incr i} {
 173         set o [expr $i + $setOffset]
 174         set title [lindex [z39.$SetNo getMARC $o field 245 a] 0]
 175         set year  [lindex [z39.$SetNo getMARC $o field 260 c] 0]
 176         .data.list insert end "$title - $year"
 177     }
 178     set setOffset [expr $setOffset + $no]
 179     if { $setOffset <= $setMax} {
 180         z39.$SetNo present $setOffset [expr $setMax - $setOffset + 1]
 181     } else {
 182         show-status {Finished} 0
 183     }
 184 }
 185
 186 proc bind-fields {list returnAction escapeAction} {
 187     set max [expr [llength $list]-1]
 188     for {set i 0} {$i < $max} {incr i} {
 189         bind [lindex $list $i] <Return> $returnAction
 190         bind [lindex $list $i] <Escape> $escapeAction
 191         bind [lindex $list $i] <Tab> [list focus [lindex $list [expr $i+1]]]
 192     }
 193     bind [lindex $list $i] <Return> $returnAction
 194     bind [lindex $list $i] <Escape> $escapeAction
 195     bind [lindex $list $i] <Tab>    [list focus [lindex $list 0]]
 196     focus [lindex $list 0]
 197 }
 198
 199 proc entry-fields {parent list tlist returnAction escapeAction} {
 200     set alist {}
 201     set i 0
 202     foreach field $list {
 203         set label ${parent}.${field}.label
 204         set entry ${parent}.${field}.entry
 205         label $label -text [lindex $tlist $i] -anchor e
 206         entry $entry -width 30 -relief sunken
 207         pack $label -side left
 208         pack $entry -side right
 209         lappend alist $entry
 210         incr i
 211     }
 212     bind-fields $alist $returnAction $escapeAction
 213 }
 214
 215 proc open-target-dialog {} {
 216     set w .target-connect
 217
 218     toplevel $w
 219
 220     place-force $w .
 221
 222     frame $w.top -relief sunken -border 1
 223     frame $w.bot -relief sunken -border 1
 224
 225     pack  $w.top $w.bot -side top -fill both -expand yes
 226
 227     frame $w.top.host
 228     frame $w.top.port
 229
 230     pack $w.top.host $w.top.port \
 231             -side top -anchor e -pady 2
 232
 233     entry-fields $w.top {host port } \
 234             {{Hostname:} {Port number:}} \
 235             {open-target-action} {destroy .target-connect}
 236
 237     frame $w.bot.left -relief sunken -border 1
 238     pack $w.bot.left -side left -expand yes -padx 5 -pady 5
 239     button $w.bot.left.ok -width 6 -text {Ok} \
 240             -command {open-target-action}
 241     pack $w.bot.left.ok -expand yes -padx 3 -pady 3
 242     button $w.bot.cancel -width 6 -text {Cancel} \
 243             -command {destroy .target-connect}
 244     pack $w.bot.cancel -side left -expand yes
 245
 246     grab $w
 247
 248     tkwait window $w
 249 }
 250
 251 proc close-target {} {
 252     pack forget .mid.searchlabel .mid.searchentry
 253     z39 disconnect
 254     show-target {None}
 255     show-status {Not connected} 0
 256     show-message {}
 257 }
 258
 259 proc protocol-setup-action {} {
 260     destroy .protocol-setup
 261 }
 262
 263
 264 proc place-force {window parent} {
 265     set g [wm geometry $parent]
 266
 267     set p1 [string first + $g]
 268     set p2 [string last + $g]
 269
 270     set x [expr 40+[string range $g [expr $p1 +1] [expr $p2 -1]]]
 271     set y [expr 60+[string range $g [expr $p2 +1] end]]
 272     wm geometry $window +${x}+${y}
 273 }
 274
 275 proc protocol-setup {} {
 276     set w .protocol-setup
 277
 278     toplevel $w
 279
 280     place-force $w .
 281
 282     frame $w.top -relief sunken -border 1
 283     frame $w.bot -relief sunken -border 1
 284
 285     pack  $w.top $w.bot -side top -fill both -expand yes
 286
 287     frame $w.top.description
 288     frame $w.top.idAuthentification
 289     frame $w.top.maximumMessageSize
 290     frame $w.top.preferredMessageSize
 291     frame $w.top.cs-type -relief ridge -border 2
 292     frame $w.top.query -relief ridge -border 2
 293
 294 # Maximum/preferred/idAuth ...
 295     pack $w.top.description \
 296             $w.top.idAuthentification $w.top.maximumMessageSize \
 297             $w.top.preferredMessageSize -side top -anchor e -pady 2
 298
 299     entry-fields $w.top {description idAuthentification maximumMessageSize \
 300             preferredMessageSize} \
 301             {{Description:} {Id Authentification:} {Maximum Message Size:}
 302             {Preferred Message Size:}} \
 303             {protocol-setup-action} {destroy .protocol-setup}
 304
 305 # Transport ...
 306     pack $w.top.cs-type -side left -pady 2 -padx 2
 307
 308     global csRadioType
 309
 310     label $w.top.cs-type.label -text "Transport" -anchor e
 311         radiobutton $w.top.cs-type.tcpip -text "TCP/IP" \
 312             -command {puts tcp/ip} -variable csRadioType -value tcpip
 313     radiobutton $w.top.cs-type.mosi -text "MOSI" \
 314             -command {puts mosi} -variable csRadioType -value mosi
 315
 316     pack $w.top.cs-type.label $w.top.cs-type.tcpip $w.top.cs-type.mosi \
 317         -padx 4 -side top -fill x
 318
 319 # Query ...
 320     pack $w.top.query -side right -pady 2 -padx 2 -expand yes
 321
 322     label $w.top.query.label -text "Query support" -anchor e
 323     checkbutton $w.top.query.c1 -text "CCL query"
 324     checkbutton $w.top.query.c2 -text "RPN query"
 325     checkbutton $w.top.query.c3 -text "Result sets"
 326
 327     pack $w.top.query.label -side top -anchor w
 328     pack $w.top.query.c1 $w.top.query.c2 $w.top.query.c3 \
 329          -padx 4 -side left -fill x
 330
 331 # Buttons ...
 332     frame $w.bot.left -relief sunken -border 1
 333     pack $w.bot.left -side left -expand yes -padx 5 -pady 5
 334     button $w.bot.left.ok -width 6 -text {Ok} \
 335             -command {protocol-setup-action}
 336     pack $w.bot.left.ok -expand yes -padx 3 -pady 3
 337     button $w.bot.cancel -width 6 -text {Cancel} \
 338             -command "destroy $w"
 339     pack $w.bot.cancel -side left -expand yes
 340
 341 # Grab ...
 342     grab $w
 343
 344     tkwait window $w
 345
 346 }
 347
 348 proc database-select-action {} {
 349     z39 databaseNames [.database-select.top.database.entry get]
 350     destroy .database-select
 351 }
 352
 353 proc database-select {} {
 354     set w .database-select
 355
 356     toplevel $w
 357
 358     place-force $w .
 359
 360     frame $w.top -relief sunken -border 1
 361     frame $w.bot -relief sunken -border 1
 362
 363     pack  $w.top $w.bot -side top -fill both -expand yes
 364
 365     frame $w.top.database
 366
 367 # Database select
 368     pack $w.top.database -side top -anchor e -pady 2
 369
 370     entry-fields $w.top {database} \
 371             {{Database:}} \
 372             {database-select-action} {destroy .database-select}
 373
 374 # Buttons ...
 375     frame $w.bot.left -relief sunken -border 1
 376     pack $w.bot.left -side left -expand yes -padx 5 -pady 5
 377     button $w.bot.left.ok -width 6 -text {Ok} \
 378             -command {protocol-setup-action}
 379     pack $w.bot.left.ok -expand yes -padx 3 -pady 3
 380     button $w.bot.cancel -width 6 -text {Cancel} \
 381             -command "destroy .database-select"
 382     pack $w.bot.cancel -side left -expand yes
 383
 384 # Grab ...
 385     grab $w
 386
 387     tkwait window $w
 388 }
 389
 390 proc save-settings {} {
 391     global hotTargets
 392
 393     set f [open "~/.tk-c" w]
 394     puts $f "# Setup file"
 395     puts $f "set hotTargets \{ $hotTargets \}"
 396     close $f
 397 }
 398
 399 frame .top -border 1 -relief raised
 400 frame .mid  -border 1 -relief raised
 401 frame .data -border 1 -relief raised
 402 frame .bot -border 1 -relief raised
 403 pack .top .mid -side top -fill x
 404 pack .data      -side top -fill both -expand yes
 405 pack .bot      -fill x
 406
 407 menubutton .top.file -text "File" -menu .top.file.m
 408 menu .top.file.m
 409 .top.file.m add command -label "Save settings" -command {save-settings}
 410 .top.file.m add command -label "Exit" -command {destroy .}
 411
 412 menubutton .top.target -text "Target" -menu .top.target.m
 413 menu .top.target.m
 414 .top.target.m add command -label "Connect" -command {open-target-dialog}
 415 .top.target.m add command -label "Disconnect" -command {close-target}
 416 .top.target.m add command -label "Initialize" -command {init-request}
 417 .top.target.m add command -label "Setup" -command {protocol-setup}
 418 .top.target.m add separator
 419 set-target-hotlist
 420
 421 menubutton .top.database -text "Database" -menu .top.database.m
 422 menu .top.database.m
 423 .top.database.m add command -label "Select ..." -command {database-select}
 424 .top.database.m add command -label "Add ..." -command {puts "Add"}
 425
 426 menubutton .top.help -text "Help" -menu .top.help.m
 427 menu .top.help.m
 428 .top.help.m add command -label "Help on help" -command {puts "Help on help"}
 429 .top.help.m add command -label "About" -command {puts "About"}
 430
 431 pack .top.file .top.target .top.database -side left
 432 pack .top.help -side right
 433
 434 label .mid.searchlabel -text {Search:}
 435 entry .mid.searchentry -width 50 -relief sunken
 436
 437 listbox .data.list -yscrollcommand {.data.scroll set}
 438 #-geometry 50x10
 439 scrollbar .data.scroll -orient vertical -border 1
 440 pack .data.list -side left -fill both -expand yes
 441 pack .data.scroll -side right -fill y
 442 .data.scroll config -command {.data.list yview}
 443
 444 message .bot.target -text "None" -aspect 1000 -relief sunken -border 1
 445 label .bot.status -text "Not connected" -width 12 -relief \
 446     sunken -anchor w -border 1
 447 label .bot.message -text "" -width 20 -relief \
 448     sunken -anchor w -border 1
 449 pack .bot.target .bot.status .bot.message -anchor nw -side left -padx 2 -pady 2
 450
 451 for {set i 0} {$i < 30} {incr i} {
 452     .data.list insert end "Record $i"
 453 }
 454
 455 bind .data.list <Double-Button-1> {set indx [.data.list nearest %y]
 456 puts "y=%y index $indx" }
 457
 458 ir z39
 459 z39 comstack tcpip
 460 set csRadioType [z39 comstack]