pushdpopd.tcl

Functional equivalents to pushd and popd, mostly ;^)

 proc pushd { { dir "" } } {
   if { ! [ file isdirectory $dir ] && \
          [ string length $dir ] } {
      return -code error "${dir}: No such file or directory."
   }

   set dir [ file nativename $dir ]
   set here [ pwd ]
   regsub {^\.\.} $dir [ file dirname $here ] dir
   if { [ info exists ::__pushdpopd ] } {
      set last [ lindex $::__pushdpopd end ]
      if { ! [ string equal $here $last ] && \
             [ string length $dir ] } {
         lappend ::__pushdpopd $here
      } else {
         if { ! [ string length $dir ] } {
            if { [ llength $::__pushdpopd ] >=2 } {

               set ::__pushdpopd \
                  [ concat \
                  [ lrange $::__pushdpopd 0 end-2 ] \
                  [ lindex $::__pushdpopd end ] \
                  [ lindex $::__pushdpopd end-1 ] ]

               cd [ lindex $::__pushdpopd end ]
            }
         }
         return {}
      }
   } else {
      if { [ string length $dir ] } {
         set ::__pushdpopd $here
      } else {
         return -code error "Directory stack empty."
      }
   }
   lappend ::__pushdpopd $dir
   cd $dir
 }

 proc popd {} {
   if { ! [ info exists ::__pushdpopd ] } {
      return -code error "Directory stack empty."
   } else {
      if { ! [ string length $::__pushdpopd ] } {
         unset ::__pushdpopd
      }
   }
   set last [ lindex $::__pushdpopd end ]
   set prev [ lindex $::__pushdpopd end-1 ]
   if { ! [ string length $prev ] } {
      return -code error "Directory stack empty."
   }
   if { ! [ file isdirectory $prev ] } {
      set parent [ file dirname $prev ]
      if { [ file isdirectory $parent ] } {
         cd $parent
      } else {
         return -code error "${prev}: Parent directory missing."
      }
   } else {
      cd $prev
   }
   set ::__pushdpopd [ lrange $::__pushdpopd 0 end-2 ]
   if { ! [ string length $::__pushdpopd ] } {
      unset ::__pushdpopd
   }
 }

 proc dirs {} {
   if { ! [ info exists ::__pushdpopd ] } {
      pwd
   } else {
      puts $::__pushdpopd
   }
 }

I came up with the following in Tcl 8.6. -dther 2026-05-28 (minor edits: formatting + misnamed procs)

namespace eval pushdpopd {
  set dirstack {}
  proc pushd {{dir {}}} {
    variable dirstack
    lappend dirstack [pwd]
    if {$dir != {}} {cd $dir}
  }

  proc popd {} {
    variable dirstack
    if {[llength $dirstack] == 0} {
       error "dirstack underflow"
    }
    cd [lindex $dirstack end]
    set dirstack [lrange $dirstack 0 end-1]
  }
  namespace export pushd popd
}