Return to pushd.tcl CVS log

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

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

1.1     ! root        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: 
        !            22: global TCLENV(dirPushList)
        !            23: 
        !            24: set TCLENV(dirPushList) ""
        !            25: 
        !            26: proc 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: 
        !            39: proc 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: 
        !            50: proc dirs {} { 
        !            51:     global TCLENV
        !            52:     echo [pwd] $TCLENV(dirPushList)
        !            53: }

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