| 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 | } |