# IR toolkit for tcl/tk
-# (c) Index Data 1995-1996
+# (c) Index Data 1995-1998
# See the file LICENSE for details.
# Sebastian Hammer, Adam Dickmeiss
#
+# Configuration Driver
+#
# $Log: setup.tcl,v $
-# Revision 1.1 1996-09-13 10:54:25 adam
-# Started work on Explain in client.
+# Revision 1.6 1999-12-12 00:25:59 adam
+# Updated list of preconfigure targets.
#
+# Revision 1.5 1998/04/02 14:32:01 adam
+# Minor changes to EXPLAIN driver.
+#
+# Revision 1.4 1998/02/12 13:32:42 adam
+# Updated configuration system.
+#
+# Revision 1.3 1998/01/30 13:30:50 adam
+# Name of target database is irtdb.tcl instead of clientrc.tcl.
+#
+# Revision 1.2 1997/11/19 11:20:57 adam
+# New target profile format - associative arrrays instead of LONG lists.
+#
+# Revision 1.1 1996/09/13 10:54:25 adam
+# Started work on Explain in client.
#
-
-set pref(font,h1) {-Adobe-Helvetica-Bold-R-Normal-*-240-*}
-set pref(font,h2) {-Adobe-Helvetica-Bold-R-Normal-*-180-*}
-set pref(font,h3) {-Adobe-Helvetica-Bold-R-Normal-*-140-*}
-set pref(font,h4) {-Adobe-Helvetica-Bold-R-Normal-*-120-*}
-
-set pref(font,s1) {-Adobe-Helvetica-Bold-R-Normal-*-100-*}
-set pref(font,s2) {-Adobe-Helvetica-Bold-R-Normal-*-80-*}
proc print-date {w msg date} {
frame $w
proc protocol-setup {target} {
global profileS profile
- set tinfo $profile($target)
-
- set profileS($target,targetDescription) [lindex $tinfo 0]
- set profileS($target,host) [lindex $tinfo 1]
- set profileS($target,port) [lindex $tinfo 2]
- set profileS($target,idAuthentication) [lindex $tinfo 3]
- set profileS($target,targetMRS) [lindex $tinfo 4]
-
- set profileS($target,targetPMS) [lindex $tinfo 5]
- set profileS($target,comstack) [lindex $tinfo 6]
- set profileS($target,databases) [lindex $tinfo 7]
- set profileS($target,targetResultSets) [lindex $tinfo 8]
- set profileS($target,RPN) [lindex $tinfo 9]
- set profileS($target,CCL) [lindex $tinfo 10]
-
- set profileS($target,protocolType) [lindex $tinfo 11]
- set profileS($target,wno) [lindex $tinfo 12]
- set profileS($target,LSLB) [lindex $tinfo 13]
- set profileS($target,SSUB) [lindex $tinfo 14]
-
- set profileS($target,MSPN) [lindex $tinfo 15]
- set profileS($target,PresentChunk) [lindex $tinfo 16]
- set profileS($target,timeDefine) [lindex $tinfo 17]
- set profileS($target,timeInit) [lindex $tinfo 18]
- set profileS($target,timeExplain) [lindex $tinfo 19]
-
- set profileS($target,targetName) [lindex $tinfo 20]
- set profileS($target,targetRecentNews) [lindex $tinfo 21]
- set profileS($target,targetMaxResultSets) [lindex $tinfo 22]
- set profileS($target,targetMaxResultSize) [lindex $tinfo 23]
- set profileS($target,targetMaxTerms) [lindex $tinfo 24]
-
- set profileS($target,spare) [lindex $tinfo 25]
- set profileS($target,targetMultipleDatabases) [lindex $tinfo 26]
- set profileS($target,targetWelcome) [lindex $tinfo 27]
-
+ foreach n [array names profile $target,*] {
+ set profileS($n) $profile($n)
+ }
target-setup $target 0 0
}
set timedef $profileS($target,timeDefine)
if {![string length $timedef]} {
- set timedef [clock seconds]
+ set profileS($target,timeDefine) [clock seconds]
}
- set profile($target) [list \
- $profileS($target,targetDescription) \
- $profileS($target,host) \
- $profileS($target,port) \
- $profileS($target,idAuthentication) \
- $profileS($target,targetMRS) \
- $profileS($target,targetPMS) \
- $profileS($target,comstack) \
- $profileS($target,databases) \
- $profileS($target,targetResultSets) \
- $profileS($target,RPN) \
- $profileS($target,CCL) \
- $profileS($target,protocolType) \
- $profileS($target,wno) \
- $profileS($target,LSLB) \
- $profileS($target,SSUB) \
- $profileS($target,MSPN) \
- $profileS($target,PresentChunk) \
- $profileS($target,timeDefine) \
- $profileS($target,timeInit) \
- $profileS($target,timeExplain) \
- $profileS($target,targetName) \
- $profileS($target,targetRecentNews) \
- $profileS($target,targetMaxResultSets) \
- $profileS($target,targetMaxResultSize) \
- $profileS($target,targetMaxTerms) \
- $profileS($target,spare) \
- $profileS($target,targetMultipleDatabases) \
- $profileS($target,targetWelcome) \
- ]
+ foreach n [array names profileS $target,*] {
+ set profile($n) $profileS($n)
+ unset profileS($n)
+ }
set settingsChanged 1
cascade-target-list
delete-target-hotlist $target
}
+proc target-setup-delete {target category dir} {
+
+ if {![string compare $target Default]} return
+ set a [alert "Are you sure you want to delete the target \
+definition $target ?"]
+ if {$a} {
+ target-setup $target $category $dir
+ }
+}
+
proc target-setup {target category dir} {
+ global profile settingsChanged
+
+ set w .setup-$profile($target,windowNumber)
- set w .setup100
if {$dir} {
- target-setup-leave-$category $target
+ target-setup-leave-$category $target $w
}
- if {$dir == 2} {
+ if {$dir == 3} {
+ foreach n [array names profile $target,*] {
+ unset profile($n)
+ }
+ set settingsChanged 1
+ cascade-target-list
+ delete-target-hotlist $target
+ destroy $w
+ return
+ } elseif {$dir == 2} {
protocol-setup-action $target
destroy $w
return
- }
- incr category $dir
- if {[winfo exists $w]} {
- destroy $w.top
- destroy $w.bot
} else {
- toplevel $w
- wm geometry $w 430x400
- }
- if {$target == ""} {
- set target Default
+ incr category $dir
+ if {[winfo exists $w]} {
+ destroy $w.top
+ destroy $w.bot
+ } else {
+ toplevelG $w
+ wm geometry $w 430x370
+ }
+ if {$target == ""} {
+ set target Default
+ }
+ top-down-window $w
+ bottom-buttons $w \
+ [list {Ok} [list target-setup $target $category 2] \
+ {Previous} [list target-setup $target $category -1] \
+ {Next} [list target-setup $target $category 1] \
+ {Delete} [list target-setup-delete $target $category 3] \
+ {Cancel} [list destroy $w]] 0
+ if {$category == 0} {
+ $w.bot.2 configure -state disabled
+ }
+ if {$category == 2} {
+ $w.bot.4 configure -state disabled
+ }
+ target-setup-enter-$category $target $w
}
- top-down-window $w
- bottom-buttons $w [list \
- {Ok} [list target-setup $target $category 2] \
- {Previous} [list target-setup $target $category -1] \
- {Next} [list target-setup $target $category 1] \
- {Cancel} [list destroy $w]] 0
- if {$category == 0} {
- $w.bot.2 configure -state disabled
- }
- if {$category == 2} {
- $w.bot.4 configure -state disabled
- }
- target-setup-enter-$category $target
}
-proc target-setup-leave-0 {target} {
+proc target-setup-leave-0 {target w} {
global profileS
- set w .setup100
set y $w.top.hostport
- set profileS($target,host) [$y.host.entry get]
- set profileS($target,port) [$y.port.entry get]
- set profileS($target,idAuthentication) [$y.idAuthentication.entry get]
}
-proc target-setup-enter-0 {target} {
+proc target-setup-enter-0 {target w} {
global profileS
- set w .setup100
-
wm title $w "$target - Initial Information"
# host/port/id . . .
{{Host:} {Port:} {Id Authentication:}} \
[list target-setup $target 0 2] [list destroy $w]
- $y.host.entry insert 0 $profileS($target,host)
- $y.port.entry insert 0 $profileS($target,port)
- $y.idAuthentication.entry insert 0 $profileS($target,idAuthentication)
-
- # bottom
-
- set y $w.top.bottom
-
- frame $y
- pack $y -side bottom -fill both -expand yes
+ $y.host.entry configure -textvariable \
+ profileS($target,host)
+ $y.port.entry configure -textvariable \
+ profileS($target,port)
+ $y.idAuthentication.entry configure -textvariable \
+ profileS($target,idAuthentication)
+
+ # databases
+
+ frame $w.top.name -relief ridge -border 2
+ pack $w.top.name -pady 2 -padx 2 -side bottom -fill both -expand yes
+
+ label $w.top.name.label -text "Databases"
+ pack $w.top.name.label -side top -fill x
+
+ frame $w.top.name.buttons -border 2
+ pack $w.top.name.buttons -side right
+
+ button $w.top.name.buttons.add -text "Add" -command \
+ [list target-setup-db-add $target $w]
+ button $w.top.name.buttons.remove -text "Remove" -state disabled \
+ -command [list target-setup-db-remove $target $w]
+ button $w.top.name.buttons.configure -text "Configure" -state disabled
+ pack $w.top.name.buttons.add -side top -fill x
+ pack $w.top.name.buttons.remove -side top -fill x
+ pack $w.top.name.buttons.configure -side top -fill x
+
+ scrollbar $w.top.name.scroll -orient vertical -border 1
+ listbox $w.top.name.list -border 1 -height 5 -yscrollcommand \
+ [list $w.top.name.scroll set]
+ pack $w.top.name.list -side left -padx 2 -pady 2 -fill both -expand yes
+ pack $w.top.name.scroll -side right -padx 2 -pady 2 -fill y
+ $w.top.name.scroll config -command [list $w.top.name.list yview]
+
+ target-setup-dblist-update $target $w
# misc. dates . . .
label $y.label -text "Dates"
pack $y.label -side top -fill x
print-date $w.top.dates.a {Defined:} $profileS($target,timeDefine)
- print-date $w.top.dates.b {Last Access:} $profileS($target,timeInit)
- print-date $w.top.dates.c {Last Explain:} $profileS($target,timeExplain)
+ print-date $w.top.dates.b {Last Access:} $profileS($target,timeLastInit)
+ print-date $w.top.dates.c {Last Explain:} $profileS($target,timeLastExplain)
# protocol . . .
label $y.label -text "Protocol"
radiobutton $y.z39v2 -text "Z39.50" -anchor w \
- -variable profileS($target,protocolType) -value Z39
+ -variable profileS($target,protocol) -value Z39
radiobutton $y.sr -text "SR" -anchor w \
- -variable profileS($target,protocolType) -value SR
+ -variable profileS($target,protocol) -value SR
pack $y.label $y.z39v2 $y.sr -padx 2 -side top -fill x
radiobutton $y.mosi -text "MOSI" -anchor w\
-variable profileS($target,comstack) -value mosi
pack $y.label $y.tcpip $y.mosi -padx 2 -side top -fill x
+
}
-proc target-setup-leave-1 {target} {
+proc target-setup-leave-1 {target w} {
global profileS
- set w .setup100
set y $w.top.nr
- set profileS($target,targetName) [$y.name.text get 0.0 end]
- set profileS($target,targetRecentNews) [$y.recentNews.text get 0.0 end]
- set profileS($target,targetDescription) [$y.description.text get 0.0 end]
+ set profileS($target,targetInfoName) \
+ [string trim [$y.name.text get 0.0 end]]
+ set profileS($target,recentNews) \
+ [string trim [$y.recentNews.text get 0.0 end]]
+ set profileS($target,description) \
+ [string trim [$y.description.text get 0.0 end]]
+ set profileS($target,welcomeMessage) \
+ [string trim [$y.welcome.text get 0.0 end]]
set y $w.top.rs
-
- set profileS($target,targetMaxResultSets) [$y.maxResultSets.entry get]
- set profileS($target,targetMaxResultSize) [$y.maxResultSize.entry get]
- set profileS($target,targetMaxTerms) [$y.maxTerms.entry get]
}
-proc target-setup-enter-1 {target} {
+proc target-setup-enter-1 {target w} {
global profileS
- set w .setup100
-
wm title $w "$target - Target Information"
# Name, Recent News . . .
text $y.name.text -width 40 -height 2 -relief sunken -border 1 \
-wrap word
TextEditable $y.name.text
- $y.name.text insert end $profileS($target,targetName)
+ $y.name.text insert end $profileS($target,targetInfoName)
pack $y.name.text -side right -fill x -expand yes
label $y.recentNews.label -text "Recent News" -width 15
text $y.recentNews.text -width 40 -height 2 -relief sunken -border 1 \
-wrap word
TextEditable $y.recentNews.text
- $y.recentNews.text insert end $profileS($target,targetRecentNews)
+ $y.recentNews.text insert end $profileS($target,recentNews)
pack $y.recentNews.text -side right -fill x -expand yes
label $y.description.label -text "Description" -width 15
text $y.description.text -width 40 -height 4 -relief sunken -border 1 \
-wrap word
TextEditable $y.description.text
- $y.description.text insert end $profileS($target,targetDescription)
+ $y.description.text insert end $profileS($target,description)
pack $y.description.text -side right -fill x -expand yes
label $y.welcome.label -text "Welcome Message" -width 15
text $y.welcome.text -width 40 -height 4 -relief sunken -border 1 \
-wrap word
TextEditable $y.welcome.text
- $y.welcome.text insert end $profileS($target,targetWelcome)
+ $y.welcome.text insert end $profileS($target,welcomeMessage)
pack $y.welcome.text -side right -fill x -expand yes
# Result Sets Size, numbers, etc. . . .
{{Max Result Sets:} {Max Result Size:} {Max Terms:}} \
[list target-setup $target 1 2] [list destroy $w]
- $y.maxResultSets.entry insert 0 $profileS($target,targetMaxResultSets)
- $y.maxResultSize.entry insert 0 $profileS($target,targetMaxResultSize)
- $y.maxTerms.entry insert 0 $profileS($target,targetMaxTerms)
+ $y.maxResultSets.entry configure \
+ -textvariable profileS($target,targetMaxResultSets)
+ $y.maxResultSize.entry configure \
+ -textvariable profileS($target,targetMaxResultSize)
+ $y.maxTerms.entry configure \
+ -textvariable profileS($target,targetMaxTerms)
# Checkbuttons . . .
set y $w.top.ns
pack $y -side right -padx 2 -pady 2 -fill both -expand yes
checkbutton $y.resultSets -text "Named Result Sets" \
- -anchor n -variable profileS($target,targetResultSets)
+ -anchor n -variable profileS($target,namedResultSets)
checkbutton $y.multipleDatabases -text "Multiple Database Search" \
- -anchor n -variable profileS($target,targetMultipleDatabases)
+ -anchor n -variable profileS($target,multipleDatabases)
pack $y.resultSets $y.multipleDatabases -side top -padx 2 -pady 2
$menu configure -text $e
}
-proc target-setup-leave-2 {target} {
+proc target-setup-leave-2 {target w} {
global profileS
}
set w .database-select
set db [$w.top.database.entry get]
- if {![string length [lindex $profileS($target,databases) 0]]} {
- set profileS($target,databases) $db
- } else {
- lappend profileS($target,databases) $db
- }
+ lappend profileS($target,databases) $db
+
destroy $w
- target-setup-dblist-update $target
+ target-setup-dblist-update $target $wp
}
proc target-setup-db-remove {target wp} {
set w .setup100
set y $w.top.name
- set db [$y.data cget -text]
+ set db [$wp.top.name.list get active]
+
set a [alert "Are you sure you want to remove the database ${db}?"]
if {$a} {
set i [lsearch -exact $profileS($target,databases) $db]
set profileS($target,databases) \
[lreplace $profileS($target,databases) $i $i]
}
- target-setup-dblist-update $target
+ target-setup-dblist-update $target $wp
+ if {![llength $profileS($target,databases)]} {
+ unset profileS($target,databases)
+ }
}
}
-proc target-setup-dblist-update {target} {
+proc target-setup-dblist-update {target w} {
global profileS
- set w .setup100
set y $w.top.name
- set no 0
- set databaseList $profileS($target,databases)
- $y.data configure -text [lindex $databaseList 0]
- $y.data.m delete 0 100
- foreach d $databaseList {
- $y.data.m add command -label $d -command \
- [list target-setup-2-dbselect $y.data $d]
- incr no
- }
- if {$no == 0} {
- $y.remove configure -state disabled
+ $w.top.name.list delete 0 end
+ if {[info exists profileS($target,databases)]} {
+ foreach db $profileS($target,databases) {
+ $w.top.name.list insert end $db
+ }
+ $w.top.name.buttons.remove configure -state normal
+ $w.top.name.list see 0
+ $w.top.name.list select set 0
} else {
- $y.remove configure -state normal
+ $w.top.name.buttons.remove configure -state disabled
}
}
-proc target-setup-enter-2 {target} {
- global profileS
+proc target-setup-add {target w} {
- set w .setup100
- set databaseList $profileS($target,databases)
-
- wm title $w "$target - Database Information"
-
- frame $w.top.name -border 2
- pack $w.top.name -pady 2 -padx 2 -side top -fill x
-
- label $w.top.name.label -text "Database Name"
-
- pack $w.top.name.label -side left
- menubutton $w.top.name.data -menu $w.top.name.data.m -relief raised
- menu $w.top.name.data.m
-
- pack $w.top.name.data -side left
-
- button $w.top.name.add -text "Add" -command \
- [list target-setup-db-add $target $w]
- pack $w.top.name.add -side right
+}
- button $w.top.name.remove -text "Remove" -command \
- [list target-setup-db-remove $target $w]
- pack $w.top.name.remove -side right
+proc target-setup-enter-2 {target w} {
+ global profileS
+ wm title $w "$target - Other Information (not yet completed)"
+
frame $w.top.data -relief ridge -border 2
pack $w.top.data -pady 2 -padx 2 -side top -fill x
- target-setup-dblist-update $target
-
frame $w.top.data.avRecordSize
frame $w.top.data.maxRecordSize
projects / ir-tcl-moved-to-github.git / blobdiff