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
   }

}