Here's a couple handy little gems I like to have available.  The one-letter ones are not always the most efficient way of doing the task, but when the line's getting a little convoluted, these things can make it a little more readable.  At least, I think so...

======
interp alias {} nocase {} string equal -nocase

interp alias {} L {} list

proc K {args} {lindex $args 0}

proc U {varName} {
        uplevel 1 [subst -noc {lindex [list [set $varName] [unset $varName]] 0}]
}

proc S {varName {value {}} } {
        uplevel 1 \
        [subst -noc {lindex [list [set $varName] [set $varName [list $value]]] 0}]
}

proc G {varName {default ""} } {
        upvar 1 $varName var
        if { [info exists var] } {return $var}
        return $default
}

proc error-args {mesg} {
        return -level 2 -code error "wrong # args: should be \"$mesg\""
}

proc list2 {args} {
        set outl [list]
        foreach item $args {lappend outl $item $item}
        return $outl
}
======

And what I consider to be an irritatingly trivial omission from the [expr] command:

======
proc ::tcl::mathfunc::sgn {v} {expr {$v > 0 ? 1 : $v < 0 ? -1 : 0}}
======

Also there's my version of the [lshift] command.

----
[AMG]: Here's [rmax]'s clever version of sgn:

======
proc ::tcl::mathfunc::sgn {v} {expr {($v > 0) - ($v < 0)}}
======

----
Here's a proc I use for adding new commands to an existing [ensemble].  It's probably not the best version, but it's handy, and it works where I've needed it.

======
proc proc-ensemble {args} {
        if { ( [llength $args] < 4 || [llength $args] % 3 != 1 ) &&
                        [llength $args] != 2 } {
                error-args "proc-ensemble command ?name args body?..."
        }
        set args [lassign $args command]
        set spc [namespace ensemble configure $command -namespace]
        set map [namespace ensemble configure $command -map]
        # convert "-subcommands" into "-map"
        set cmds [namespace ensemble configure $command -subcommands]
        if { [llength $cmds] } {
                foreach cmd [namespace ensemble configure $command -subcommands] {
                        dict set map $cmd ${spc}::$cmd
                }
                namespace ensemble configure $command -subcommands {}
        }
        # validate list-of-procs form
        if { [llength $args] == 1 } {
                set args [lindex $args 0]
                if { [llength $args] % 3 != 0 } {
                        error-args "proc-ensemble command ?name args body?..."
                }
        }
        # build the new ensemble commands
        foreach {name args body} $args {
                if { $body ne "" } {
                        proc ${spc}::_$name $args $body
                        dict set map $name ${spc}::_$name
                } elseif { [dict exists $map $name] } {
                        dict unset map $name
                }
        }
        # update the ensemble command map
        namespace ensemble configure $command -map $map
}
======

And now, a proc that does a similar job to [regsub], except that the text to be substituted is the value produced by evaluating the supplied ''script''.

======
proc regcmd {args} {
        if { [llength $args] < 3 } {
                error-args "regcmd ?switches? exp string script"
        }

        set parts [list]; set opts [list]; set start 0; set all 0
        for {set n 0} {$n < [llength $args]-3} {incr n} {
                set arg [lindex $args $n]
                switch -exact -- $arg {
                   -expanded - -line - -linestop - -lineanchor - -nocase
                        {if {$arg ni $opts} {lappend opts $arg}}
                   -indices - -inline {if {$arg ni $parts} {lappend parts $arg}}
                   -start {set start [lindex $args [incr n]]}
                -all {set all 1}
                default {return -level 1 -code error "bad switch \"$arg\": must be -indices, -inline, -expanded, -line, -linestop, -lineanchor, -nocase, or -start"}
                }
        }
        if { ! [llength $parts] } {set parts "-inline"}
        lassign [lrange $args end-2 end] exp strn script
        lappend opts -start $start $exp
        
        set out ""
        while { [llength [set ranges [regexp -inline -indices {*}$opts $strn]]] } {
                set list [list]
                foreach range $ranges {
                        set item [list]
                        foreach part $parts {
                                switch -exact -- $part {
                                "-inline" {lappend item [string range $strn {*}$range]}
                                "-indices" {lappend item {*}$range}
                                }
                        }
                        lappend list $item
                }
                lassign [lindex $ranges 0] start stop
                append out [string range $strn 0 $start-1][uplevel 1 $script {*}$list]
                set strn [string range $strn $stop+1 end]
                if { ! $all } break
        }

        return $out$strn
}
======

<<categories>> Command