## ********************************************************
 ## stack.tcl version 2.0
 ##
 ## Provides stack-like functions for tcl.
 ##
 ## Release Date: 00.04.07.
 ##
 ## In all of these functions, a Tcl list is handled like
 ## a stack.
 ##
 ## The caller wishing to use these functions without
 ## qualifiying the names with stack:: should include the
 ## line:
 ##        namespace import stack::*.
 ## after requiring or sourcing this code.  Possibly
 ## qualfying this with:
 ##        namespace forget stack::errorTest.
 ##
 ## When speed is more important than exception handling
 ## the variable "stack::nodebug" can be set to "1" and
 ## things will go somewhat faster.
 ##
 ## When debugging IS enabled, the CALLING function must
 ## be caught to catch the uplevel'd exceptions.
 ##
 ## When the stack being manipulated is at global scope,
 ## remember to refer to it as ::name, or the error handler
 ## will complain about scoping problems.  
 ## ********************************************************

 ;#barecode

 package provide stack 2.0

 namespace eval stack {
     variable nodebug 0
 }

 ## ********************************************************
 ## Name: stack::getItem
 ##
 ## Description:
 ## Retrieves an item from stack and returns index into stack.

 proc stack::getItem { { stack "" } { regex "" } { n 1 } } {
      set s [ uplevel 1 [ list set $stack ] ]
      stack::errorTest
      set i [ lsearch -regexp $s $regex ]
      if { $i < 0 } {
         return [ list -1 {} ]
      }
      set j [ expr {$i + $n - 1} ]
      set data [ lrange $s $i $j ]
      return  [ list $i $data ]
 }
 ## ********************************************************

 ## ********************************************************
 ## Name: stack::updateItem
 ##
 ## Description:
 ## Replace an item from stack.
 ## Use getItem to locate item 
 ## note that an lreplace on index -1 causes a push!

 proc stack::updateItem { { stack "" } { index -1 } { newitem "" } } {
      if { $index < 0 } { return }
      set s [ uplevel 1 [ list set $stack ] ]
      stack::errorTest
      set s [ lreplace $s $index $index $newitem ]
      uplevel 1 [ list set $stack $s ]
 }
 ## ********************************************************

 ## ********************************************************
 ## Name: stack::popvector
 ##
 ## Description:
 ## Pop items from the "top" of the list/stack.
 ## "n" is the number of elements to pop.
 ## Popped items are removed from the list and
 ## returned.

 proc stack::popvector { { stack "" } { n 1 } } {
     set s [ uplevel 1 [ list set $stack ] ]
     stack::errorTest
     incr n -1
     set data [ lrange $s 0 $n ]
     incr n  1
     set s [ lrange $s $n end ]
     uplevel 1 [ list set $stack $s ]
     set data
 }
 ## ********************************************************

 ## ********************************************************
 ## Name: stack::pop
 ##
 ## Description:
 ## Pop a single item from the "top" of the list/stack.
 ## Equivalent to [lindex [stack::popvector $stackName 1] 0]

 proc stack::pop {{stack {}}} {
     stack::errorTest
     set s [ uplevel 1 [ list set $stack ]]
     uplevel 1 [ list set $stack [ lrange $s 1 end ]]
     lindex $s 0
 }
 ## ********************************************************

 ## ********************************************************
 ## Name: stack::push
 ##
 ## Description:
 ## Push items onto the top of the list/stack.
 ## "args" is a special Tcl variable which collects all
 ## arguments to a proc which are not explicitly named.

 proc stack::push { { stack "" } args } {
     stack::errorTest
     set s [ uplevel 1 [ list set $stack ] ]
     uplevel 1 [ list set $stack [ concat $args $s ] ]
 }
 ## ********************************************************

 ## ********************************************************
 ## Name: stack::shift
 ##
 ## Description:
 ## Shift items onto bottom of list/stack.
 ##
 ## Notes:
 ## Equivalent to lappend.

 proc stack::shift { { stack "" } args } {
     stack::errorTest
     uplevel 1 [concat [list lappend $stack] $args]
 }
 ## ********************************************************

 ## ********************************************************
 ## Name: stack::unshift
 ##
 ## Description:
 ## Unshifts items from the bottom of the list/stack.
 ## Unshifted items are removed from the list and returned.

 proc stack::unshift { { stack "" } { n 1 } } {
     set s [ uplevel 1 [ list set $stack ] ]
     stack::errorTest
     uplevel 1 [ list set $stack [ lrange $s 0 end-$n ] ]
     lrange $s end-[ expr {$n-1} ] end
 }
 ## ********************************************************
 
 ## ********************************************************
 ## Name: stack::prune
 ##
 ## Description:
 ## Prunes a list/stack based on a regular expression.
 ## "n" here refers to the number of items to associate
 ## into a group for regexp processing.
 ## Useful for things like queues where a key is associated
 ## with a number of entries and you want to strip out all
 ## entries based on a key.
 ## Pruned values are removed from the list/stack and
 ## returned.

 proc stack::prune { { stack "" } { regex "" } { n 1 } } {
      set s [ uplevel 1 [ list set $stack ] ]
      stack::errorTest
      set twigs [ list ]
      set i 0
      while { 1 } {
         set i [ lsearch -regexp $s $regex ]
         if { $i < 0 } { break }
         set j [ expr {$i + $n - 1} ]
         set data  [ lrange   $s $i $j ]
         set twigs [ concat $twigs $data ]
         set s     [ lreplace $s $i $j ]
     }
     uplevel 1 [ list set $stack $s ]
     set twigs
 }
 ## ********************************************************

 ## ********************************************************
 ##
 ## Name: stack::circB
 ##
 ## Description:
 ## Cause a stack to behave like a circular buffer, or
 ## like a "history" buffer.
 ## This function and stack::circF are complementary,
 ## enabling "forward" and "backward" circulation.

 proc stack::circB { { stack "" } { n 1 } } {
     set s [ uplevel 1 [ list set $stack ] ]
     stack::errorTest
     eval [list stack::push s] [stack::unshift s $n]
     uplevel 1 [ list set $stack $s ]
 }
 ## ********************************************************

 ## ********************************************************
 ##
 ## Name: stack::circF
 ##
 ## Description:
 ## Causes a stack to behave like a circular buffer, or
 ## like a "history" buffer.
 ## This function and stack::circB are complementary,
 ## enabling "forward" and "backward" circulation.

 proc stack::circF { { stack "" } { n 1 } } {
     set s [ uplevel 1 [ list set $stack ] ]
     stack::errorTest
     eval [list stack::shift s ] [stack::popvector s $n]
     uplevel 1 [ list set $stack $s ]
 }
 ## ********************************************************

 ## ********************************************************
 ##
 ## Name: stack::flip
 ##
 ## Description:
 ## Reverses the order of elements in a stack or list.

 proc stack::flip { { stack "" } } {
     set s [ uplevel 1 [ list set $stack ] ]
     stack::errorTest
     set rev [list]
     for {set i [expr {[llength $s]-1}]} {$i>=0} {incr i -1} {
         lappend rev [lindex $s $i]
     }
     uplevel 1 [ list set $stack $rev ]
 }
 ## ********************************************************

 ## ********************************************************
 ##
 ## Name: stack::shuffle
 ##
 ## Description:
 ## Randomly reorder items in a list.

 proc stack::shuffle { { stack "" } } {
     set s [ uplevel 1 [ list set $stack ] ]
     stack::errorTest
     set deck [list]
     expr srand([clock clicks])
     for {set length [llength $s]} {$length>0} {incr length -1} {
         set i [ expr {int ( rand() * $length )} ]
         lappend deck [lindex $s $i]
         set s [ lreplace $s $i $i ]
     }
     uplevel 1 [ list set $stack $deck ]
 }
 ## ********************************************************

 ## ********************************************************
 ##
 ## Name: stack::errorTest
 ##
 ## Description:
 ## Error tests for stack validity. Not rigorous.
 ## Tests done in level of caller.

 proc stack::errorTest {} {
     if { $stack::nodebug } { return {} }
     uplevel 1 {
         if {![info exists stack]} {
             return -code error "stack::errorTest called externally."
         } elseif {[info exists n] && [regexp {[^0-9]} $n]} {
             return -code error "Second argument must be integer."
         } elseif {[info exists args] && ![llength $args]} {
             return -code error "No extra values passed."
         } elseif {![string length $stack]} {
             return -code error "No stack name given."
         } elseif {![llength $s]} {
             if {![regexp {:push|:shift} [stack::myName]]} {
                 return -code error "Stack \"$stack\" exhausted."
             }
         }
     }
 }
 ## ********************************************************

 ## ********************************************************
 ##
 ## Name: stack::myName
 ##
 ## Description:
 ## Returns the name of the calling procedure.  Does this
 ## by parsing level info.  Level -1 is the immediate
 ## caller, level -2 is the caller of the caller, etc.

 proc stack::myName { { level "-1" } } {
      return [ lindex [ info level $level ] 0 ]
 }
 ## ********************************************************

----
With regard to ''shuffle'' above, see [Shuffle a list]. Timing results are available too through that page.

KBK: Thanks for the plug.  8-)