-wm title . "IrTcl Client"
-#wm iconname . "IrTcl Client"
+#!/usr/bin/wish
+# $Id: client.tcl,v 1.8 1999-03-30 15:02:40 perhans Exp $
+#
+wm title . "IrTcl Client"
# Procedure irmenu
proc irmenu {w} {
- menu $w -tearoff off
+ menu $w -tearoff off
}
-proc debug-window {} {
- set w .debug-window
- toplevel $w
-
- wm title $w "Debug Window"
+proc debug-window {text} {
+ if {[winfo exists .debug-window.top.t]} {
+ .debug-window.top.t insert end "$text \n"
+ } else {
+ set w .debug-window
+ toplevel $w
- frame $w.top -relief raised -border 1
- frame $w.bot -relief raised -border 1
- pack $w.top -side top -fill both -expand yes
- pack $w.bot -fill both
- scrollbar $w.top.s -command [list $w.top.t yview]
- text $w.top.t -width 60 -height 10 -wrap word -relief flat -borderwidth 0 \
- -font fixed -yscroll [list $w.top.s set]
- pack $w.top.s -side right -fill y
- pack $w.top.t -expand yes -fill both -expand y
+ wm title $w "Debug Window"
+
+ frame $w.top -relief raised -border 1
+ frame $w.bot -relief raised -border 1
+ pack $w.top -side top -fill both -expand yes
+ pack $w.bot -fill both
+ scrollbar $w.top.s -command [list $w.top.t yview]
+ text $w.top.t -width 60 -height 10 -wrap word -relief flat \
+ -borderwidth 0 -font fixed -yscroll [list $w.top.s set]
+ pack $w.top.s -side right -fill y
+ pack $w.top.t -expand yes -fill both -expand y
+ .debug-window.top.t insert end "$text \n"
+ }
}
-debug-window
-
# Procedure configure-enable-e {w n}
# w is a menu
# n menu entry number (0 is first entry)
# Enables menu entry
proc configure-enable-e {w n} {
- $w entryconfigure $n -state normal
+ $w entryconfigure $n -state normal
}
# Procedure configure-disable-e {w n}
# n menu entry number (0 is first entry)
# Disables menu entry
proc configure-disable-e {w n} {
- $w entryconfigure $n -state disabled
+ $w entryconfigure $n -state disabled
}
set noFocus [list -takefocus 0]
set delayRequest {}
set debugMode 0
set queryAutoOld 0
+set leadText 1
set queryTypes {Simple}
-set queryButtons { { {I 0} {I 1} {I 2} } }
-set queryInfo { { {Title {1=4 4=1}} {Author {1=1}} \
+set queryButtonsBib1 { { {I 0} {I 1} {I 2} } }
+set queryInfoBib1 { { {Title {1=4 4=1}} {Author {1=1}} \
{Subject {1=21}} {Any {1=1016}} } }
set queryAuto 1
wm minsize . 0 0
set setOffset 0
set setMax 0
-set syntaxList {None sep USMARC UNIMARC UKMARC DANMARC FINMARC NORMARC PICAMARC sep SUTRS sep GRS1}
+set syntaxList {None sep USMARC UNIMARC UKMARC DANMARC FINMARC NORMARC \
+ PICAMARC sep SUTRS sep GRS1}
set font(bb,normal) {Helvetica 24}
# Override the Tk error handler function.
if {1} {
proc tkerror err {
- global font
- set w .tkerrorw
-
- if {[winfo exists $w]} {
- destroy $w
- }
- toplevel $w
- wm title $w "Error"
-
- place-force $w .
- top-down-window $w
-
- label $w.top.b -bitmap error
- message $w.top.t -aspect 300 -text "Error: $err" -font $font(b,bold)
- pack $w.top.b $w.top.t -side left -padx 10 -pady 10
-
- bottom-buttons $w [list {Close} [list destroy $w]] 1
+ global font
+ set w .tkerrorw
+
+ if {[winfo exists $w]} {
+ destroy $w
+ }
+ toplevel $w
+ wm title $w "Error"
+
+ place-force $w .
+ top-down-window $w
+
+ label $w.top.b -bitmap error
+ message $w.top.t -aspect 300 -text "Error: $err" -font $font(b,bold)
+ pack $w.top.b $w.top.t -side left -padx 10 -pady 10
+
+ bottom-buttons $w [list {Close} [list destroy $w]] 1
}
}
# Read tag set file (if present)
if {[file readable [file join $libdir tagsets.tcl]]} {
- source [file join $libdir tagsets.tcl]
+ source [file join $libdir tagsets.tcl]
}
# Read the global target configuration file.
if {[file readable [file join $libdir irtdb.tcl]]} {
-# source "${libdir}/irtdb.tcl"
source [file join $libdir irtdb.tcl]
}
# Read the local target configuration file.
}
# Read the user configuration file.
-if {[file readable [file join $libdir .clientrc.tcl]]} {
-# source "${libdir}/.clientrc.tcl"
- source [file join $libdir .clientrc.tcl]
+if {[file readable "~/.clientrc.tcl"]} {
+ source "~/.clientrc.tcl"
}
-source "bib-1.tcl"
-
set queryAutoOld $queryAuto
+set attribute$attributeTypeSelected 1
# Convert old format to new format...
foreach target [array names profile] {
set timedef [clock seconds]
if {[string first , $target] == -1} {
- if {![info exists profile($target,port)]} {
- foreach n [array names profile Default,*] {
- set profile($target,[string range $n 8 end]) $profile($n)
- }
- set profile($target,description) [lindex $profile($target) 0]
- set profile($target,host) [lindex $profile($target) 1]
- set profile($target,port) [lindex $profile($target) 2]
- set profile($target,authentication) [lindex $profile($target) 3]
- set profile($target,maximumRecordSize) \
- [lindex $profile($target) 4]
- set profile($target,preferredMessageSize) \
- [lindex $profile($target) 5]
- set profile($target,comstack) [lindex $profile($target) 6]
- set profile($target,databases) [lindex $profile($target) 7]
- set profile($target,timeDefine) $timedef
- set profile($target,windowNumber) 1
- }
- unset profile($target)
+ if {![info exists profile($target,port)]} {
+ foreach n [array names profile Default,*] {
+ set profile($target,[string range $n 8 end]) $profile($n)
+ }
+ set profile($target,description) [lindex $profile($target) 0]
+ set profile($target,host) [lindex $profile($target) 1]
+ set profile($target,port) [lindex $profile($target) 2]
+ set profile($target,authentication) [lindex $profile($target) 3]
+ set profile($target,maximumRecordSize) \
+ [lindex $profile($target) 4]
+ set profile($target,preferredMessageSize) \
+ [lindex $profile($target) 5]
+ set profile($target,comstack) [lindex $profile($target) 6]
+ set profile($target,databases) [lindex $profile($target) 7]
+ set profile($target,timeDefine) $timedef
+ set profile($target,windowNumber) 1
+ }
+ unset profile($target)
}
}
# These globals describe the current query type. They are set to the
# first query type.
-set queryButtonsFind [lindex $queryButtons 0]
-set queryInfoFind [lindex $queryInfo 0]
+if {[info exists queryButtons$attributeTypeSelected]} {
+ update
+ set queryButtonsFind [lindex [set "queryButtons$attributeTypeSelected"] 0]
+} else {
+ set queryButtonsFind [lindex [set queryButtonsBib1] 0]
+ set queryButtons$attributeTypeSelected $queryButtonsBib1
+}
+if {[info exists queryInfo$attributeTypeSelected]} {
+ set queryInfoFind [lindex [set "queryInfo$attributeTypeSelected"] 0]
+} else {
+ set queryInfoFind [lindex [set queryInfoBib1] 0]
+ set queryInfo$attributeTypeSelected $queryInfoBib1
+}
# Procedure read-formats
# Read all Tcl source files in the subdirectory 'formats'.
# The name of each source will correspond to a display format.
proc read-formats {} {
- global displayFormats
- global libdir
+ global displayFormats libdir
set oldDir [pwd]
cd [file join $libdir formats]
set formats [glob {*.[tT][cC][lL]}]
foreach f $formats {
- if {[file readable $f]} {
+ if {[file readable $f]} {
source $f
set l [string length $f]
set f [string tolower [string range $f 0 [expr $l - 5]]]
# puts utility for debugging.
proc dputs {m} {
global debugMode
- if {$debugMode} {
+ if {$debugMode == 1} {
puts $m
}
}
top-down-window $w
text $w.top.t -font fixed -width 60 -height 12 -wrap word \
- -relief flat -borderwidth 0 \
- -yscrollcommand [list $w.top.s set] -background grey85
+ -relief flat -borderwidth 0 \
+ -yscrollcommand [list $w.top.s set] -background grey85
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
proc toplevelG {w} {
global windowGeometry
- toplevel $w
+ if {![winfo exists $w]} {
+ toplevel $w
+ }
if {[info exists windowGeometry($w)]} {
set g $windowGeometry($w)
if {$g != ""} {
wm geometry $w $g
}
- }
+ }
bind $w <Destroy> [list destroyGW $w]
}
frame $w.bot.$i -relief sunken -border 1
pack $w.bot.$i -side left -expand yes -padx 2 -pady 2
button $w.bot.$i.ok -text [lindex $buttonList $i] \
- -command [lindex $buttonList [expr $i + 1]]
+ -command [lindex $buttonList [expr $i + 1]]
pack $w.bot.$i.ok -expand yes -padx 2 -pady 2 -side left
incr i 2
return
}
if {![string length $base]} {
- .bot.a.target configure -text "$target"
+ .bot.a.target configure -text "$target"
} else {
.bot.a.target configure -text "$target - $base"
}
# Inserts text at the insertion point in widget w. The text is tagged
# with the tags in args.
proc insertWithTags {w text args} {
+ global leadText
+ set text [string trimright $text ,]
set start [$w index insert]
- $w insert insert $text
+ if {[lsearch {marc-text marc-it marc-id} $args] == -1||$leadText} {
+ $w insert insert "$text"
+ } else {
+ $w insert insert ", $text"
+ }
foreach tag [$w tag names $start] {
$w tag remove $tag $start insert
}
foreach i $args {
$w tag add $i $start insert
}
+ set leadText 0
+ if {[lsearch -exact {marc-head marc-pref marc-tag marc-small-head} $args] != -1} {
+ set leadText 1
+ }
}
# Procedure popup-license and displays LICENSE information.
top-down-window $w
frame $w.top.a -relief ridge -border 2
- frame $w.top.p -relief ridge -border 2
+ frame $w.top.p -relief ridge -border 2 -background white
pack $w.top.a $w.top.p -side top -fill x
label $w.top.a.about -text "About"
pack $w.top.a.about $w.top.a.irtcl -side top
set i [z39 targetImplementationName]
- label $w.top.p.in -text "Implementation name: $i"
+ label $w.top.p.in -text "Implementation name: $i" -background white
set i [z39 targetImplementationId]
- label $w.top.p.ii -text "Implementation id: $i"
+ label $w.top.p.ii -text "Implementation id: $i" -background white
set i [z39 targetImplementationVersion]
- label $w.top.p.iv -text "Implementation version: $i"
+ label $w.top.p.iv -text "Implementation version: $i" -background white
set i [z39 options]
- label $w.top.p.op -text "Protocol options: $i"
+ label $w.top.p.op -text "Protocol options: $i" -background white
pack $w.top.p.in $w.top.p.ii $w.top.p.iv $w.top.p.op -side top -anchor nw
bottom-buttons $w [list {Close} [list destroy $w]] 1
text $w.top.record -width 60 -height 5 -wrap word -relief flat \
-borderwidth 0 -font fixed \
- -yscrollcommand [list $w.top.s set] -background grey85
+ -yscrollcommand [list $w.top.s set] -background white
scrollbar $w.top.s -command [list $w.top.record yview]
$w.top.record tag configure marc-tag -foreground blue
$w.top.record tag configure marc-id -foreground red
$w.top.record tag configure marc-data -foreground black
$w.top.record tag configure marc-head -font $font(n,bold) \
- -background black -foreground white
+ -background black -foreground white
$w.top.record tag configure marc-pref -font $font(n,normal) -foreground blue
$w.top.record tag configure marc-text -font $font(n,normal) -foreground black
$w.top.record tag configure marc-it -font $font(n,normal) -foreground black
pack $w.top.s -side right -fill y
pack $w.top.record -expand yes -fill both
- bottom-buttons $w [list \
- {Close} [list destroy $w] \
- {Prev} {} \
- {Next} {} \
- {Duplicate} {}] 0
+ bottom-buttons $w [list {Close} [list destroy $w] \
+ {Prev} {} {Next} {} {Duplicate} {}] 0
menubutton $w.bot.formats -text "Format" -menu $w.bot.formats.m -relief raised
irmenu $w.bot.formats.m
pack $w.bot.formats -expand yes -ipadx 2 -ipady 2 -padx 3 -pady 3 -side left
set i 0
foreach f $displayFormats {
$w.bot.formats.m add radiobutton -label $f -variable popupMarcdf -value $i \
- -command [list popup-marc $sno $no $b 0]
+ -command [list popup-marc $sno $no $b 0]
incr i
}
$w.top.record delete 0.0 end
set recordType [z39.$sno recordType $no]
wm title $w "$recordType record #$no"
+ focus $w
$w.bot.2 configure -command [list popup-marc $sno [expr $no-1] $b $df]
$w.bot.4 configure -command [list popup-marc $sno [expr $no+1] $b $df]
set i 0
foreach e $hotTargets {
if {$target == [lindex $e 0]} {
- set hotTargets [lreplace $hotTargets $i $i]
+ set hotTargets [lreplace $hotTargets $i $i]
}
incr i
}
}
}
foreach n [array names profile Default,*] {
- set profile($target,[string range $n 8 end]) $profile($n)
-
+ set profile($target,[string range $n 8 end]) $profile($n)
}
incr profile(Default,windowNumber)
+# debug-window "Target er her $target"
protocol-setup $target
destroy .target-define
}
}
close-target
# tkerror "$m ($c)"
- bgerror "$m ($c)"
+ bgerror "$m ($c)"
}
# Procedure connect-response {target base}
z39 disconnect
show-target {} {}
show-status {Not connected} 0 0
- .top.options.m.query.slist entryconfigure 2 -state disabled
+# .top.options.m.query.slist entryconfigure 2 -state disabled
+ configure-enable-e .top.options.m.query.slist 2
init-title-lines
show-message {}
configure-disable-e .top.target.m 1
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} \
- {{Filename:}} \
- {load-set-action} {destroy .load-set}
+# frame $w.top.filename
+ frame $w.top.left
+ frame $w.top.right
+# pack $w.top.filename -side top -anchor e -pady 2
+ pack $w.top.left $w.top.right -side left -anchor e -pady 2
+
+ entry-fields $w.top {left} {{Filename:}} {load-set-action} {destroy .load-set}
+ button $w.top.right.but -text "Browse ..." \
+ -command "fileDialog $w $w.top.left.entry open"
+ pack $w.top.right.but -side right
top-down-ok-cancel $w {load-set-action} 1
- focus $oldFocus
+# focus $oldFocus
+ focus $w
+}
+
+proc fileDialog {w ent operation} {
+ # Type names Extension(s) Mac File Type(s)
+ #
+ #---------------------------------------------------------
+ set types {
+ {"Text files" {.txt} }
+ {"Text files" {} TEXT}
+ {"Tcl Scripts" {.tcl} TEXT}
+ {"All files" *}
+ }
+ if {$operation == "open"} {
+ set file [tk_getOpenFile -filetypes $types -parent $w]
+ } else {
+ set file [tk_getSaveFile -filetypes $types -parent $w \
+ -initialfile Untitled -defaultextension .txt]
+ }
+ if [string compare $file ""] {
+ $ent delete 0 end
+ $ent insert 0 $file
+ $ent xview end
+ }
}
+
# Procedure init-request
# Sends an initialize request to the target. This procedure is called
# when a connect has been established.
# tkerror "Connection rejected by target: $u"
bgerror "Connection rejected by target: $u"
} else {
- z39 failback [list explain-crash $target $base]
+ z39 failback [list explain-crash $target $base]
explain-check $target [list ready-response $base] $base
}
}
open-target $target $base
}
-# Procedure explain-check
-# Stub function to check explain. May be overwritten later.
-#proc explain-check {target response}
-# eval $response [list $target]
-
-
# Procedure ready-response
# Called after a target has been initialized and, possibly, explained
proc ready-response {base target} {
z39 failback [list fail-response $target]
if {[string length $base]} {
- set profile($target,timeLastInit) [clock seconds]
- set settingsChanged 1
+ set profile($target,timeLastInit) [clock seconds]
+ set settingsChanged 1
- z39 databaseNames $base
- cascade-dblist $target $base
- show-target $target $base
+ z39 databaseNames $base
+ cascade-dblist $target $base
+ show-target $target $base
}
if {[lsearch [z39 options] scan] >= 0} {
set scanEnable 1
}
set data [string trim $profile($target,welcomeMessage)]
if {[string length $data]} {
- .data.record insert end "Welcome Message:\n$data\n\n"
+ .data.record insert end "Welcome Message:\n$data\n\n"
}
set data [string trim $profile($target,recentNews)]
if {[string length $data]} {
#proc ready-response-actions {target base}
#This procedure take care of all the actions that should start if connect is succesfull.
proc ready-response-actions {target base} {
- global profile queryAuto
-# changeQueryButtons $target $base
- configureOptionsSyntax $target $base
- if {[info exists profile($target,AttributeDetails,$base,Bib1Use)] && $queryAuto == 1} {
- changeQueryButtons $target $base
- change-queryInfo $target $base
- query-select 2
- .top.options.m.query.slist entryconfigure 2 -state normal
-# listbuttonx
- } else {
- query-select 0
- .top.options.m.query.slist entryconfigure 2 -state disabled
- }
+ global profile queryAuto attributeTypeSelected queryTypes
+ set autoNr [lsearch $queryTypes Auto]
+ configureOptionsSyntax $target $base
+# if {[info exists profile($target,AttributeDetails,$base,\
+# $attributeTypeSelected)] && $queryAuto == 1}
+ if {[info exists profile($target,AttributeDetails,$base,$attributeTypeSelected)]} {
+ changeQueryButtons $target $base
+ change-queryInfo $target $base
+ .top.options.m.query.slist entryconfigure $autoNr -state normal
+ .top.options.m.query.clist entryconfigure $autoNr -state normal
+ if {$queryAuto == 1} {
+ query-select $autoNr
+ } else {
+ query-select 0
+ }
+ } else {
+ query-select 0
+# .top.options.m.query.slist entryconfigure $autoNr -state disabled
+ configure-disable-e .top.options.m.query.slist $autoNr
+# if {![info exists profile($target,AttributeDetails,$base,$attributeTypeSelected)]}
+# .top.options.m.query.clist entryconfigure $autoNr -state disabled
+ configure-disable-e .top.options.m.query.clist $autoNr
+#
+ }
+ if {[info exists attributeTypeSelected]} {
+ global attribute[set attributeTypeSelected]
+ set attribute$attributeTypeSelected 1
+ } else {
+ global attributeBib1
+ set attributeBib1 1
+ }
}
# Procedure search-request
# sets many search-related Z39-settings. The global $setNo is set
# to the result set number (z39.$setNo).
proc search-request {bflag} {
- global setNo setNoLast profile hostid busy cancelFlag delayRequest recordSyntax elementSetNames
+ global setNo setNoLast profile hostid busy cancelFlag delayRequest \
+ recordSyntax elementSetNames
set target $hostid
set delayRequest {}
set query [index-query]
+ debug-window "Query er her: \"${query}\""
if {![string length $query]} {
return
}
set setNo $setNoLast
ir-set z39.$setNo z39
- if {$profile($target,namedResultSets)} {
+ if {$profile($target,namedResultSets) == 1} {
z39.$setNo setName $setNo
dputs "setName=${setNo}"
} else {
z39.$setNo setName default
dputs "setName=default"
}
- if {$profile($target,queryRPN)} {
- z39.$setNo queryType rpn
- } elseif {$profile($target,queryCCL)} {
- z39.$setNo queryType ccl
+ if {$profile($target,queryRPN) == 1} {
+ z39.$setNo queryType rpn
+ } elseif {$profile($target,queryCCL) == 1} {
+ z39.$setNo queryType ccl
}
dputs Setting
dputs $recordSyntax
z39.$setNo mediumSetElementSetNames $elementSetNames
}
z39 callback {search-response}
- z39.$setNo search $query
+ z39.${setNo} search $query
show-status Searching 1 0
}
set w .scan-window
global profile hostid scanView scanTerm curIndexEntry queryButtonsFind \
- queryInfoFind cancelFlag delayRequest
+ queryInfoFind cancelFlag delayRequest
dputs "scan-request"
if {$cancelFlag} {
entry $w.top.entry -relief sunken
pack $w.top.entry -fill x -padx 4 -pady 2
bind $w.top.entry <KeyRelease> [list scan-term-h $attr]
- listbox $w.top.list -yscrollcommand [list $w.top.scroll set] -font fixed
+ listbox $w.top.list -yscrollcommand [list $w.top.scroll set] \
+ -font fixed -background white
scrollbar $w.top.scroll -orient vertical -border 1
pack $w.top.list -side left -fill both -expand yes
pack $w.top.scroll -side right -fill y
$w.top.scroll config -command [list $w.top.list yview]
bottom-buttons $w [list {Close} [list destroy $w] \
- {Up} [list scan-up $attr] \
- {Down} [list scan-down $attr]] 0
+ {Up} [list scan-up $attr] {Down} [list scan-down $attr]] 0
bind $w.top.list <Up> [list scan-up $attr]
bind $w.top.list <Down> [list scan-down $attr]
focus $w.top.entry
if {$setNo == 0} {
dputs "setNo=$setNo"
- return
+ return
}
set setOffset [z39.$setNo nextResultSetPosition]
dputs "setOffest=${setOffset}"
frame $w.top.target
pack $w.top.target -side top -anchor e -pady 2
entry-fields $w.top {target} {{Target:}} \
- {define-target-action} {destroy .target-define}
+ {define-target-action} {destroy .target-define}
top-down-ok-cancel $w {define-target-action} 1
}
top-down-window $w
frame $w.top.database
pack $w.top.database -side top -anchor e -pady 2
- entry-fields $w.top {database} {{Database to add:}} \
- [list add-database-action $target $wp] {destroy .database-select}
+ entry-fields $w.top {database} {{Database to add:}} \
+ [list add-database-action $target $wp] {destroy .database-select}
top-down-ok-cancel $w [list add-database-action $target $wp] 1
focus $oldFocus
toplevelG $w
wm title $w "Advanced setup $target"
top-down-window $w
- if {![string length $target]} {
+ if {![string length $target]} {
set target Default
}
dputs target
frame $w.top.preferredMessageSize
pack $w.top.largeSetLowerBound $w.top.smallSetUpperBound \
- $w.top.mediumSetPresentNumber $w.top.presentChunk \
- $w.top.maximumRecordSize $w.top.preferredMessageSize \
- -side top -anchor e -pady 2
+ $w.top.mediumSetPresentNumber $w.top.presentChunk \
+ $w.top.maximumRecordSize $w.top.preferredMessageSize \
+ -side top -anchor e -pady 2
entry-fields $w.top {largeSetLowerBound smallSetUpperBound \
- mediumSetPresentNumber presentChunk maximumRecordSize \
- preferredMessageSize} \
- {{Large Set Lower Bound:} {Small Set Upper Bound:} \
- {Medium Set Present Number:} {Present Chunk:} \
- {Maximum Record Size:} {Preferred Message Size:}} \
- [list advanced-setup-action $target $b] [list destroy $w]
+ mediumSetPresentNumber presentChunk maximumRecordSize \
+ preferredMessageSize} \
+ {{Large Set Lower Bound:} {Small Set Upper Bound:} \
+ {Medium Set Present Number:} {Present Chunk:} \
+ {Maximum Record Size:} {Preferred Message Size:}} \
+ [list advanced-setup-action $target $b] [list destroy $w]
$w.top.largeSetLowerBound.entry configure -textvariable \
- profileS($target,largeSetLowerBound)
+ profileS($target,largeSetLowerBound)
$w.top.smallSetUpperBound.entry configure -textvariable \
- profileS($target,smallSetUpperBound)
+ profileS($target,smallSetUpperBound)
$w.top.mediumSetPresentNumber.entry configure -textvariable \
- profileS($target,mediumSetPresentNumber)
+ profileS($target,mediumSetPresentNumber)
$w.top.presentChunk.entry configure -textvariable \
- profileS($target,presentChunk)
+ profileS($target,presentChunk)
$w.top.maximumRecordSize.entry configure -textvariable \
- profileS($target,maximumRecordSize)
+ profileS($target,maximumRecordSize)
$w.top.preferredMessageSize.entry configure -textvariable \
- profileS($target,preferredMessageSize)
+ profileS($target,preferredMessageSize)
bottom-buttons $w [list {Ok} [list advanced-setup-action $target $b] \
{Cancel} [list destroy $w]] 0
label $w.top.databases.label -text "List"
listbox $w.top.databases.list -width 20 -height 6 \
- -yscrollcommand "$w.top.databases.scroll set"
+ -yscrollcommand "$w.top.databases.scroll set"
scrollbar $w.top.databases.scroll -orient vertical -border 1
pack $w.top.databases.label -side top -fill x -padx 2 -pady 2
pack $w.top.databases.list -side left -fill both -expand yes -padx 2 -pady 2
global profile
set w .top.service.m.dblist
- $w delete 0 200
+# $w delete 0 200
+ $w delete 0 end
if {[info exists profile($target,databases)]} {
- foreach db $profile($target,databases) {
- $w add command -label $db \
- -command [list cascade-dblist-select $target $db]
- }
+ foreach db $profile($target,databases) {
+ $w add command -label $db \
+ -command [list cascade-dblist-select $target $db]
+ }
}
}
}
.top.target.m.clist delete 0 last
foreach nn [lsort [array names profile *,host]] {
- if {[string length $profile($nn)]} {
- set ll [expr {[string length $nn] - 6}]
- set n [string range $nn 0 $ll]
-
- set nl $profile($n,windowNumber)
- if {[info exists profile($n,databases)]} {
- set ndb [llength $profile($n,databases)]
- } else {
- set ndb 0
- }
- if {$ndb > 1} {
- .top.target.m.clist add cascade -label $n \
- -menu .top.target.m.clist.$nl
- irmenu .top.target.m.clist.$nl
- foreach b $profile($n,databases) {
- .top.target.m.clist.$nl add command -label $b \
- -command [list reopen-target $n $b]
- }
- } elseif {$ndb == 1} {
- .top.target.m.clist add command -label $n -command \
- [list reopen-target $n [lindex $profile($n,databases) 0]]
- } else {
- .top.target.m.clist add command -label $n -command \
- [list reopen-target $n {}]
- }
- }
+ if {[string length $profile($nn)]} {
+ set ll [expr {[string length $nn] - 6}]
+ set n [string range $nn 0 $ll]
+
+ set nl $profile($n,windowNumber)
+ if {[info exists profile($n,databases)]} {
+ set ndb [llength $profile($n,databases)]
+ } else {
+ set ndb 0
+ }
+ if {$ndb > 1} {
+ .top.target.m.clist add cascade -label $n \
+ -menu .top.target.m.clist.$nl
+ irmenu .top.target.m.clist.$nl
+ foreach b $profile($n,databases) {
+ .top.target.m.clist.$nl add command -label $b \
+ -command [list reopen-target $n $b]
+ }
+ } elseif {$ndb == 1} {
+ .top.target.m.clist add command -label $n -command \
+ [list reopen-target $n [lindex $profile($n,databases) 0]]
+ } else {
+ .top.target.m.clist add command -label $n -command \
+ [list reopen-target $n {}]
+ }
+ }
}
.top.target.m.slist delete 0 last
foreach nn [lsort [array names profile *,host]] {
- set ll [expr {[string length $nn] - 6}]
- set n [string range $nn 0 $ll]
- .top.target.m.slist add command -label $n -command [list protocol-setup $n]
+ set ll [expr {[string length $nn] - 6}]
+ set n [string range $nn 0 $ll]
+ .top.target.m.slist add command -label $n -command [list protocol-setup $n]
}
}
# i Query type number (integer)
# This procedure is called when the user selects a Query type. The current
# query type information given by the globals $queryButtonsFind and
-# $queryInfoFind are affected by this operation.
+# $queryInfoFind are changed by this operation.
proc query-select {i} {
- global queryButtonsFind queryInfoFind queryButtons queryInfo queryAuto queryAutoOld hostid currentDb profile
-
- if {$queryAutoOld == 1 && $queryAuto == 0} {
- set queryAutoOld $queryAuto
- return
+ global queryButtonsFind queryInfoFind queryTypes queryAuto queryAutoOld \
+ hostid currentDb profile attributeTypeSelected
+ global queryButtons$attributeTypeSelected queryInfo$attributeTypeSelected
+ foreach n $queryTypes {
+ global query$n
+ set query$n 0
}
- if {$queryAutoOld == 0 && $queryAuto == 1 && [info exists profile($hostid,AttributeDetails,$currentDb,Bib1Use)] == 0} {
- set queryAutoOld $queryAuto
- return
+ set query[lindex $queryTypes $i] 1
+ if {$queryAutoOld && !$queryAuto} {
+ set queryAutoOld $queryAuto
}
- set queryInfoFind [lindex $queryInfo $i]
- set queryButtonsFind [lindex $queryButtons $i]
+ if {!$queryAutoOld && $queryAuto && ![info exists profile($hostid,AttributeDetails,$currentDb,[lindex $queryTypes $i])]} {
+ set queryAutoOld $queryAuto
+ }
+ set queryInfoFind [lindex [set queryInfo$attributeTypeSelected] $i]
+ set queryButtonsFind [lindex [set queryButtons$attributeTypeSelected] $i]
index-lines .lines 1 $queryButtonsFind $queryInfoFind activate-index
}
# Commits a new query type definition by extending the globals
# $queryTypes, $queryButtons and $queryInfo.
proc query-new-action {} {
- global queryTypes queryButtons queryInfo settingsChanged
-
+ global queryTypes settingsChanged attributeTypeSelected
+ global queryButtons$attributeTypeSelected queryInfo$attributeTypeSelected
set settingsChanged 1
lappend queryTypes [.query-new.top.index.entry get]
- lappend queryButtons {}
- lappend queryInfo {}
+ lappend queryButtons$attributeTypeSelected {}
+ lappend queryInfo$attributeTypeSelected {}
destroy .query-new
cascade-query-list
# queryNo query type number (integer)
# Procedure that deletes the query type specified by $queryNo.
proc query-delete-action {queryNo} {
- global queryTypes queryButtons queryInfo settingsChanged
+ global queryTypes settingsChanged attributeTypeSelected
+ global queryInfo$attributeTypeSelected queryButtons$attributeTypeSelected
set settingsChanged 1
set queryTypes [lreplace $queryTypes $queryNo $queryNo]
- set queryButtons [lreplace $queryButtons $queryNo $queryNo]
- set queryInfo [lreplace $queryInfo $queryNo $queryNo]
+ set queryButtons$attributeTypeSelected [lreplace [set queryButtons$attributeTypeSelected] \
+ $queryNo $queryNo]
+ set queryInfo$attributeTypeSelected [lreplace [set queryInfo$attributeTypeSelected] \
+ $queryNo $queryNo]
destroy .query-delete
cascade-query-list
}
label $w.top.warning -bitmap warning
message $w.top.quest -text "Are you sure you want to delete the \
- query type $n ?" -aspect 300
+ query type $n ?" -aspect 300
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
+ {Cancel} [list destroy $w]] 1
}
# Procedure cascade-query-list
# Updates the entries below Options|Query to list all query types.
proc cascade-query-list {} {
- global queryTypes hostid queryAuto
+ global queryTypes hostid attributeTypes queryAuto
set w .top.options.m.query
set i 0
$w.clist delete 0 last
foreach n $queryTypes {
- if {$n == "Auto"} {
- $w.clist add check -label $n -variable queryAuto -command [list query-select $i]
- } else {
- $w.clist add command -label $n -command [list query-select $i]
- }
+ $w.clist add check -label $n -variable query$n -command [list query-select $i]
+ global query$n
incr i
}
set i 0
$w.slist delete 0 last
foreach n $queryTypes {
- if {$n == "Auto"} {
- if {$hostid == "Default"} {
- $w.slist add command -label $n -state disabled -command [list query-setup $i]
- } else {
- $w.slist add command -label $n -command [list query-setup $i]
- }
+ if {$n == "Auto"} {
+ if {$hostid == "Default"} {
+ $w.slist add command -label $n -state disabled \
+ -command [list query-setup $i]
+ } else {
+ $w.slist add command -label $n -command [list query-setup $i]
+ }
} else {
- $w.slist add command -label $n -command [list query-setup $i]
+ $w.slist add command -label $n -command [list query-setup $i]
}
incr i
}
set i 0
+ $w.tlist delete 0 last
+ foreach n $attributeTypes {
+ global attribute$n
+ $w.tlist add check -label $n -variable attribute$n \
+ -command [list attribute-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]
+ if {$n == "Auto"} {
+ $w.dlist add command -label $n -state disabled \
+ -command [list query-setup $i]
+ } else {
+ $w.dlist add command -label $n -command [list query-delete $i]
+ }
incr i
}
}
# saved.
proc save-geometry {} {
global windowGeometry hotTargets textWrap displayFormat popupMarcdf \
- recordSyntax elementSetNames hostid
+ recordSyntax elementSetNames hostid
set windowGeometry(.) [wm geometry .]
# is normally kept in the directory /usr/local/lib/irtcl.
# All query types and target defintion profiles are saved.
proc save-settings {} {
- global profile libdir settingsChanged queryTypes queryButtons queryInfo queryAuto
-
+ global profile libdir settingsChanged queryTypes queryAuto \
+ attributeTypes attributeTypeSelected
if {[file writable [file join $libdir irtdb.tcl]]} {
set f [open [file join $libdir irtdb.tcl] w]
} else {
foreach n [lsort [array names profile]] {
puts $f "set [list profile($n)] [list $profile($n)]"
}
+ puts $f "set attributeTypes [list $attributeTypes]"
+ puts $f "set attributeTypeSelected [list $attributeTypeSelected]"
puts $f "set queryTypes [list $queryTypes]"
- puts $f "set queryButtons [list $queryButtons]"
- puts $f "set queryInfo [list $queryInfo]"
+ foreach attrtype $attributeTypes {
+ global queryButtons$attrtype queryInfo$attrtype
+ catch {puts $f "set queryButtons$attrtype [list [set queryButtons$attrtype]]"}
+ catch {puts $f "set queryInfo$attrtype [list [set queryInfo$attrtype]]"}
+ }
puts $f "set queryAuto [list $queryAuto]"
close $f
set settingsChanged 0
proc listbuttonaction {w name h user i} {
$w configure -text [lindex $name 0]
$h [lindex $name 1] $user $i
+ if {[regexp {.lines.[ ]*([0-9]+).*} $w match j]} {
+ global attributeTypeSelected queryTypes hostid currentDb profile
+ global queryButtons$attributeTypeSelected
+ set n -1
+ foreach type $queryTypes {
+ global query$type
+ if {[set query$type] == 1} {
+ set n [lsearch $queryTypes $type]
+ }
+ }
+ if {$n == -1} {
+ return
+ }
+ set list [lindex [set queryButtons$attributeTypeSelected] $n]
+ set length [llength $list]
+ if {$j < $length} {
+# set new [lreplace [lindex [set queryButtons$attributeTypeSelected] $n] $j $j [list I $i]]
+ set new [lreplace $list $j $j [list I $i]]
+ } else {
+ set new [lappend $list [list I $i]]
+ }
+ set queryButtons$attributeTypeSelected \
+ [lreplace [set queryButtons$attributeTypeSelected] $n $n $new]
+ set profile($hostid,queryButtons,$currentDb) $new
+
+ }
+# debug-window "[lindex $name 0], [lindex $name 1], i er her $i, winduesnavnet er $w, n er $n"
+# debug-window "new er $new"
}
# Procedure listbuttonx {button no names handle user}
# user user argument to the $handle function
# Makes an extended listbutton.
proc listbuttonx {button no names handle user} {
- set width 10
- foreach name $names {
- set buttonName [lindex $name 0]
- if {[string length $buttonName] > $width} {
- set width [string length $buttonName]
- }
- }
+ set width 10
+ foreach name $names {
+ set buttonName [lindex $name 0]
+ if {[string length $buttonName] > $width} {
+ set width [string length $buttonName]
+ }
+ }
if {[winfo exists $button]} {
$button configure -width $width -text [lindex [lindex $names $no] 0]
${button}.m delete 0 last
} else {
menubutton $button -text [lindex [lindex $names $no] 0] \
- -width $width -menu ${button}.m -relief raised -border 1
+ -width $width -menu ${button}.m -relief raised -border 1
irmenu ${button}.m
${button}.m configure -tearoff off
}
set i 0
foreach name $names {
${button}.m add command -label [lindex $name 0] \
- -command [list listbuttonaction ${button} $name $handle $user $i]
+ -command [list listbuttonaction ${button} $name $handle $user $i]
incr i
}
}
# and menu widgets.
proc listbutton {button no names} {
menubutton $button -text [lindex $names $no] -width 10 -menu ${button}.m \
- -relief raised -border 1
+ -relief raised -border 1
irmenu ${button}.m
${button}.m configure -tearoff off
foreach name $names {
# queryNo query type number (integer)
# Handler that adds new query line.
proc query-add-line {queryNo} {
- set w .query-setup
-
global queryInfoTmp queryButtonsTmp
+
+ set w .query-setup
lappend queryButtonsTmp {I 0}
+
+ set height [expr [winfo height $w] + 100]
+# set windowGeometry($w) ${height}x[winfo width $w]+0+0
+ $w configure -height $height -width [winfo width $w]
index-lines $w.top.lines 0 $queryButtonsTmp $queryInfoTmp activate-e-index
}
# globals $queryInfo and $queryButtons. This procedure is executed when
# the user commits the query setup changes by pressing button "Ok".
proc query-setup-action {queryNo} {
- global queryButtons queryInfo queryButtonsTmp queryInfoTmp queryButtonsFind \
- queryInfoFind settingsChanged hostid currentDb profile
+ global queryButtonsTmp queryInfoTmp queryButtonsFind \
+ queryInfoFind settingsChanged hostid currentDb profile attributeTypeSelected
+ global queryInfo$attributeTypeSelected queryButtons$attributeTypeSelected
set settingsChanged 1
- set queryInfo [lreplace $queryInfo $queryNo $queryNo $queryInfoTmp]
- set queryButtons [lreplace $queryButtons $queryNo $queryNo $queryButtonsTmp]
- if {[info exists profile($hostid,AttributeDetails,$currentDb,Bib1Use)]} {
- set profile($hostid,queryButtons,$currentDb) $queryButtonsTmp
+ set queryInfo$attributeTypeSelected [lreplace [set queryInfo$attributeTypeSelected] \
+ $queryNo $queryNo $queryInfoTmp]
+ set queryButtons$attributeTypeSelected [lreplace \
+ [set queryButtons$attributeTypeSelected] $queryNo $queryNo $queryButtonsTmp]
+ if {[info exists profile($hostid,AttributeDetails,$currentDb,Bib1)]} {
+ set profile($hostid,queryButtons,$currentDb) $queryButtonsTmp
}
set queryInfoFind $queryInfoTmp
set queryButtonsFind $queryButtonsTmp
index-lines .lines 1 $queryButtonsFind $queryInfoFind activate-index
}
+#This procedure handles selection of what attribute set the user wants to use for searching.
+#queryNo index in the attributeTypes list (also the menu item number in Query|Type).
+proc attribute-select {queryNo} {
+ global attributeTypes attributeTypeSelected
+ set attributeTypeSelected [lindex $attributeTypes $queryNo]
+ foreach type $attributeTypes {
+ global attribute[set type]
+ set attribute$type 0
+ }
+ set attribute$attributeTypeSelected 1
+}
+
#proc changeQueryButtons {target base}
-#target target name
-#base database name
+#target target name
+#base database name
#Substitutes the third element (the Auto element) in queryButtons with
#profile(target,queryButtons,base). The third element in queryInfo is also substituted with
-#profile(target,AttributeDetails,base,Bib1Use)
+#profile(target,AttributeDetails,base,attributeTypeSelected)
proc changeQueryButtons {target base} {
- source bib-1.tcl
- global profile queryButtons queryInfo
- if {[info exists profile($target,queryButtons,$base)]} {
- set queryButtons [lreplace $queryButtons 2 2 $profile($target,queryButtons,$base)]
- foreach tag $profile($target,AttributeDetails,$base,Bib1Use) {
- if {$tag < 1037} {
- lappend tempList [list $bib1($tag) 1=$tag]
- }
- }
- set queryInfo [lreplace $queryInfo 2 2 $tempList]
- }
+ global profile queryInfo attributeTypeSelected queryTypes
+ global queryButtons$attributeTypeSelected
+ set n [lsearch $queryTypes Auto]
+ if {[info exists profile($target,queryButtons,$base)]} {
+ set queryButtons$attributeTypeSelected [lreplace [set \
+ queryButtons$attributeTypeSelected] $n $n $profile($target,queryButtons,$base)]
+ change-queryInfo $target $base
+ }
}
# Procedure activate-e-index {value no i}
proc update-attr {} {
set w .index-setup
listbuttonv $w.top.relation.b relationTmpValue\
- {{None} 0 {Less than} 1 {Greater than or equal} 2 {Equal} 3 \
- {Greater than or equal} 4 {Greater than} 5 {Not equal} 6 \
- {Phonetic} 100 {Stem} 101 {Relevance} 102 {AlwaysMatches} 103}
+ {{None} 0 {Less than} 1 {Greater than or equal} 2 {Equal} 3 \
+ {Greater than or equal} 4 {Greater than} 5 {Not equal} 6 \
+ {Phonetic} 100 {Stem} 101 {Relevance} 102 {AlwaysMatches} 103}
listbuttonv $w.top.position.b positionTmpValue {{None} 0 \
- {First in field} 1 {First in subfield} 2 {Any position in field} 3}
+ {First in field} 1 {First in subfield} 2 {Any position in field} 3}
listbuttonv $w.top.structure.b structureTmpValue {{None} 0 {Phrase} 1 \
- {Word} 2 {Key} 3 {Year} 4 {Date (norm)} 5 {Word list} 6 \
- {Date (un-norm)} 100 {Name (norm)} 101 {Date (un-norm)} 102 \
- {Structure} 103 {urx} 104 {free-form} 105 {doc-text} 106 \
- {local-number} 107 {string} 108 {numeric string} 109}
+ {Word} 2 {Key} 3 {Year} 4 {Date (norm)} 5 {Word list} 6 \
+ {Date (un-norm)} 100 {Name (norm)} 101 {Date (un-norm)} 102 \
+ {Structure} 103 {urx} 104 {free-form} 105 {doc-text} 106 \
+ {local-number} 107 {string} 108 {numeric string} 109}
listbuttonv $w.top.truncation.b truncationTmpValue {{Auto} 0 {Right} 1 \
- {Left} 2 {Left and right} 3 {No truncation} 100 \
- {Process #} 101 {Re-1} 102 {Re-2} 103}
+ {Left} 2 {Left and right} 3 {No truncation} 100 \
+ {Process #} 101 {Re-1} 102 {Re-2} 103}
listbuttonv $w.top.completeness.b completenessTmpValue {{None} 0 \
- {Incomplete subfield} 1 {Complete subfield} 2 {Complete field} 3}
+ {Incomplete subfield} 1 {Complete subfield} 2 {Complete field} 3}
}
# Procedure use-attr {init}
# is 0 the current selection of the listbox is read and the global
# $useTmpValue is set to the current use-value.
proc use-attr {init} {
- set attr {
- {None} 0
- {Personal name} 1
- {Corporate name} 2
- {Conference name} 3
- {Title} 4
- {Title-series} 5
- {Title-uniform} 6
- {ISBN} 7
- {ISSN} 8
- {LC card number} 9
- {BNB card number} 10
- {BGF(sic) number} 11
- {Local number} 12
- {Dewey classification} 13
- {UDC classification} 14
- {Bliss classification} 15
- {LC call number} 16
- {NLM call number} 17
- {NAL call number} 18
- {MOS call number} 19
- {Local classification} 20
- {Subject heading} 21
- {Subject-RAMEAU} 22
- {BDI-index-subject} 23
- {INSPEC-subject} 24
- {MESH-subject} 25
- {PA-subject} 26
- {LC-subject-heading} 27
- {RVM-subject-heading} 28
- {Local subject index} 29
- {Date} 30
- {Date of publication} 31
- {Date of acquisition} 32
- {Title-key} 33
- {Title-collective} 34
- {Title-parallel} 35
- {Title-cover} 36
- {Title-added-title-page} 37
- {Title-caption} 38
- {Title-running} 39
- {Title-spine} 40
- {Title-other-variant} 41
- {Title-former} 42
- {Title-abbreviated} 43
- {Title-expanded} 44
- {Subject-PRECIS} 45
- {Subject-RSWK} 46
- {Subject-subdivision} 47
- {Number-natl-bibliography} 48
- {Number-legal-deposit} 49
- {Number-govt-publication} 50
- {Number-publisher-for-music} 51
- {Number-DB} 52
- {Number-local-call} 53
- {Code-language} 54
- {Code-geographic-area} 55
- {Code-institution} 56
- {Name and title} 57
- {Name-geographic} 58
- {Place-publication} 59
- {CODEN} 60
- {Microform-generation} 61
- {Abstract} 62
- {Note} 63
- {Author-title} 1000
- {Record type} 1001
- {Name} 1002
- {Author} 1003
- {Author-name-personal} 1004
- {Author-name-corporate} 1005
- {Author-name-conference} 1006
- {Identifier-standard} 1007
- {Subject-LC-children's} 1008
- {Subject-name-personal} 1009
- {Body of text} 1010
- {Date/time added to database} 1011
- {Date/time last modified} 1012
- {Authority/format identifier} 1013
- {Concept-text} 1014
- {Concept-reference} 1015
- {Any} 1016
- {Server choice} 1017
- {Publisher} 1018
- {Record source} 1019
- {Editor} 1020
- {Bib-level} 1021
- {Geographic class} 1022
- {Indexed by} 1023
- {Map scale} 1024
- {Music key} 1025
- {Related periodical} 1026
- {Report number} 1027
- {Stock number} 1028
- {Thematic number} 1030
- {Material type} 1031
- {Doc ID} 1032
- {Host item} 1033
- {Content type} 1034
- {Anywhere} 1035
- }
+ global useTmpValue attributeTypeSelected queryAuto profile hostid currentDb
+ set ats [string tolower $attributeTypeSelected]
+ source ${ats}.tcl
+
set w .index-setup
- global useTmpValue
- set l [llength $attr]
if {$init} {
set s 0
set lno 0
- for {set i 0} {$i < $l} {incr i} {
- $w.top.use.list insert end [lindex $attr $i]
- incr i
- if {$useTmpValue == [lindex $attr $i]} {
- set s $lno
+ if {$queryAuto} {
+ foreach i $profile($hostid,AttributeDetails,$currentDb,$attributeTypeSelected) {
+ $w.top.use.list insert end "[set ${ats}($i)]"
+ if {$useTmpValue == $i} {
+ set s $lno
+ }
+ incr lno
+ }
+ } else {
+ foreach i [lsort -integer [array names $ats]] {
+ $w.top.use.list insert end "[set ${ats}($i)]"
+ if {$useTmpValue == $i} {
+ set s $lno
+ }
+ incr lno
}
- incr lno
}
$w.top.use.list selection clear 0 end
$w.top.use.list selection set $s $s
- incr s -3
- if {$s < 0} {
- set s 0
- }
+# incr s -3
+# if {$s < 0}
+# set s 0
+#
$w.top.use.list yview $s
} else {
- set lno [lindex [$w.top.use.list curselection] 0]
- set i [expr {$lno+$lno+1}]
- set useTmpValue [lindex $attr $i]
+ set j [lindex [$w.top.use.list curselection] 0]
+ set i [lindex [lsort -integer [array names ${ats}]] $j]
+# debug-window "[$w.top.use.list curselection] [set ${ats}($i)]"
+# set useTmpValue [set ${ats}($i)]
+ set useTmpValue $i
dputs "useTmpValue=$useTmpValue"
}
}
set attr [lindex $oldAttr 0]
global useTmpValue relationTmpValue structureTmpValue truncationTmpValue \
- completenessTmpValue positionTmpValue queryInfoTmp
+ completenessTmpValue positionTmpValue queryInfoTmp
use-attr 0
set w .index-setup
global relationTmpValue structureTmpValue truncationTmpValue \
- completenessTmpValue positionTmpValue useTmpValue
+ completenessTmpValue positionTmpValue useTmpValue attributeTypeSelected
set relationTmpValue 0
set truncationTmpValue 0
set structureTmpValue 0
toplevelG $w
set n [lindex $attr 0]
- wm title $w "Index setup $n"
+ wm title $w "Index setup: $n, $attributeTypeSelected"
top-down-window $w
pack $w.top.use -side left -pady 6 -padx 6 -fill y
label $w.top.use.label -text "Use"
- listbox $w.top.use.list -width 26 -yscrollcommand "$w.top.use.scroll set"
+ listbox $w.top.use.list -width 26 -yscrollcommand "$w.top.use.scroll set"
scrollbar $w.top.use.scroll -orient vertical -border 1
pack $w.top.use.label -side top -fill x -padx 2 -pady 2
pack $w.top.use.list -side left -fill both -expand yes -padx 2 -pady 2
pack $w.top.completeness.label $w.top.completeness.b -fill x
# Ok-cancel
- bottom-buttons $w [list \
- {Ok} [list index-setup-action $attr $queryNo $indexNo] \
- {Cancel} [list destroy $w]] 0
-
+ bottom-buttons $w [list {Ok} \
+ [list index-setup-action $attr $queryNo $indexNo] {Cancel} [list destroy $w]] 0
+
+ focus $w
}
# Procedure query-edit-index {queryNo}
# Procedure query-setup {queryNo}
# queryNo query number
-# Makes a dialog in which a query type an be customized.
+# Makes a dialog in which a query type can be customized.
proc query-setup {queryNo} {
+ global queryTypes queryButtonsTmp queryInfoTmp queryIndexTmp attributeTypeSelected
+ global queryInfo$attributeTypeSelected queryButtons$attributeTypeSelected
set w .query-setup
- global queryTypes queryButtons queryInfo queryButtonsTmp queryInfoTmp queryIndexTmp
-
set queryIndexTmp 0
set queryName [lindex $queryTypes $queryNo]
- set queryInfoTmp [lindex $queryInfo $queryNo]
- set queryButtonsTmp [lindex $queryButtons $queryNo]
+ if {[info exists queryInfo$attributeTypeSelected]} {
+ set queryInfoTmp [lindex [set queryInfo$attributeTypeSelected] $queryNo]
+ } else {
+ set queryInfoTmp [lindex $queryInfoBib1 $queryNo]
+ }
+ if {[info exists queryButtons$attributeTypeSelected]} {
+ set queryButtonsTmp [lindex [set queryButtons$attributeTypeSelected] $queryNo]
+ } else {
+ set queryButtonsTmp [lindex $queryButtonsBib1 $queryNo]
+ }
toplevelG $w
wm minsize $w 0 0
- wm title $w "Query setup $queryName"
+ wm title $w "Query setup $queryName - $attributeTypeSelected"
top-down-window $w
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]
+ listbox $w.top.index.list -yscrollcommand [list $w.top.index.scroll set] \
+ -background white
scrollbar $w.top.index.scroll -orient vertical -border 1 \
-command [list $w.top.index.list yview]
bind $w.top.index.list <Double-1> [list query-edit-index $queryNo]
$w.top.index.list selection clear 0 end
$w.top.index.list selection set 0 0
foreach x $queryInfoTmp {
- $w.top.index.list insert end [lindex $x 0]
+ $w.top.index.list insert end [lindex $x 0]
}
# Bottom
Edit [list query-edit-index $queryNo] \
Delete [list query-delete-index $queryNo] \
Cancel [list destroy $w]] 0
+ focus $w
}
# Procedure index-clear
# left truncation; (?) on right-side indicates right-truncation; (?)
# on both sides indicates both-left-and-right truncation.
proc index-query {} {
- global queryButtonsFind queryInfoFind
+ global queryButtonsFind queryInfoFind attributeTypeSelected
set i 0
set qs {}
}
incr i
}
- dputs "qs= $qs"
- return $qs
+# debug-window "Querystring er her $qs"
+ if {$qs == ""} {
+ return ""
+ } else {
+ set qs "@attrset $attributeTypeSelected $qs"
+ dputs "qs= $qs"
+# debug-window "....og nu er den $qs\n"
+ return $qs
+ }
}
# Procedure index-focus-in {w i}
if {! [winfo exists $w.$i.e]} {
entry $w.$i.e -width 32 -relief sunken -border 1
bind $w.$i.e <FocusIn> [list index-focus-in $w $i]
- bind $w.$i.e <FocusOut> [list $w.$i configure -background white]
+ bind $w.$i.e <FocusOut> [list $w.$i configure -background white]
pack $w.$i.l -side left
pack $w.$i.e -side left -fill x -expand yes
pack $w.$i -side top -fill x -padx 2 -pady 2
set j $k
}
if {$i >= 0} {
- bind $w.$i.e <Tab> "focus $w.0.e"
+ bind $w.$i.e <Tab> "focus $w.0.e"
focus $w.0.e
}
}
#Procedure configureOptionsSyntax {target base}
-#target target name
-#base database name
+#target target name
+#base database name
#Changes the Options|Syntax menu acording to the information obtained via explain.
proc configureOptionsSyntax {target base} {
- global profile syntaxList recordSyntax
- set activate 0
- set i -1
- set w .top.options.m.syntax
- if {[info exists profile($target,RecordSyntaxes,$base)]} {
- foreach syntax $syntaxList {
- incr i
- if {$syntax == "sep"} {continue}
- if {[lsearch $profile($target,RecordSyntaxes,$base) $syntax] != -1} {
- configure-enable-e $w $i
- if {$activate == 0} {
- $w invoke $i
- set recordSyntax $syntax
- set activate 1
- }
- } else {
- configure-disable-e $w $i
- }
- }
- } else {
- foreach syntax $syntaxList {
- incr i
- if {$syntax == "sep"} {continue}
- configure-enable-e $w $i
- }
- $w invoke 0
- }
+ global profile syntaxList recordSyntax
+ set activate 0
+ set i -1
+ set j 0
+ set w .top.options.m.syntax
+ if {[info exists profile($target,RecordSyntaxes,$base)]} {
+ foreach syntax $syntaxList {
+ incr i
+ if {$syntax == "sep"} {continue}
+ incr j
+ if {[lsearch $profile($target,RecordSyntaxes,$base) $syntax] != -1} {
+ configure-enable-e $w $i
+ if {$activate == 0} {
+ $w invoke $j
+ set recordSyntax $syntax
+ set activate 1
+ }
+ } else {
+ configure-disable-e $w $i
+ }
+ }
+ } else {
+ foreach syntax $syntaxList {
+ incr i
+ if {$syntax == "sep"} {continue}
+ incr j
+ if {$syntax == $recordSyntax} {
+ $w invoke $j
+ }
+ configure-enable-e $w $i
+ }
+ }
}
# Init: The geometry information for the main window is set - either
# to a default value or to the value in windowGeometry(.)
if {[catch {set g $windowGeometry(.)}]} {
- wm geometry . 420x340
+ wm geometry . 500x410
} else {
wm geometry . $g
}
pack .top .lines .mid -side top -fill x
pack .data -side top -fill both -expand yes
pack .bot -fill x
+#irmenu .top.file
# Init: Definition of File menu.
-menubutton .top.file -text File -menu .top.file.m
+menubutton .top.file -text File -menu .top.file.m -underline 0
irmenu .top.file.m
.top.file.m add command -label {Save settings} -command {save-settings}
.top.file.m add separator
.top.file.m add command -label Exit -command {exit-action}
# Init: Definition of Target menu.
-menubutton .top.target -text Target -menu .top.target.m
+menubutton .top.target -text Target -menu .top.target.m -underline 0
irmenu .top.target.m
.top.target.m add cascade -label Connect -menu .top.target.m.clist
.top.target.m add command -label Disconnect -command {close-target}
cascade-target-list
# Init: Definition of Service menu.
-menubutton .top.service -text Service -menu .top.service.m
+menubutton .top.service -text Service -menu .top.service.m -underline 0
irmenu .top.service.m
.top.service.m add cascade -label Database -menu .top.service.m.dblist
.top.service.m add cascade -label Present -menu .top.service.m.present
irmenu .top.service.m.dblist
# Init: Definition of Set menu.
-menubutton .top.rset -text Set -menu .top.rset.m
+menubutton .top.rset -text Set -menu .top.rset.m -underline 1
irmenu .top.rset.m
.top.rset.m add command -label Load -command {load-set}
.top.rset.m add separator
# Init: Definition of the Options menu.
-menubutton .top.options -text Options -menu .top.options.m
+menubutton .top.options -text Options -menu .top.options.m -underline 0
irmenu .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
# Init: Definition of the Options|Query menu.
irmenu .top.options.m.query
.top.options.m.query add cascade -label Select -menu .top.options.m.query.clist
+.top.options.m.query add cascade -label Type -menu .top.options.m.query.tlist
.top.options.m.query add cascade -label Edit -menu .top.options.m.query.slist
.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
irmenu .top.options.m.query.slist
+irmenu .top.options.m.query.tlist
irmenu .top.options.m.query.clist
irmenu .top.options.m.query.dlist
cascade-query-list
# Init: Definition of the Options|Syntax menu.
proc initOptionsSyntax {} {
- global syntaxList recordSyntax
- set w .top.options.m.syntax
- irmenu $w
- foreach syntax $syntaxList {
- if {$syntax == "sep"} {
- $w add separator
- } else {
- $w add radiobutton -label $syntax -value $syntax -variable recordSyntax
- }
- }
+ global syntaxList recordSyntax
+ set w .top.options.m.syntax
+ irmenu $w
+ foreach syntax $syntaxList {
+ if {$syntax == "sep"} {
+ $w add separator
+ } else {
+ $w add radiobutton -label $syntax -value $syntax -variable recordSyntax
+ }
+ }
}
initOptionsSyntax
irmenu .top.options.m.elements
.top.options.m.elements add radiobutton -label Unspecified \
-value None -variable elementSetNames
-.top.options.m.elements add radiobutton -label Full \
- -value F -variable elementSetNames
+.top.options.m.elements add radiobutton -label Full -value F -variable elementSetNames
.top.options.m.elements add radiobutton -label Brief -value B -variable elementSetNames
# Init: Definition of Help menu.
-menubutton .top.help -text "Help" -menu .top.help.m
+menubutton .top.help -text "Help" -menu .top.help.m -underline 0
irmenu .top.help.m
#.top.help.m add command -label "Help on help" -command {tkerror "Help on help not available. Sorry"}
# Init: Pack menu bar items.
pack .top.file .top.target .top.service .top.rset .top.options -side left
pack .top.help -side right
+#.top configure -menu .top.file
-# Init: Define query area.
-index-lines .lines 1 $queryButtonsFind [lindex $queryInfo 0] activate-index
+# Init: Define query area buttons with icons.
+index-lines .lines 1 $queryButtonsFind [lindex [set \
+ queryInfo$attributeTypeSelected] 0] activate-index
image create photo scan -file [file join $libdir bitmaps a-z.gif]
image create photo clear -file [file join $libdir bitmaps trash.gif]
image create photo present -file [file join $libdir bitmaps page.gif]
image create photo search -file [file join $libdir bitmaps search.gif]
-button .mid.search -image search -command {search-request 0} -state disabled -relief flat
+image create photo stop -file [file join $libdir bitmaps stop.gif]
+button .mid.search -image search -command {search-request 0} \
+ -state disabled -relief flat
button .mid.scan -image scan -command scan-request -state disabled -relief flat
-button .mid.present -image present -command [list present-more 10] -state disabled -relief flat
+button .mid.present -image present -command [list present-more 10] \
+ -state disabled -relief flat
button .mid.clear -image clear -command index-clear -relief flat
+button .mid.stop -image stop -command cancel-operation -relief flat
pack .mid.search .mid.scan .mid.present .mid.clear -side left -fill y -pady 1
+pack .mid.stop -side left -fill y -padx 20
# Init: Define record area in main window.
text .data.record -font fixed -height 2 -width 20 -wrap none -borderwidth 0 \
- -relief flat -yscrollcommand [list .data.scroll set] -wrap $textWrap
+ -relief flat -yscrollcommand [list .data.scroll set] -wrap $textWrap
scrollbar .data.scroll -command [list .data.record yview]
.data.record configure -takefocus 0
.data.scroll configure -takefocus 0
projects / ir-tcl-moved-to-github.git / blobdiff