# Sebastian Hammer, Adam Dickmeiss
#
# $Log: client.tcl,v $
-# Revision 1.37 1995-06-13 14:37:59 adam
+# Revision 1.41 1995-06-14 15:07:59 adam
+# Bug fix in cascade-target-list. Uses yaz-version.h.
+#
+# Revision 1.40 1995/06/14 13:37:17 adam
+# Setting recordType implemented.
+# Setting implementationVersion implemented.
+# Settings implementationId / implementationName edited.
+#
+# Revision 1.39 1995/06/14 12:16:22 adam
+# hotTargets, textWrap and displayFormat saved in clientg.tcl.
+#
+# Revision 1.38 1995/06/14 07:22:45 adam
+# Target definitions can be deleted.
+# Listbox used in the query definition dialog.
+#
+# Revision 1.37 1995/06/13 14:37:59 adam
# Work on query setup.
# Better about origin/target.
# Better presentation formats.
set hotInfo {}
set busy 0
+set libDir ""
+
set profile(Default) {{} {} {210} {} 16384 8192 tcpip {} 1 {} {} z39v2}
set hostid Default
set settingsChanged 0
set searchEnable 0
set fullMarcSeq 0
set displayFormat 1
+set textWrap word
set queryTypes {Simple}
set queryButtons { { {I 0} {I 1} {I 2} } }
}
}
+proc set-wrap {m} {
+ global textWrap
+
+ set textWrap $m
+ .data.record configure -wrap $m
+}
+
proc set-display-format {f} {
global displayFormat
global setNo
if {$setNo == 0} {
return
}
+ .bot.a.status configure -text "Reformatting"
+ update idletasks
add-title-lines 0 10000 1
+ .bot.a.status configure -text "Done"
}
proc initBindings {} {
}
}
+proc popup-license {} {
+ set w .popup-licence
+ toplevel $w
+
+ wm title $w "License"
+
+ wm minsize $w 0 0
+
+ top-down-window $w
+
+ text $w.top.t -width 80 -height 10 -wrap word \
+ -yscrollcommand [list $w.top.s set]
+ scrollbar $w.top.s -command [list $w.top.t yview]
+
+ pack $w.top.s -side right -fill y
+ pack $w.top.t -expand yes -fill both
+
+ set f [open "LICENSE" r]
+ while {[gets $f buf] != -1} {
+ $w.top.t insert end $buf
+ $w.top.t insert end "\n"
+ }
+ close $f
+ bottom-buttons $w [list {Close} [list destroy $w]] 1
+}
+
proc about-target {} {
set w .about-target-w
global hostid
bottom-buttons $w [list {Close} [list destroy $w]] 1
}
-proc about-origin {} {
+proc about-origin-logo {n} {
set w .about-origin-w
+ if {![winfo exists $w]} {
+ return
+ }
+ incr n -1
+ if {$n==0} {
+ set n 9
+ }
+ $w.top.a.logo configure -bitmap @book$n
+ after 140 [list about-origin-logo $n]
+}
- toplevelG $w
+proc about-origin {} {
+ set w .about-origin-w
+
+ if {[winfo exists $w]} {
+ destroy $w
+ }
+ toplevel $w
wm title $w "About IrTcl"
place-force $w .
pack $w.top.a $w.top.p -side top -fill x
- label $w.top.a.about -text "About"
label $w.top.a.irtcl -text "IrTcl" \
-font -Adobe-Helvetica-Bold-R-Normal-*-240-*
- pack $w.top.a.about $w.top.a.irtcl -side top
+ label $w.top.a.logo -bitmap @book1
+ pack $w.top.a.irtcl $w.top.a.logo -side left -expand yes
set i [z39 implementationName]
label $w.top.p.in -text "Implementation name: $i"
set i [z39 implementationId]
label $w.top.p.ii -text "Implementation id: $i"
+ set i [z39 implementationVersion]
+ label $w.top.p.iv -text "Implementation version: $i"
- pack $w.top.p.in $w.top.p.ii -side top -anchor nw
+ pack $w.top.p.in $w.top.p.ii $w.top.p.iv -side top -anchor nw
- bottom-buttons $w [list {Close} [list destroy $w]] 1
+ about-origin-logo 1
+ bottom-buttons $w [list {Close} [list destroy $w] \
+ {License} [list popup-license]] 0
}
proc popup-marc {sno no b df} {
global fullMarcSeq
global displayFormats
- global popupMarcOdf
+ global popupMarcdf
if {[z39.$sno type $no] != "DB"} {
return
if {$b} {
set w .full-marc-$fullMarcSeq
incr fullMarcSeq
+ set df $popupMarcdf
} else {
set w .full-marc
+ if {[info exists popupMarcdf]} {
+ set df $popupMarcdf
+ } else {
+ set popupMarcdf $df
+ }
}
if {[winfo exists $w]} {
set new 0
set new 1
}
$w.top.record delete 0.0 end
- wm title $w "Record #$no"
+ set recordType [z39.$sno recordType $no]
+ wm title $w "$recordType record #$no"
set ffunc [lindex $displayFormats $df]
set ffunc "display-$ffunc"
- $ffunc $sno $no $w.top.record 0
+ $ffunc $sno $no $w.top.record 0
if {$new} {
bind $w.top.record <Return> {destroy .full-marc}
if {$b} {
bottom-buttons $w [list \
- {Close} [list destroy $w] \
- {Duplicate} [list popup-marc $sno $no 1 $df]] 0
- menubutton $w.bot.formats -text "Format" -menu $w.bot.formats.m
- menu $w.bot.formats.m
- set i 0
- foreach f $displayFormats {
- $w.bot.formats.m add radiobutton -label $f \
- -command [list display-$f $sno $no $w.top.record 0]
- incr i
- }
- pack $w.bot.formats -expand yes -ipadx 2 -ipady 2 \
- -padx 3 -pady 3 -side left
+ {Close} [list destroy $w]] 0
} else {
bottom-buttons $w [list \
- {Close} [list destroy $w] \
- {Duplicate} [list popup-marc $sno $no 1 $df]] 0
+ {Close} [list destroy $w] \
+ {Duplicate} [list popup-marc $sno $no 1 0]] 0
menubutton $w.bot.formats -text "Format" -menu $w.bot.formats.m
menu $w.bot.formats.m
set i 0
foreach f $displayFormats {
$w.bot.formats.m add radiobutton -label $f \
+ -variable popupMarcdf -value $i \
-command [list display-$f $sno $no $w.top.record 0]
incr i
}
destroy .load-set
if {$fname != ""} {
show-status {Loading} 1 {}
+ update
z39.$setNo loadFile $fname
set no [z39.$setNo numberOfRecordsReturned]
toplevel $w
place-force $w .
-
top-down-window $w
frame $w.top.filename
-
pack $w.top.filename -side top -anchor e -pady 2
entry-fields $w.top {filename} \
foreach a [lrange [lindex $queryInfoFind [lindex $b 1]] 1 end] {
set attr "@attr $a $attr"
}
+ set title [lindex [lindex $queryInfoFind [lindex $b 1]] 0]
ir-scan z39.scan z39
if {![winfo exists $w]} {
toplevelG $w
- wm title $w "Scan"
-
wm minsize $w 0 0
top-down-window $w
{Down} [list scan-down $attr]] 0
bind $w.top.list <Up> [list scan-up $attr]
bind $w.top.list <Down> [list scan-down $attr]
-
-# bind $w.top <Any-Enter> [list focus $w.top.entry]
}
+ wm title $w "Scan $title"
+
z39 callback [list scan-response $attr 0 35]
z39.scan numberOfTermsRequested 5
z39.scan preferredPositionInResponse 1
$ffunc $setno $o .data.record 1
.data.record tag add r$o $insert0 insert
.data.record tag bind r$o <1> \
- [list popup-marc $setno $o 0 $displayFormat]
+ [list popup-marc $setno $o 0 0]
+ update idletasks
}
}
top-down-ok-cancel $w {define-target-action} 1
}
+proc protocol-setup-delete {target} {
+ global profile
+
+ set a [alert "Are you sure you want to delete the target \
+definition $target ?"]
+ if {$a} {
+ set wno [lindex $profile($target) 12]
+ set w .setup-${wno}
+ destroy $w
+ unset profile($target)
+ cascade-target-list
+ }
+}
+
proc protocol-setup-action {target} {
global profile
global csRadioType
set wno [lindex $profile($target) 12]
set w .setup-${wno}
-
- foreach i [lsort -decreasing \
- [$w.top.databases.list curselection]] {
- $w.top.databases.list delete $i
+ set l {}
+ foreach i [$w.top.databases.list curselection] {
+ set b [$w.top.databases.list get $i]
+ set l "$l $b"
+ }
+ set a [alert "Are you sure you want to remove the database(s)${l}?"]
+ if {$a} {
+ foreach i [lsort -decreasing \
+ [$w.top.databases.list curselection]] {
+ $w.top.databases.list delete $i
+ }
}
}
}
# Databases ....
- pack $w.top.databases -side left -pady 6 -padx 6 -expand yes -fill both
+ pack $w.top.databases -side left -pady 4 -padx 4 -expand yes -fill both
label $w.top.databases.label -text "Databases"
button $w.top.databases.add -text "Add" \
}
# Transport ...
- pack $w.top.cs-type -pady 6 -padx 6 -side top -fill x
+ pack $w.top.cs-type -pady 4 -padx 4 -side top -fill x
label $w.top.cs-type.label -text "Transport"
radiobutton $w.top.cs-type.tcpip -text "TCP/IP" -anchor w \
-padx 4 -side top -fill x
# Protocol ...
- pack $w.top.protocol -pady 6 -padx 6 -side top -fill x
+ pack $w.top.protocol -pady 4 -padx 4 -side top -fill x
label $w.top.protocol.label -text "Protocol"
radiobutton $w.top.protocol.z39v2 -text "Z39.50" -anchor w \
-padx 4 -side top -fill x
# Query ...
- pack $w.top.query -pady 6 -padx 6 -side top -fill x
+ pack $w.top.query -pady 4 -padx 4 -side top -fill x
label $w.top.query.label -text "Query support"
checkbutton $w.top.query.c1 -text "RPN query" -anchor w -variable RPNCheck
# Ok-cancel
bottom-buttons $w [list {Ok} [list protocol-setup-action $target] \
+ {Delete} [list protocol-setup-delete $target] \
{Cancel} [list destroy $w]] 0
}
global profile
foreach sub [winfo children .top.target.m.clist] {
- puts "deleting $sub"
destroy $sub
}
.top.target.m.clist delete 0 last
foreach n [array names profile] {
if {$n != "Default"} {
- set nl [string tolower $n]
+ set nl [lindex $profile($n) 12]
if {[llength [lindex $profile($n) 7]] > 1} {
.top.target.m.clist add cascade -label $n \
-menu .top.target.m.clist.$nl
frame $w.top.index
pack $w.top.index \
-side top -anchor e -pady 2
- entry-fields $w.top {index} \
+ entry-fields $w.top index \
{{Query Name:}} \
query-new-action {destroy .query-new}
top-down-ok-cancel $w query-new-action 1
}
+proc query-delete-action {queryNo} {
+ global queryTypes
+ global queryButtons
+ global queryInfo
+ global settingsChanged
+
+ set settingsChanged 1
+
+ set queryTypes [lreplace $queryTypes $queryNo $queryNo]
+ set queryButtons [lreplace $queryButtons $queryNo $queryNo]
+ set queryInfo [lreplace $queryInfo $queryNo $queryNo]
+ destroy .query-delete
+ cascade-query-list
+}
+
+proc query-delete {queryNo} {
+ global queryTypes
+
+ set w .query-delete
+
+ toplevel $w
+ place-force $w .
+ top-down-window $w
+ set n [lindex $queryTypes $queryNo]
+
+ label $w.top.warning -bitmap warning
+ message $w.top.quest -text "Are you sure you want to delete the \
+query type $n ?" -aspect 200
+ pack $w.top.warning $w.top.quest -side left -expand yes -padx 10 -pady 5
+ bottom-buttons $w [list {Ok} [list query-delete-action $queryNo] \
+ {Cancel} [list destroy $w]] 1
+}
+
proc cascade-query-list {} {
global queryTypes
set w .top.options.m.query
$w.clist add command -label $n -command [list query-select $i]
incr i
}
+ set i 0
+ $w.dlist delete 0 last
+ foreach n $queryTypes {
+ $w.dlist add command -label $n -command [list query-delete $i]
+ incr i
+ }
}
proc save-geometry {} {
global windowGeometry
+ global hotTargets
+ global textWrap
+ global displayFormat
set windowGeometry(.) [wm geometry .]
set f [open "clientg.tcl" w]
+ puts $f "set hotTargets \{ $hotTargets \}"
+ puts $f "set textWrap $textWrap"
+ puts $f "set displayFormat $displayFormat"
foreach n [array names windowGeometry] {
puts -nonewline $f "set \{windowGeometry($n)\} \{"
puts -nonewline $f $windowGeometry($n)
}
proc save-settings {} {
- global hotTargets
global profile
global settingsChanged
global queryTypes
set f [open "clientrc.tcl" w]
puts $f "# Setup file"
- puts $f "set hotTargets \{ $hotTargets \}"
foreach n [array names profile] {
puts -nonewline $f "set \{profile($n)\} \{"
place-force $w .
top-down-window $w
- message $w.top.message -text $ask
+ label $w.top.warning -bitmap warning
+ message $w.top.message -text $ask -aspect 200 \
+ -font -Adobe-Times-Medium-R-Normal-*-180-*
- pack $w.top.message -side left -pady 6 -padx 20 -expand yes -fill x
+ pack $w.top.warning $w.top.message -side left -pady 5 -padx 10 -expand yes
set alertAnswer 0
top-down-ok-cancel $w {alert-action} 1
}
proc query-add-index-action {queryNo} {
- set w .setup-query
+ set w .query-setup
global queryInfoTmp
global queryButtonsTmp
- lappend queryInfoTmp [list [.query-add-index.top.index.entry get] {}]
-
+ set newI [.query-add-index.top.index.entry get]
+ lappend queryInfoTmp [list $newI {}]
+ $w.top.index insert end $newI
destroy .query-add-index
#destroy $w.top.lines
#frame $w.top.lines -relief ridge -border 2
}
proc query-add-line {queryNo} {
- set w .setup-query
+ set w .query-setup
global queryInfoTmp
global queryButtonsTmp
}
proc query-del-line {queryNo} {
- set w .setup-query
+ set w .query-setup
global queryInfoTmp
global queryButtonsTmp
set w .query-add-index
toplevel $w
- place-force $w .setup-query
+ place-force $w .query-setup
top-down-window $w
frame $w.top.index
pack $w.top.index \
-side top -anchor e -pady 2
entry-fields $w.top {index} \
{{Index Name:}} \
- [list query-add-index-action $queryNo] {destroy .query-add-index}
+ [list query-add-index-action $queryNo] [list destroy $w]
top-down-ok-cancel $w [list query-add-index-action $queryNo] 1
}
$queryInfoTmp]
set queryButtons [lreplace $queryButtons $queryNo $queryNo \
$queryButtonsTmp]
- destroy .setup-query
+ destroy .query-setup
}
proc activate-e-index {value no i} {
set lno [lindex [$w.top.use.list curselection] 0]
set i [expr $lno+$lno+1]
set useTmpValue [lindex $attr $i]
+ puts "useTmpValue=$useTmpValue"
}
}
use-attr 0
+ puts "index-setup-action"
+ puts "queryNo $queryNo"
+ puts "indexNo $indexNo"
if {$useTmpValue > 0} {
lappend attr "1=$useTmpValue"
}
if {$completenessTmpValue > 0} {
lappend attr "6=$completenessTmpValue"
}
+ puts "new attr $attr"
set queryInfoTmp [lreplace $queryInfoTmp $indexNo $indexNo $attr]
destroy .index-setup
}
}
}
}
+ if {[winfo exists $w]} {
+ destroy $w
+ }
toplevelG $w
set n [lindex $attr 0]
proc query-edit-index {queryNo} {
global queryInfoTmp
- global queryIndexTmp
+ set w .query-setup
- set attr [lindex $queryInfoTmp $queryIndexTmp]
- puts "Editing $attr"
- index-setup $attr $queryNo $queryIndexTmp
+ set i [lindex [$w.top.index.list curselection] 0]
+ if {$i == ""} {
+ return
+ }
+ set attr [lindex $queryInfoTmp $i]
+ puts "Editing no $i $attr"
+ index-setup $attr $queryNo $i
+}
+
+proc query-delete-index {queryNo} {
+ global queryInfoTmp
+ global queryButtonsTmp
+ set w .query-setup
+
+ set i [lindex [$w.top.index.list curselection] 0]
+ if {$i == ""} {
+ return
+ }
+ set queryInfoTmp [lreplace $queryInfoTmp $i $i]
+ index-lines $w.top.lines 0 $queryButtonsTmp $queryInfoTmp activate-e-index
+ $w.top.index.list delete $i
}
proc query-setup {queryNo} {
- set w .setup-query
+ set w .query-setup
global queryTypes
global queryButtons
frame $w.top.lines -relief ridge -border 2
+ pack $w.top.lines -side left -pady 6 -padx 6 -fill y
+
# Index Lines
index-lines $w.top.lines 0 $queryButtonsTmp $queryInfoTmp activate-e-index
- pack $w.top.lines -side left -pady 6 -padx 6 -fill y
+ button $w.top.lines.add -text "Add" \
+ -command [list query-add-line $queryNo]
+ button $w.top.lines.del -text "Remove" \
+ -command [list query-del-line $queryNo]
- # Ok-cancel
+ pack $w.top.lines.del -fill x -side bottom
+ pack $w.top.lines.add -fill x -pady 10 -side bottom
+
+ # Indexes
+
+ frame $w.top.index -relief ridge -border 2
+ pack $w.top.index -pady 6 -padx 6 -side right -fill y
+
+ 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]
+
+ 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
+
+ $w.top.index.list select from 0
+ $w.top.index.list select to 0
+
+ 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] \
- {Add line} [list query-add-line $queryNo] \
- {Delete line} [list query-del-line $queryNo] \
+ {Delete index} [list query-delete-index $queryNo] \
{Cancel} [list destroy $w]] 0
}
menubutton .top.service -text "Service" -underline 0 -menu .top.service.m
menu .top.service.m
.top.service.m add command -label "Database" -command {database-select}
-.top.service.m add cascade -label "Query type" -menu .top.service.m.querytype
-menu .top.service.m.querytype
-.top.service.m.querytype add radiobutton -label "RPN"
-.top.service.m.querytype add radiobutton -label "CCL"
.top.service.m add cascade -label "Present" -menu .top.service.m.present
menu .top.service.m.present
-.top.service.m.present add command -label "More" \
+.top.service.m.present add command -label "10 More" \
-command [list present-more 10]
.top.service.m.present add command -label "All" \
-command [list present-more {}]
+.top.service.m add command -label "Search" -command {search-request}
+.top.service.m add command -label "Scan" -command {scan-request}
+
.top.service configure -state disabled
menubutton .top.rset -text "Set" -menu .top.rset.m
menu .top.options.m
.top.options.m add cascade -label "Query" -menu .top.options.m.query
.top.options.m add cascade -label "Format" -menu .top.options.m.formats
+.top.options.m add cascade -label "Wrap" -menu .top.options.m.wrap
menu .top.options.m.query
-.top.options.m.query add cascade -label "Choose query" \
+.top.options.m.query add cascade -label "Select" \
-menu .top.options.m.query.clist
-.top.options.m.query add cascade -label "Edit query" \
+.top.options.m.query add cascade -label "Edit" \
-menu .top.options.m.query.slist
-.top.options.m.query add command -label "Define query" \
+.top.options.m.query add command -label "New" \
-command {query-new}
+.top.options.m.query add cascade -label "Delete" \
+ -menu .top.options.m.query.dlist
menu .top.options.m.query.slist
menu .top.options.m.query.clist
+menu .top.options.m.query.dlist
cascade-query-list
menu .top.options.m.formats
set i 0
foreach f $displayFormats {
- .top.options.m.formats add radiobutton -label $f \
- -command [list set-display-format $i]
+ .top.options.m.formats add radiobutton -label $f -value $i \
+ -command [list set-display-format $i] -variable displayFormat
incr i
}
+menu .top.options.m.wrap
+.top.options.m.wrap add radiobutton -label "Character" \
+ -value char -variable textWrap -command {set-wrap char}
+.top.options.m.wrap add radiobutton -label "Word" \
+ -value word -variable textWrap -command {set-wrap word}
+.top.options.m.wrap add radiobutton -label "None" \
+ -value none -variable textWrap -command {set-wrap none}
+
menubutton .top.help -text "Help" -menu .top.help.m
menu .top.help.m
-fill y -padx 5 -pady 3
text .data.record -height 2 -width 20 -wrap none \
- -yscrollcommand [list .data.scroll set]
+ -yscrollcommand [list .data.scroll set] -wrap $textWrap
scrollbar .data.scroll -command [list .data.record yview]
pack .data.scroll -side right -fill y
pack .data.record -expand yes -fill both
pack .bot.a.status .bot.a.set .bot.a.message \
-side left -padx 2 -pady 2
-#bind . <Any-Enter> {focus .lines.0.e}
-
ir z39
-#.top.options.m.formats invoke $displayFormat
-
show-logo 1
projects / ir-tcl-moved-to-github.git / blobdiff