Forward-compatible lsort

AMG: The lsort -stride switch is new in Tcl 8.6. The following code makes it available in 8.5.
Prerequisites:
rename lsort Lsort
proc lsort {args} {
    # Process arguments.
    set pass {}
    if {![llength $args]} {
        throw {TCL WRONGARGS} "wrong # args: should be\
                \"lsort ?-option value ...? list\""
    }
    set list [lindex $args end]
    set args [lrange $args 0 end-1]
    while {[llength $args]} {
        set args [lassign $args arg]
        switch [tcl::prefix match {
            -ascii -command -decreasing -dictionary -increasing -index -indices
            -integer -nocase -real -stride -unique
        } $arg] {
        -command {
            if {![llength $args]} {
                throw {TCL ARGUMENT MISSING} "\"-command\" option must be\
                        followed by comparison command"
            }
            lappend pass $arg [lindex $args 0]
            set args [lrange $args 1 end]
        } -index {
            if {![llength $args]} {
                throw {TCL ARGUMENT MISSING} "\"-index\" option must be\
                        followed by list index"
            }
            set args [lassign $args index]
        } -stride {
            if {![llength $args]} {
                throw {TCL ARGUMENT MISSING} "\"-stride\" option must be\
                        followed by stride length"
            }
            set args [lassign $args stride]
        } default {
            lappend pass $arg
        }}
    }

    if {[info exists stride]} {
        # Validate -stride and -index.
        if {![string is integer -strict $stride]} {
            throw {TCL VALUE NUMBER} "expected integer but got \"$stride\""
        } elseif {$stride < 2} {
            throw {TCL OPERATION LSORT BADSTRIDE} "stride length must be at\
                    least 2"
        } elseif {[llength $list] % $stride} {
            throw {TCL OPERATION LSORT BADSTRIDE} "list size must be a multiple\
                    of the stride length"
        } elseif {![info exists index]} {
            set index 0
        } elseif {$index < 0 || $index > $stride} {
            throw {TCL OPERATION LSORT BADINDEX} "when used with \"-stride\",\
                    the leading \"-index\" value must be within the group"
        }

        # Build a nested list grouped by stride.
        set newList {}
        for {set i 0} {$i < [llength $list]} {incr i $stride} {
            lappend newList [lrange $list $i [expr {$i + $stride - 1}]]
        }

        # Sort the list without using -stride, then flatten the nested result.
        concat {*}[Lsort -index $index {*}$pass $newList]
    } else {
        # When not using -stride, call the base implementation directly.
        Lsort {*}[if {[info exists index]} {list -index $index}] {*}$pass $list
    }
}
Category Command