**Variable Extensions (varx) **

[Napier] (Dash Automation) - 11/09/2016

This page is dedicated to providing you guys with some of the variable-based procedures that we use heavily within our scripts.  Each procedure in the package below are meant to provide convenient syntax for commonly required patterns that we run into when creating out scripts.  We have put a fairly strong effort towards benchmarking with the development of each of these as we run our scripts on Systems that have 1/100th the processing power that most scripts would run on.  I absolutely welcome your feedback, criticisms, and additions. 

I will try to get the completely documentation and examples ready for you guys so that you can better understand how some of these procedures operate and how they may be able to provide the same level of convenience they do to us within almost every proc we write!

** Some Notes **

There are a few procedures which we utilize as dependencies within these scripts.  They are simple and are mostly a means to allow us to do some inline documentation of examples and tests.  As I can find the time I will absolutely attempt to convert them to the more standard approach taken by the community (or I welcome others to contribute if you feel so inclined).  Below are the utility procedures that may be used throughout that should be copied over.  They are great utilities mostly found within this wiki in other places.

======
proc % args {}
proc callback args { ::tailcall ::namespace code $args }
proc rrange { min max } { ::try {::expr {int(rand()*($max-$min+1)+$min)}} }
proc bench { cmd } {
  set times [ list \
    [rrange 15000 99999] [rrange 10000 30000] [rrange 90000 99999] \
    [rrange 30000 80000] [rrange 10000 20000] [rrange 50000 90000]
  ]
  set result {}
  foreach n $times { lappend result $n [ time $cmd $n ] }
  puts "
    --------------------------------------------------------
      Benchmark Statistics
      
      Host:      [info hostname] [info nameofexecutable] [info script]
      Version:   [info patchlevel]
      Command:   $cmd
      
      Times Run        Results
  "
  dict for { n stats } $result {
    puts "      $n        $stats"
  }
  puts "
    --------------------------------------------------------
  "
}
======

**Summary of Commands**

**** ::var::variables varName ...?varName? ... ****

======
# Summary:
#  ::var::variables is a convenience command which takes a list of namespace variable 
#  names and instantiates them within your procedure exactly like calling the variable 
#  command multiple times for each variable.
# Examples:
% {
  namespace eval foo {
    variable bar 1
    variable baz 2
    variable qux 3
  }
  proc ::foo::example {} {
    ::var::variables bar baz qux
    puts $bar        ; # % 1
    set qux foo
    # ... Do Fun Stuffs
  }
  ::foo::example
  puts $::foo::qux   ; # % foo
}
======

**** ::var::define varName ...?varName? ... ****

======
# Summary:
#  ::var::define allows you to provide a list of variable names which should be
#  created within your procedure.  If the variable does not already exist it will 
#  create it with an empty value (set $var {}).  It returns the args that are 
#  passed to it.
# Examples:
% {
  proc ::foo::example {} {
    ::var::define foo bar baz
    puts $foo        ; # % {}
    puts $bar        ; # % {}
    puts $baz        ; # % {}
    # ... Do Fun Stuffs
  }
  ::foo::example
}
======

**** ::var::const varName varValue ****

======
#############################################################################
# Summary:
#  ::var::const allows you to define a variable which can not be modified once 
#  an initial value has been set on it.  This can be useful in cases where you 
#  wish to build static values without worry another procedure or part of your 
#  current procedure may change the value.
#  This command returns the value that was set upon the const variable and thus 
#  may also be utilized as an identity procedure.
# Examples:
% {
  puts [ ::var::const foo bar ]   ; # % bar
  proc ::foo::example {} {
    global foo
    set foo baz
    puts $foo        ; # % bar
    # ... Do Fun Stuffs
  }
  set foo baz
  puts $foo          ; # % bar
  ::foo::example
}
======


**** ::var::sets varName varValue ...?varName? ...varValue ...****

======
#############################################################################
# Summary:
#  ::var::sets is a procedure which makes it easy to set the values of multiple
#  variables within a single line.  It is extremely useful when establishing default 
#  values as well as for making your procedures smaller and easier to read and maintain.
#  
#  In addition, this procedure will return a dict which contains the variables that were 
#  set and their values as the keys and values.
#############################################################################

# Examples:
% {  
  set dict [ ::var::sets foo bar baz qux ]
  puts $foo  ; % bar
  puts $baz  ; % qux
  puts $dict ; % {foo bar baz qux}
}
% {
  namespace eval foo {
    variable bar v1
    variable baz v2
  }
  proc ::foo::example {} {
    ::var::pipe variables foo baz | sets foo n1 baz n2 myVar test
    puts $myVar    ;  # % test
    # ... Do Fun Stuffs
  }
  ::foo::example
  puts $::foo::bar   ; # % n1
  puts $::foo::baz   ; # % n2
}
======


**** ::var::switch varValue   ...?globPattern? ...matchResponse ... ****

