X-Git-Url: http://git.indexdata.com/?a=blobdiff_plain;f=setup.tcl;h=227a7c513ed08f7badcd8fb8e9136f7a7213d68c;hb=4d640ad2c7256e7571fbeb0a051473f4924d5456;hp=5696cb7fc271269179120fa4d2a9bd3428ccc657;hpb=1bf7f7dd79d70efaa29e01b2a0ba911b40547154;p=ir-tcl-moved-to-github.git

diff --git a/setup.tcl b/setup.tcl
index 5696cb7..227a7c5 100644
--- a/setup.tcl
+++ b/setup.tcl
@@ -1,21 +1,26 @@
 # 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.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
@@ -50,42 +55,9 @@ proc entry-fieldsx {width parent list tlist returnAction escapeAction} {
 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
 }
 
@@ -96,97 +68,88 @@ proc protocol-setup-action {target} {
     if {![string length $timedef]} {
         set timedef [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 . . .
@@ -204,16 +167,41 @@ proc target-setup-enter-0 {target} {
             {{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 . . .
 
@@ -224,8 +212,8 @@ proc target-setup-enter-0 {target} {
     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 . . .
 
@@ -236,9 +224,9 @@ proc target-setup-enter-0 {target} {
     
     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
 
@@ -255,30 +243,29 @@ proc target-setup-enter-0 {target} {
     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 . . .
@@ -299,7 +286,7 @@ proc target-setup-enter-1 {target} {
     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
@@ -307,7 +294,7 @@ proc target-setup-enter-1 {target} {
     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
@@ -315,7 +302,7 @@ proc target-setup-enter-1 {target} {
     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
@@ -323,7 +310,7 @@ proc target-setup-enter-1 {target} {
     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. . . .
@@ -344,9 +331,12 @@ proc target-setup-enter-1 {target} {
             {{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
@@ -355,10 +345,10 @@ proc target-setup-enter-1 {target} {
     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
 
@@ -368,7 +358,7 @@ proc target-setup-2-dbselect {menu e} {
     $menu configure -text $e
 }
 
-proc target-setup-leave-2 {target} {
+proc target-setup-leave-2 {target w} {
     global profileS
 }
 
@@ -400,13 +390,10 @@ proc target-setup-db-add-action {target wp} {
     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} {
@@ -415,7 +402,8 @@ 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]
@@ -423,65 +411,44 @@ proc target-setup-db-remove {target wp} {
             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