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