Return to packages.tcl CVS log

Up to [Micropolis - Activity] / micropolis / src / tclx / tclsrc

Annotation of micropolis/src/tclx/tclsrc/packages.tcl, revision 1.1

1.1     ! root        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: }

This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.