Index: openacs-4/packages/acs-tcl/tcl/utilities-procs.tcl =================================================================== RCS file: /usr/local/cvsroot/openacs-4/packages/acs-tcl/tcl/utilities-procs.tcl,v diff -u -r1.55 -r1.56 --- openacs-4/packages/acs-tcl/tcl/utilities-procs.tcl 1 Nov 2003 08:45:37 -0000 1.55 +++ openacs-4/packages/acs-tcl/tcl/utilities-procs.tcl 4 Nov 2003 10:04:29 -0000 1.56 @@ -2872,6 +2872,79 @@ return 1 } +ad_proc -public util_subset_p { + -ignore_duplicates:boolean + list1 + list2 +} { + Tests whether list1 is a subset of list2. + + @param ignore_duplicates Set this to ignore duplicates in lists + + @return 1 if list1 is a subset of list2. + + @author Peter Marklund +} { + if { [llength $list1] == 0 } { + # The empty list is always a subset of any list + return 1 + } + + if { $ignore_duplicates_p } { + set sorted_list1 [list] + foreach elm [lsort $list1] { + if { [llength $sorted_list1] == 0 || ![string equal [lindex $sorted_list1 end] $elm] } { + lappend sorted_list1 $elm + } + } + } else { + set sorted_list1 [lsort $list1] + } + set sorted_list2 [lsort $list2] + + set len1 [llength $sorted_list1] + set len2 [llength $sorted_list2] + + # Loop over list1 and list2 in sort order, comparing the elements + + set index1 0 + set index2 0 + while { $index1 < $len1 && $index2 < $len2 } { + set elm1 [lindex $sorted_list1 $index1] + set elm2 [lindex $sorted_list2 $index2] + set compare [string compare $elm1 $elm2] + + switch -exact -- $compare { + -1 { + # elm1 < elm2 + # The first element in list1 is smaller than any element in list2, + # therefore this element cannot exist in list2, and therefore list1 is not a subset of list2 + return 0 + } + 0 { + # A match, great, next element + incr index1 + incr index2 + continue + } + 1 { + # elm1 > elm2 + # Move to the next element in list2, knowing that this will be larger, and therefore + # potentially equal to the element in list1 + incr index2 + } + } + } + + if { $index1 == $len1 } { + # We've reached the end of list1, finding all elements along the way, we're done + return 1 + } else { + # One or more elements in list1 not found in list2 + return 0 + } +} + ad_proc -public ad_tcl_list_list_to_ns_set { -set_id -put:boolean