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
Index: openacs-4/packages/acs-tcl/tcl/test/acs-tcl-test-procs.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/acs-tcl/tcl/test/acs-tcl-test-procs.tcl,v
diff -u -r1.15 -r1.16
--- openacs-4/packages/acs-tcl/tcl/test/acs-tcl-test-procs.tcl	7 Oct 2003 15:49:53 -0000	1.15
+++ openacs-4/packages/acs-tcl/tcl/test/acs-tcl-test-procs.tcl	4 Nov 2003 10:03:56 -0000	1.16
@@ -674,3 +674,17 @@
 
     db_dml drop_table {drop table tmp_db_transaction_test}
 }
+
+
+aa_register_case util__subset_p {
+    Test the util_subset_p proc.
+
+    @author Peter Marklund
+} {
+    aa_true "List is a subset" [util_subset_p [list c b] [list c a a b b a]]
+    aa_true "List is a subset" [util_subset_p [list a b c] [list c a b]]
+    aa_false "List is not a subset" [util_subset_p [list a a a b b c] [list c c a b b a]]
+    aa_true "List is a subset" [util_subset_p -ignore_duplicates [list a a a b b c] [list c c a b b a]]
+    aa_false "List is not a subset" [util_subset_p [list a b c d] [list a b c]]
+}
+