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