======
#############################################################################
# Summary:
#  ::var::switch is very similar to a regular switch command except that instead 
#  of executing a script when a match is found, we will simply return the value.
#  When using ::var::switch, in contrast to a regular switch command, the -glob
#  style matching is inferred.  You may optionally provide the -nocase parameter
#  if matching should be case-insensitive.
#  You may also define a response value of "-" to automatically match the next
#  response until a value value is matched.  This does provide the side effect
#  that returning a value of "-" becomes problematic.  In the case "-" never finds
#  a valid match down the line a response of "-" will be provided instead.
#
#  Notice that another difference is that rather than "default" we simply define * 
#  which will match any value (thus giving the same effect as default).
#  
# Examples:
% {
  proc ::foo::example { val } {
    return [ ::var::switch $val f* 1 b*r 2 *z 3 dog - q* 4 * 5 ]
  }
  puts [ ::foo::example foo ] ; # % 1
  puts [ ::foo::example bar ] ; # % 2
  puts [ ::foo::example baz ] ; # % 3
  puts [ ::foo::example qux ] ; # % 4
  puts [ ::foo::example dog ] ; # % 4
  puts [ ::foo::example ham ] ; # % 5
  puts [ ::foo::example ran ] ; # % 5
  puts [ ::foo::example taz ] ; # % 3
  puts [ ::foo::example fan ] ; # % 1
}
======
-------------
**The Script**

======
namespace eval var {}

proc ::var::callback args { ::tailcall ::namespace code $args }

proc ::var::variables args { ::foreach var $args { ::uplevel 1 [::list ::variable $var] } }

proc ::var::define args { 
  ::foreach var $args {
    ::upvar 1 $var v
    ::if { ! [::info exists v] } { ::set v {} }
  }
  ::return $args
}

proc ::var::sets args {
  ::foreach {var val} $args {
    ::upvar 1 $var ref 
    ::set ref $val
  }
  ::return $args
}

proc ::var::const {name value} {
  ::uplevel 1 [::list ::set $name $value]
  ::uplevel 1 [::list ::trace variable $name w "::set $name [::list $value];#"]
  ::return $value
}

proc ::var::switch args {
  ::set nocase 0; ::set next 0; ::set response {}
  ::foreach arg $args {
    ::set args [::lassign $args var]
    ::if { ! [::string match -* $arg] } { ::break }
    ::if { $arg eq "-nocase" } { ::set nocase 1 }
  }
  ::foreach { pattern response } $args {
    ::if { $next } { ::if { $response eq "-" } { ::continue } else { ::return $response } }
    ::if { $nocase ? [::string match -nocase $pattern $var] : [::string match $pattern $var]} {
      ::if { $response eq "-" } { ::set next 1; ::continue }
      ::return $response
    }
  }
  ::return $response
}

proc ::var::trace { var callback {value {}} } {
  ::upvar 1 $var current
  ::if {![::info exists current]} {::set current $value}
  ::uplevel 1 [::list ::trace add variable $var write [callback traceback $callback $current]]
}

proc ::var::traceback { callback prev var args } {
  ::upvar 1 $var value
  ::uplevel 1 [::list ::trace remove variable $var write [callback traceback $callback $prev ]]
  ::uplevel 1 [::list ::trace add    variable $var write [callback traceback $callback $value]]
  ::set a [::info args [::lindex $callback 0]]
  ::if { "args" in $a } {
    ::set args [::list $value $prev $var]
  } else {
    ::switch -- [::llength $a] {
      0 { ::set args {}                               }
      1 { ::set args [::list $value]                  }
      2 { ::set args [::list $value $prev]            }
      3 { ::set args [::list $value $prev $var]       }
      default { ::throw error {wrong # args: should be "", "value", "value prevValue", or "value prevValue varName"} }
    }
  }
  ::uplevel #0 [::list eval $callback $args]
}

proc ::var::untrace { var } {
  ::upvar 1 $var $var
  ::set info [::trace info variable $var]
  ::if { $info eq {} } { ::return }
  ::uplevel 1 [::list ::trace remove variable $var {*}[::lindex $info 0]]
}

proc ::var::pipe args {
  ::set cmds [::split $args |]
  ::foreach cmd $cmds {
    ::uplevel 1 [::list try [::namespace current]::[::string trim $cmd]]
  }
}

proc ::var::alias { var alias } { ::uplevel 1 [::list ::upvar 0 $var $alias] }

proc ::var::empty { varName args } {
  ::upvar 1 $varName var
  ::tailcall ::if [::expr {![::info exists var] || $var eq {}}] {*}$args
}

proc var::null {varName args} {
  ::upvar 1 $varName var
  ::tailcall ::if [::expr {![::info exists var]}] {*}$args
}

proc var::false {varName args} {
  ::upvar 1 $varName var
  ::tailcall ::if [::expr {[::info exists var] && [::string is false -strict $var]}] {*}$args
}

proc var::true {varName args} {
  ::upvar 1 $varName var
  ::tailcall ::if [::expr {[::info exists var] && [::string is true -strict $var]}] {*}$args
}


======

<<categories>> Data Structure | Command