Tkabber

Artifact [e732d3f519]
Login

Artifact e732d3f51997bed588ef2bb9c0225f3da9ba6ee1:


proc cconcat {args} {
    set result ""
    foreach arg $args {
        append result $arg
    }

    return $result
}

proc cequal {string1 string2} {
    if {[string compare $string1 $string2]} {
        return 0
    }

    return 1
}

proc cindex {string indexExpr} {
    return [string index $string \
                   [indexExpr $indexExpr [string length $string]]]
}

proc clength {string} {
    return [string length $string]
}

proc crange {string firstExpr lastExpr} {
    set len [string length $string]

    return [string range $string [indexExpr $firstExpr $len] \
                                 [indexExpr $lastExpr $len]]
}

proc ctype {args} {
    switch -- [llength $args] {
        4 {
            return [eval string is [list [lindex $args 2]] \
                         [linsert $args 2 2]]
        }

        default {
            return [eval string is $args]
        }
    }
}

proc indexExpr {indexExpr len} {
    switch -regexp -- $indexExpr {
        {^[Ee][Nn][Dd]*$} {
            incr len -1

            return [expr $len[string range $indexExpr 3 end]]
        }

        {^[Ll][Ee][Nn]*$} {
            return [expr $len[string range $indexExpr 3 end]]
        }

        default {
            return $indexExpr
        }
    }
}

proc lassign {list args} {
    foreach name $args {
        upvar $name var

        set var [lindex $list 0]
        set list [lrange $list 1 end]
    }

    return $list
}

proc lcontain {list element} {
    if {[lsearch -exact $list $element] < 0} {
        return 0
    }
    return 1
}

proc lempty {list} {
    if {[llength $list] > 0} {
        return 0
    }

    return 1
}

proc lmatch {args} {
    switch -- [llength $args] {
        3 {
            set mode [lindex $args 0]
            set list [lindex $args 1]
            set pattern [lindex $args 2]
        }

        default {
            set mode -glob
            set list [lindex $args 0]
            set pattern [lindex $args 1]
        }
    }

    set result {}
    foreach elem $list {
        switch -- $mode {
            -glob {
                if {[string match $pattern $elem]} {
                    lappend result $elem
                }
            }

            -exact {
                if {![string compare $pattern $elem]} {
                    lappend result $elem
                }
            }

            -regexp {
                if {![regexp -- $pattern $elem]} {
                    lappend result $elem
                }
            }
        }
    }

    return $result
}

proc lvarpop {name {indexExpr 0} args} {
    upvar $name var

    set result [lindex $var \
                       [set indexExpr [indexExpr $indexExpr [llength $var]]]]

    switch -- [llength $args] {
        0 {
            set var [lreplace $var $indexExpr $indexExpr]
        }

        default {
            set var [lreplace $var $indexExpr $indexExpr [lindex $args 0]]
        }
    }

    return $result
}

proc lvarpush {name string {indexExpr 0}} {
    upvar $name var

    if {![info exists var]} {
        set var {}
    }
    set var [linsert $var [indexExpr $indexExpr [llength $var]] $string]
}

proc lrmdups {list} {
    return [lsort -unique $list]
}

proc max {num1 args} {
    foreach num $args {
        if {$num1 < $num} {
            set num1 $num
        }
    }

    return $num1
}

proc min {num1 args} {
    foreach num $args {
        if {$num1 > $num} {
            set num1 $num
        }
    }

    return $num1
}

proc random {args} {
    switch -- [llength $args] {
        1 {
            return [expr round(rand()*[lindex $args 0])]
        }

	default {
	    return ""
	}
    }
}