xk2600

I have often utilized this wiki since around 2001, and have only recently felt like I've become comfortable enough with my skillset to contribute recently. Figured I would put together a landing page for common little pieces of code I utilize or feel is novel in some form or another.

All code contributed below is free to use without restriction, as long as when it is used it is understood that the individual, company, or any party associated with the use of said code takes complete responsibility, and all liability of the result of the execution of said code, including the complete destruction of all things. The contributor takes absolutely no liability from the results aforementioned.

c-like preprocessor facility - useful adaptation of preprocessing directives.. I utilize this to deal with debug control.
static constant datasets stored in proc - fast access to static constants (enum-like) via runtime created proc.
subject observer logic bomb - allows event driven programming to include complex logic which only runs callback on condition.

Introspection of the interpreter

proc procInfoExample {arg1 arg2 {option1 {somedefaultvalue}}} {

  set levelInfo [info level [info level]]
  set procName [lindex $levelInfo 0]

  puts ""
  puts "Show command + args for this proc by getting info for this level:"
  puts "  % info level \[info level\]\n  [info level [info level]]\n"

  puts "Get this Proc Name:"
  puts "  % lindex $levelInfo 0\n  [lindex $levelInfo 0]\n"

  puts "Arguments:"
  puts "  % info args $procName\n  [info args $procName]\n"

  puts "What about determining default value for optional arguments?:"
  puts "     NOTE  1: true (has a default value), 0: false (there is no default value)\n"
  foreach arg [info args $procName] {   
    puts "  % puts \[info default $procName $arg ret\] : \$ret\n  [info default $procName $arg ret] : $ret\n"
  }
}

procInfoExample test test

Show command + args for this proc by getting info for this level:
  % info level[info level]
  procInfoExample test test

Get this Proc Name:
  % lindex procInfoExample test test 0
  procInfoExample

Arguments:
  % info args procInfoExample
  arg1 arg2 option1

What about determining default value for optional arguments?:
     NOTE  1: true (has a default value), 0: false (there is no default value)

  % puts [info default procInfoExample arg1 ret] : $ret
  0 : 

  % puts [info default procInfoExample arg2 ret] : $ret
  0 : 

  % puts [info default procInfoExample option1 ret] : $ret
  1 : somedefaultvalue

%

Error Handling snippets

pflags

  # pflags --
  #     returns a string with a consise representation of flags stored as an integer up to system 
  #     bit width. Note output only produces response for flags set. (value=1)
  #
  proc pflags {label flags flagDefinition} {

    array set flagArray $flagDefinition
    set result {}
    set LF "\n"

    # determine appropriate indention
    set indent [string repeat { } [expr {[string length $label]}]]

    # enforces 8 bit boundry
    set bitwidth [string length [format {%b} $flags]]
    set bitwidth [expr { (($bitwidth - 1) / 8 + 1) * 8 }]
    set bits [format "%0${bitwidth}b" $flags] 

    set result [format { %s: %s (%d)%s} $label $bits $flags $LF]

    set callouts [string map {0 { } 1 {T}} $bits]
    append result [format { %s  %s %s} $indent $callouts $LF]
    set callouts [string map {{T} {|}} $callouts]
    set tail {+}

    foreach flag [lsort -increasing -integer [array names flagArray]] {
      
      set callouts [string range $callouts 0 end-1]
      set tail [format {%s-} $tail]
      if {($flags & $flag) > 0} {

        append result [format { %s  %s%s %s %s} $indent $callouts $tail $flagArray($flag) $LF]
        
      }
    }
    return $result
  }

% pflags errorCode 63 {
    1 {error}
    2 {reserved by tcl}
    4 {reserved by tcl}
    8 {failed to create interp}
   16 {failed to cleanup interp}
   32 {failed to load last state}
  }
 errorCode: 00111111 (63)
              TTTTTT 
              |||||+- error 
              ||||+-- reserved by tcl 
              |||+--- reserved by tcl 
              ||+---- failed to create interp 
              |+----- failed to cleanup interp 
              +------ failed to load last state 
%

this statevar

  proc this {statevar} {

    # this --
    #       The proc 'this' returns various information about the stack without having
    #       to remember the programatic idioms behind it.

    switch -exact $statevar {
      procName { return [lindex [info level [expr {[info level] - 1}]] 0] }
      commandString { return [dict get [info frame [expr {[info level] - 1}]] cmd] }
      usage {
        set procName [lindex [info level [expr {[info level] - 1}]] 0]
        set usage {}

        # identify args
        foreach arg [info args $procName] {
          if {[info default $procName $arg defaultValue]} {
            lappend usage [format {?%s?} $arg]
          } else {
            lappend usage $arg
          }
        }
        return [format {"%s %s"} $procName $usage]

      }
      default {
        return [format {bad statevar "%s" must be: $stateVars}
      }
    }
  }

% proc testThisProc {reqVar1 {optVar2 Var2DefaultValue} {optVar3 {}}} {
    puts "      procName: [this procName]"
    puts " commandString: [this commandString]"
    puts "         usage: [this usage]"
}

% testThisProc reqVar1ValueTest
      procName: testThisProc
 commandString: testThisProc reqVar1ValueTest
         usage: "testThisProc reqVar1 ?optVar2? ?optVar3?"

Category Person