]> cvs.zerfleddert.de Git - micropolis/blame_incremental - src/tclx/tclsrc/pushd.tcl
let bundled tcl compile with recent tools
[micropolis] / src / tclx / tclsrc / pushd.tcl
... / ...
CommitLineData
1#
2# pushd.tcl --
3#
4# C-shell style directory stack procs.
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: pushd.tcl,v 2.0 1992/10/16 04:52:06 markd Rel $
17#------------------------------------------------------------------------------
18#
19
20#@package: TclX-directory_stack pushd popd dirs
21
22global TCLENV(dirPushList)
23
24set TCLENV(dirPushList) ""
25
26proc pushd {args} {
27 global TCLENV
28
29 if {[llength $args] > 1} {
30 error "bad # args: pushd [dir_to_cd_to]"
31 }
32 set TCLENV(dirPushList) [linsert $TCLENV(dirPushList) 0 [pwd]]
33
34 if {[llength $args] != 0} {
35 cd [glob $args]
36 }
37}
38
39proc popd {} {
40 global TCLENV
41
42 if [llength $TCLENV(dirPushList)] {
43 cd [lvarpop TCLENV(dirPushList)]
44 pwd
45 } else {
46 error "directory stack empty"
47 }
48}
49
50proc dirs {} {
51 global TCLENV
52 echo [pwd] $TCLENV(dirPushList)
53}
Impressum, Datenschutz