]> git.zerfleddert.de Git - micropolis/blame - src/tclx/tclsrc/packages.tcl
use old forking player when SDL_mixer is not available
[micropolis] / src / tclx / tclsrc / packages.tcl
CommitLineData
6a5fa4e0
MG
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
21proc 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
46proc 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}
Impressum, Datenschutz