Visual cd

if 0 {Richard Suchenwirth 2006-02-21 - Here's another Sepp componentlet - an overloaded cd that keeps a most-recently-used stack of the directories visited so far. For added convenience, a menu displaying this LRU stack is added to the console so you can view it, and change to a directory by selecting it from the menu, rather than typing its name (convenient when stylus-taping on a small screen).

The script has been tested stand-alone on Win XP, but is of course intended by me for use with eTcl :-) See also Extending the eTcl console. }

 package require Tk

#-- Initialization of the directory stack

 proc visual'cd'init {} {
    console eval {
        if ![winfo exists .menubar.cd] {
            .menubar insert 4 cascade -menu [menu .menubar.cd -tearoff 0] \
                -label cd
            proc dirsel'update {m dirs} {
                $m delete 0 end
                foreach dir $dirs {
                    $m add command -label $dir -command "cd {$dir}; puts {$dir}"
                }
            }
        }
     }
     rename cd tcl::cd
     #-- Overloaded version
     proc cd {{dir ""}} {
         global dirstack
         if {$dir eq ""} {set dir [file normalize ~]}
         if {$dir eq "-"} {cd [lindex $dirstack end-1]; puts [pwd]; return}
         tcl::cd $dir
         mrupush dirstack [pwd]
         console eval [list dirsel'update .menubar.cd $dirstack]
     }
     set ::dirstack {}
     cd .
 }

#-- Make sure an item is last in a most-recently-used queue

 proc mrupush {_mruq value} {
    upvar 1 $_mruq mruq
    lremove mruq $value
    lappend mruq $value
 }

#-- Remove an item from a list, if present

 proc lremove {_list value} {
    upvar 1 $_list list
    set pos [lsearch -exact $list $value]
    set list [lreplace $list $pos $pos]
 }

#-- Self-test if sourced at toplevel:

 if {[file tail [info script]] eq [file tail $argv0]} {
     console show
     wm withdraw .
     visual'cd'init
     console eval {
         bind .console <Escape> {
             exec [info na] [consoleinterp eval {set argv0}] &; exit
         }
     }
 }

Arts and crafts of Tcl-Tk programming