if 0 {[Richard Suchenwirth] 2003-03-18 - I needed a way for testing whether the elements in a list were all equal. Not a hard nut to crack - just compare the first with all the others. But then I thought on how to generalize this approach, so besides equality, it could also be used for testing monotonous ascension/descension, etc by comparing each two neighboring elements. Here's what I came up with, allowing the one-liner "luxury" of calling either with flat args, or a list (to avoid the need for [eval] ;-). Note that in order to pass the operator in as an argument, the [if] in the loop has an explicit [expr] invocation:
}
 proc multicompare {op args} {
    if {[llength $args]==1} {set args [lindex $args 0]}
    set first [lindex $args 0]
    foreach i [lrange $args 1 end] {
       if {![expr $first $op $i]} {return 0}
       set first $i
    }
    return 1
 }
if 0 {#--------------------------- Testing:
 % multicompare == 1 1 1 1
 1
 % multicompare == 1 1 1 1 0
 0
 % multicompare == 1 1 1 1 1.0
 1
 % multicompare == {1 1 1 1 1.0}
 1
 % multicompare < {1 2 3 4 5}
 1
 % multicompare < {1 2 3 4 5 0}
 0
 % multicompare < {1 2 3 4 5 6}
 1
 % multicompare <= {1 2 2 3 4 5 6}
 1
 % multicompare <= {1 21 2 3 4 5 6}
 0
----
Note however that the comparison of neighboring elements would not work right in tests for inequality:
 multicompare != {1 2 1} => 1, which is wrong - the two 1's are never compared
In this case we need the list of all pairs that can be formed from the list - basically a half matrix LxL minus the main diagonal. This code is factored out into a ''pairs'' function:}
 proc pairs list {
    set res {}
    set last [expr {[llength $list]-1}]
    for {set i 0} {$i < $last-1} {incr i} {
       for {set j [expr {$i+1}]} {$j < $last} {incr j} {
          lappend res [list [lindex $list $i] [lindex $list $j]]
       }
    }
    set res
 }
 proc multiNotEqual list {
    foreach pair [pairs $list] {
       if {[lindex $pair 0] == [lindex $pair 1]} {return 0}
    }
    return 1
 }
if 0 {
This custom comparison can be integrated into multiCompare above, by adding the line
 if {$op == "!="} {return [multiNotEqual $args]}
below the ''llength $args'' check.
----
[Arts and crafts of Tcl-Tk programming]
}