| 1 | # |
| 2 | # packages.tcl -- |
| 3 | # |
| 4 | # Command to retrieve a list of packages or information about the packages. |
| 5 | #------------------------------------------------------------------------------ |
| 6 | # Copyright 1992 Karl Lehenbauer and Mark Diekhans. |
| 7 | # |
| 8 | # Permission to use, copy, modify, and distribute this software and its |
| 9 | # documentation for any purpose and without fee is hereby granted, provided |
| 10 | # that the above copyright notice appear in all copies. Karl Lehenbauer and |
| 11 | # Mark Diekhans make no representations about the suitability of this |
| 12 | # software for any purpose. It is provided "as is" without express or |
| 13 | # implied warranty. |
| 14 | #------------------------------------------------------------------------------ |
| 15 | # $Id: packages.tcl,v 2.0 1992/10/16 04:52:02 markd Rel $ |
| 16 | #------------------------------------------------------------------------------ |
| 17 | # |
| 18 | |
| 19 | #@package: TclX-packages packages autoprocs |
| 20 | |
| 21 | proc packages {{option {}}} { |
| 22 | global TCLENV |
| 23 | set packList {} |
| 24 | foreach key [array names TCLENV] { |
| 25 | if {[string match "PKG:*" $key]} { |
| 26 | lappend packList [string range $key 4 end] |
| 27 | } |
| 28 | } |
| 29 | if [lempty $option] { |
| 30 | return $packList |
| 31 | } else { |
| 32 | if {$option != "-location"} { |
| 33 | error "Unknow option \"$option\", expected \"-location\"" |
| 34 | } |
| 35 | set locList {} |
| 36 | foreach pack $packList { |
| 37 | set fileId [lindex $TCLENV(PKG:$pack) 0] |
| 38 | |
| 39 | lappend locList [list $pack [concat $TCLENV($fileId) \ |
| 40 | [lrange $TCLENV(PKG:$pack) 1 2]]] |
| 41 | } |
| 42 | return $locList |
| 43 | } |
| 44 | } |
| 45 | |
| 46 | proc autoprocs {} { |
| 47 | global TCLENV |
| 48 | set procList {} |
| 49 | foreach key [array names TCLENV] { |
| 50 | if {[string match "PROC:*" $key]} { |
| 51 | lappend procList [string range $key 5 end] |
| 52 | } |
| 53 | } |
| 54 | return $procList |
| 55 | } |