git.zerfleddert.de Git - micropolis/blob - src/tclx/tclsrc/array.tcl

   1 #
   2 # arrayprocs.tcl --
   3 #
   4 # Extended Tcl array procedures.
   5 #
   6 #------------------------------------------------------------------------------
   7 # Copyright 1992 Karl Lehenbauer and Mark Diekhans.
   8 #
   9 # Permission to use, copy, modify, and distribute this software and its
  10 # documentation for any purpose and without fee is hereby granted, provided
  11 # that the above copyright notice appear in all copies.  Karl Lehenbauer and
  12 # Mark Diekhans make no representations about the suitability of this
  13 # software for any purpose.  It is provided "as is" without express or
  14 # implied warranty.
  15 #------------------------------------------------------------------------------
  16 # $Id: arrayprocs.tcl,v 2.0 1992/10/16 04:51:54 markd Rel $
  17 #------------------------------------------------------------------------------
  18 #
  19
  20 #@package: TclX-ArrayProcedures for_array_keys
  21
  22 proc for_array_keys {varName arrayName codeFragment} {
  23     upvar $varName enumVar $arrayName enumArray
  24
  25     if ![info exists enumArray] {
  26         error "\"$arrayName\" isn't an array"
  27     }
  28
  29     set searchId [array startsearch enumArray]
  30     while {[array anymore enumArray $searchId]} {
  31         set enumVar [array nextelement enumArray $searchId]
  32         uplevel $codeFragment
  33     }
  34     array donesearch enumArray $searchId
  35 }