::namespace eval ::qw::list {} ::namespace eval ::qw::list::var {}; ::if {![::qw::command_exists ::lempty]} { #2.32.2 linux (because can't load Tclx) ::proc ::lempty {List} { ::if {[::llength $List]==0} { ::return 1; } ::return 0; } } ::proc ::qw::list::is_empty {sargs} { ::set List [::sargs::get $sargs .list]; ::if {[::lempty $List]} { ::if {![::sargs::exists $sargs .list]} { ::qw::bug 314120200423095953 "[::qw::procname] - no .list argument."; } ::return 1; } ::return 0; } ::proc ::qw::list::delete {sargs} { /* { Usage1 ::set ResultList [::qw::list::delete .list $List .element $Element]; Usage2 ::set ResultList [::qw::list::delete .list_var List .element $Element]; Returns a list with the specified element deleted. Uses exact matching. If there are duplicates, only the first element is deleted. If the element is not found, the original list is returned. */ } ::set List [::sargs::get $sargs .list]; ::set Element [::sargs::get $sargs .element]; ::if {$Element eq ""} { ::if {![::sargs::exists $sargs .element]} { ::qw::bug 314120130415121725 "[::qw::procname] - no .element argument."; } } ::if {[::llength $List]==0} { ::if {![::sargs::exists $sargs .list]} { ::qw::bug 314120140409104318 "[::qw::procname] - no .list argument."; } ::return $List; } ::set Pos [::lsearch $List $Element]; ::if {$Pos<0} { ::return $List; } ::set Result [::lreplace $List $Pos $Pos]; ::return $Result; ::return [::lreplace $List $Pos $Pos]; } ::proc ::qw::list::var::delete {sargs} { /* { Usage: ::qw::list::delete .list ListVar .element $Element; */ } ::set ListVar [::sargs::get $sargs .list]; ::upvar $ListVar x; ::set x [::qw::list::delete $sargs .list $x]; ::return $x; } ::proc ::qw::list::reverse {sargs} { /* { Usage: ::set ResultList [::qw::list::reverse .list $List]; */ } ::set List [::sargs::get $sargs .list]; ::if {[::llength $List]==0} { ::if {![::sargs::exists $sargs .list]} { ::qw::bug 314120130819172659 "[::qw::procname] - no .list argument."; } } ::if {$::tcl_version>=8.6} { ::set Result [::lreverse $List]; ::return $Result; } ::set Result [::list]; ::set i [::llength $List]; ::while {[::incr i -1]>=0} { ::lappend Result [::lindex $List $i]; } ::return $Result; } ::proc ::qw::list::var::reverse {sargs} { /* { Usage: ::qw::list::reverse .list ListVar; */ } ::if {![::sargs::exists $sargs .list]} { ::qw::bug 314120170411134748 "[::qw::procname] - no .list argument."; } ::set ListVar [::sargs::get $sargs .list]; ::upvar $ListVar x; ::set x [::qw::list::reverse $sargs .list $x]; ::return $x; } ::proc ::qw::list::duplicates_delete {sargs} { /* { Usage: ::set NewList [::qw::list::duplicates_delete .list $List]; Returns the list with duplicates deleted. The order of the remaining duplicates is maintained. When a duplicate occurs the first occurrence is kept and the rest are discarded. An exact match is used so if you want case insensitivity then toupper/tolower the list yourself before calling. */ } ::set List [::sargs::get $sargs .list]; ::if {[::llength $List]==0} { ::if {![::sargs::exists $sargs .list]} { ::qw::bug 314120130426133233 "[::qw::procname] - no .list argument."; } ::return $List; } ::set Sorted [::lsort -exact -unique $List]; ::if {[::llength $Sorted] == [::llength $List]} { ::return $List; } ::set Result ""; ::while {[::llength $List]} { ::set Element [$lindex $List 0]; ::lappend Result $Element; ::while {1} { ::set Pos [::lsearch -exact $List $Element]; ::if {$Pos<0} { ::break; } ::set List [::lreplace $List $Pos $Pos]; } } ::return $Result; } ::proc ::qw::list::promote {sargs} { /* { ::qw::list::promote enter sargs==( .list {{::string match *ee* "%_value_%"}} .element {::expr {[::qw::number::scan "%_value_%"]>10000}} ) ::qw::list::promote return List=={::expr {[::qw::number::scan "%_value_%"]>10000}} {::string match *ee* "%_value_%"} ::qw::list::promote enter sargs==( .list {{::expr {[::qw::number::scan "%_value_%"]>10000}} {::string match *ee* "%_value_%"}} .element {::expr {[::qw::number::scan "%_value_%"]>10000}} ) ::qw::list::promote return List=={::expr {[::qw::number::scan "%_value_%"]>10000}} {::expr {[::qw::number::scan "%_value_%"]>10000}} {::string match *ee* "%_value_%"} ::qw::list::promote enter sargs==( .list {{::expr {[::qw::number::scan "%_value_%"]>10000}} {::expr {[::qw::number::scan "%_value_%"]>10000}} {::string match *ee* "%_value_%"}} .element {::expr {[::qw::number::scan "%_value_%"]>10000}} ) ::qw::list::promote return List=={::expr {[::qw::number::scan "%_value_%"]>10000}} {::expr {[::qw::number::scan "%_value_%"]>10000}} {::expr {[::qw::number::scan "%_value_%"]>10000}} {::string match *ee* "%_value_%"} */} #//::puts "pgq,debug2340::qw::list::promote enter sargs==(\n[::sargs::format .structure $sargs]\n)"; /* { Usage: ::set NewList [::qw::list::promote .list $List .element $Element]; Prepends a value to the beginning of a list and returns a new list. First the list is searched for the element value (ignoring the case) and if found it is moved to the front of the list. Otherwise the element is simply prepended to the front of the list. An empty element value is ignored but it must at least be specified. */ } ::set List [::sargs::get $sargs .list]; ::if {[::llength $List]==0} { ::if {![::sargs::exists $sargs .list]} { ::qw::bug 314120120529095117 "[::qw::procname] - no .list argument."; } } ::set Element [::sargs::get $sargs .element]; ::if {$Element eq ""} { ::if {![::sargs::exists $sargs .element]} { ::qw::bug 314120120529095118 "[::qw::procname] - no .element argument."; } ::return $List; } #rwb_master - see pgq - we have unfinished business here ::set Pos [::lsearch -nocase $List $Element]; ::set Pos -1; ::set Count -1; ::foreach Guy $List { ::incr Count; ::if {$Guy eq $Element} { ::set Pos $Count; ::break; } } #//::puts "pgq,debug2340::qw::list::promote Pos==$Pos List==\"$List\" Element==\"$Element\""; ::if {$Pos>=0} { ::set List [::lreplace $List $Pos $Pos]; } ::set List [::linsert $List 0 $Element]; #//::puts "pgq,debug2340::qw::list::promote return List==\"$List\""; ::return $List; } ::proc ::qw::list::var::promote {sargs} { /* { Usage: ::qw::list::var::promote .list ListVar .element $Element; */ } ::set ListVar [::sargs::get $sargs .list]; ::upvar $ListVar x; ::set x [::qw::list::promote $sargs .list $x]; ::return $x; } ::proc ::qw::list::demote {sargs} { /* { Usage: ::set NewList [::qw::list::demote .list $List .element $Element]; Appends a value to the end of a list and returns a new list. First the list is searched for the element value (ignoring the case) and if found it is moved to the end of the list. Otherwise the element is simply appended to the end of the list. An empty element value is ignored but it must at least be specified. The promote and demote methods search the list forst and move the element if already in the list. Otherwise you are better off using ::lappend. There is not ::lprepend. */ } ::set List [::sargs::get $sargs .list]; ::if {[::llength $List]==0} { ::if {![::sargs::exists $sargs .list]} { ::qw::bug 314120120529095119 "[::qw::procname] - no list."; } } ::set Element [::sargs::get $sargs .element]; ::if {$Element eq ""} { ::if {![::sargs::exists $sargs .element]} { ::qw::bug 314120120529095120 "[::qw::procname] - no element."; } ::return $List; } ::set Pos [::lsearch -nocase $List $Element]; ::if {$Pos>=0} { ::set List [::lreplace $List $Pos $Pos]; } ::lappend List $Element; ::return $List; } ::proc ::qw::list::var::demote {sargs} { /* { Usage: ::qw::list::var::demote .list ListVar .element $Element; */ } ::set ListVar [::sargs::get $sargs .list]; ::upvar $ListVar x; ::set x [::qw::list::demote $sargs .list $x]; ::return $x; } ::proc ::qw::list::find {sargs} { /* { Finds the element and returns its position. Case is ignored. This proc replaces the most usual functionality of lsearch and the improvement is that the arguments are named and you don't have to go to the manual every time you want to search a list. */ } ::set List [::sargs::get $sargs .list]; ::set Element [::sargs::get $sargs .element]; ::if {$Element eq ""} { ::if {![::sargs::exists $sargs .element]} { ::qw::bug 314120130426133233 "[::qw::procname] - no .element argument."; } } ::if {[::llength $List]==0} { ::if {![::sargs::exists $sargs .list]} { ::qw::bug 314120130426133233 "[::qw::procname] - no .list argument."; } ::return -1; } ::return [::lsearch $List $Element]; } ::proc ::qw::list::lsearch {sargs} { /* { Usage: ::set Pos [::qw::list::lsearch .pattern "a" .list {a b c} .options [::list -exact]]; Exactly the same functionality as ::lsearch but wraps the arguments. I was getting tired of looking up the order of the arguments each time, or debugging when I didn't bother double-checking them. Note: Used "lsearch" instead of "search" to re-enforce notion of compatibility and to reserve "::qw::list::search" for future use. */ } ::set Pattern [::sargs::get $sargs .pattern]; ::if {$Pattern eq ""} { ::if {![::sargs::exists $sargs .pattern]} { ::qw::throw \ .text "[::qw::procname] - missing .pattern argument." \ .error_id 314120150402102634 \ ; } } ::set List [::sargs::get $sargs .list]; ::if {[::llength $List]==0} { ::if {![::sargs::exists $sargs .list]} { ::qw::throw \ .text "[::qw::procname] - missing .list argument." \ .error_id 314120150402102635 \ ; } } ::set Options [::sargs::get $sargs .options]; ::if {$Options eq ""} { ::set Result [::lsearch $List $Pattern]; ::return $Result; } ::set Result [::eval ::lsearch $Options [::list $List] [::list $Pattern]]; ::return $Result; } ::proc ::qw::list::var::option_add {sargs} { /* { Usage: ::qw::list::var::option_add .list ListVar .option $Option .value $Value; */ } ::set ListVar [::sargs::get $sargs .list]; ::upvar $ListVar x; ::set x [::qw::list::option_add $sargs .list $x]; ::return $x; } ::proc ::qw::list::option_add {sargs} { /* { ::qw::list::option_add .list $List .option $Option .value $Value; Assumes list is in hyphenated name/value pairs. Finds and replaces one name/value pair if it exists, or appends the new name/value pair, and returns the list. */ } ::set Option [::sargs::get $sargs .option]; ::if {$Option eq ""} { ::qw::bug 314120200324161915 "[::qw::procname] - no .option argument."; } ::if {[::string index $Option 0] ne "-"} { ::qw::bug 314120200324161916 "[::qw::procname] - invalid .option argument \"$Option\": no hyphen prefix."; } ::set List [::sargs::get $sargs .list]; ::if {[::llength $List]==0} { ::if {![::sargs::exists $sargs .list]} { ::qw::bug 314120200324161917 "[::qw::procname] - no .list argument."; } } ::set Value [::sargs::get $sargs .value]; ::if {$Value eq ""} { ::if {![::sargs::exists $sargs .list]} { ::qw::bug 314120200324161918 "[::qw::procname] - no .value argument."; } } ::set Pos [::lsearch $List $Option]; ::if {$Pos>=0} { ::set List [::lreplace $List $Pos [::expr {$Pos+1}] $Option $Value]; } else { ::lappend List $Option $Value; } ::return $List; } ::proc ::qw::list::var::option_delete {sargs} { /* { Usage: ::qw::list::var::promote .list ListVar .element $Element; */ } ::set ListVar [::sargs::get $sargs .list]; ::upvar $ListVar x; ::set x [::qw::list::option_delete $sargs .list $x]; ::return $x; } ::proc ::qw::list::option_delete {sargs} { /* { Usage: ::qw::list::option_delete .list ListVar .option $Option; Assumes list is in hyphenated name/value pairs. Finds and deletes one name/value pair if it exists and returns the list. */ } ::set List [::sargs::get $sargs .list]; ::set Option [::sargs::get $sargs .option]; ::if {$Option eq ""} { ::qw::bug 314120200324161235 "[::qw::procname] - no .option argument."; } ::if {[::string index $Option 0] ne "-"} { ::qw::bug 314120200324161236 "[::qw::procname] - invalid .option argument \"$Option\": no hyphen prefix."; } ::if {[::llength $List]==0} { ::if {![::sargs::exists $sargs .list]} { ::qw::bug 314120200324161237 "[::qw::procname] - no .list argument."; } ::return $List; } ::set Pos [::lsearch $List $Option]; ::if {$Pos>=0} { ::set List [::lreplace $List $Pos [::expr {$Pos+1}]]; } ::return $List; } ::proc ::qw::list::intersect3 {sargs} { /* { Copied from Tclx ::intersect3. returns a list with three elements. Element 0 == List of elements in list 1 but not in list 2. Element 1 == Intersection of list 1 qnd list 2. Element 2 == List of elements in list 2 but not in list 1. Copied from Tclx because we had to load the whole package just to get one or two procs. We want nv2 to load more quickly. If other scripts need TclX later they can still load it. */ } ::if {![::sargs::exists $sargs .list1]} { ::qw::bug 314120210326092521 "[::qw::procname] - no .list1 argument."; } ::if {![::sargs::exists $sargs .list2]} { ::qw::bug 314120210326092522 "[::qw::procname] - no .list2 argument."; } ::set List1 [::sargs::get $sargs .list1]; ::set List2 [::sargs::get $sargs .list2]; ::array set Array1 {}; ::array set Array2 {}; ::array set Intersection {}; ::foreach Value $List1 { ::set Array1($Value) {} } ::foreach Value $List2 { ::set Array2($Value) {} } ::foreach Item [::concat $List1 $List2] { ::if {[::info exists Array1($Item)] && [::info exists Array2($Item)]} { ::unset Array1($Item); ::unset Array2($Item); ::set Intersection($Item) {}; } } /* { Don't see any reason to sort the results but original proc did it and don't want any subtle behavior changes during debugging. */ } ::return [::list \ [::lsort [::array names Array1]] \ [::lsort [::array names Intersection]] \ [::lsort [::array names Array2]] \ ]; } ::proc ::qw::list::intersect {sargs} { /* { returns the intersection of two lists. Copied from Tclx because we had to load the whole package just to get one or two procs. We want nv2 to load more quickly. If other scripts need TclX later they can still load it. */ } ::if {![::sargs::exists $sargs .list1]} { ::qw::bug 314120210326092523 "[::qw::procname] - no .list1 argument."; } ::if {![::sargs::exists $sargs .list2]} { ::qw::bug 314120210326092524 "[::qw::procname] - no .list2 argument."; } ::set List1 [::sargs::get $sargs .list1]; ::set List2 [::sargs::get $sargs .list2]; ::array set Array1 {}; ::array set Array2 {}; ::array set Intersection {}; ::foreach Value $List1 { ::set Array1($Value) {} } ::foreach Value $List2 { ::set Array2($Value) {} } ::foreach Item [::concat $List1 $List2] { ::if {[::info exists Array1($Item)] && [::info exists Array2($Item)]} { ::set Intersection($Item) {}; } } ::return [::lsort [::array names Intersection]]; } ::proc ::qw::intersect3 {List1 List2} { /* { intersect and intersect3 should be list operations. We also use sargs to allow for subsequent options such as sorting etc. */ } ::return [::qw::list::intersect3 .list1 $List1 .list2 $List2]; } ::proc ::qw::intersect {List1 List2} { ::return [::qw::list::intersect .list1 $List1 .list2 $List2]; } ::proc ::qw::list::eliminate_duplicates {sargs} { /* { 2.35.1 Eliminates duplicates without changing the original order in which elements are encountered. The first occurrence of an element is not eliminated. */ } ::if {![::sargs::exists $sargs .list]} { ::qw::bug 314120211229082857 "[::qw::procname] - no .list argument."; } ::set List [::sargs::get $sargs .list]; ::set Result [::union $List $List]; ::return $Result; } ::proc ::qw::list::dump_numbered_list {sargs} { /* { Usage: ::qw::list::dump_numbered_list .name "SomeList" .list $List; To stdout: SomeList[0]=value_0 SomeList[1]=value_1 ... SomeList[N-1]=value_n-1 */ } ::set Count 0; ::set Name [::sargs::get $sargs .name]; ::foreach Item [::sargs::get $sargs .list] { ::puts "$Name\[$Count\]==$Item"; ::incr Count 1; } }