Richard Suchenwirth 2003-03-03 - Here is an enhanced development snapshot of iFile: a little file system browser - see that page for detailed explanations - I stripped lengthy comments from the source for faster editing. Many new features, the biggest chunk being proc introspection. No warranties, but enjoy!
In place of the files font_ce.txt (see Font families workaround) and puts_ce.txt (see puts workaround) sourced below, one might of course just include them here:
if ![llength [info command ::tk::font]] {
rename font ::tk::font
proc font {cmd args} {
switch -- $cmd {
f - fa - fam - families {
list Bookdings {Courier New}\
Frutiger Tahoma\
{Bitstream Cyberbit}\
{MS Gothic} Sorawin
}
default {
eval ::tk::font $cmd $args
}
}
}
}
proc redef_puts w {
set ::putsw $w
if ![llength [info command ::tcl::puts]] {
rename puts ::tcl::puts
proc puts args {
set la [llength $args]
if {$la<1 || $la>3} {
error "usage: puts ?-nonewline? ?channel? string"
}
set nl \n
if {[lindex $args 0]=="-nonewline"} {
set nl ""
set args [lrange $args 1 end]
}
if {[llength $args]==1} {
set args [list stdout $args]
}
foreach {channel s} $args break
set s [join $s] ;# (1) prevent braces at leading/tailing spaces
if {$channel=="stdout" || $channel=="stderr"} {
$::putsw insert end $s$nl
} else {
set cmd ::tcl::puts
if {$nl==""} {lappend cmd -nonewline}
lappend cmd $channel $s
eval $cmd
}
}
}
}
#Title: iFile - a little file system browser
set version 1.0
set g(about) " iFile $version:
a little file system explorer
Richard Suchenwirth, Konstanz 2003
Tcl/Tk: [info patchlevel]
Exec: [info nameofexecutable]
BWidget: [package require BWidget]
"
#set dir [file dir [info script]]
#source [file join $dir font_ce.txt]
#source [file join $dir puts_ce.txt]
set g(font) {Tahoma 7}
option add *Font $g(font)
set g(ufont) {{Bitstream Cyberbit} 10}
option add *BorderWidth 1
option add *padY 0
set g(sortedby) [set g(sortby) Name]
proc drawTree {w} {
$w insert end root _ -text / \
-drawcross allways -image $::g(folder)
openDir $w _
$w itemconfigure _ -open 1
}
proc openDir {w node} {
set dc [$w itemcget $node -drawcross]
if {$dc=="allways"} {
set path [getPath $w $node]
cd $path
set dirs [glob -nocomp -type d * .??*]
set parent $node
foreach dir [lsort -unique -dic $dirs] {
regsub -all {[^A-Za-z0-9]}\
$path/$dir _ node
if [llength [glob -noc -type d \
[file join $path $dir *]]] {
set dc allways
} else {set dc never}
$w insert end $parent $node -text $dir\
-drawcross $dc -image $::g(folder)
}
$w itemconfigure $parent \
-drawcross auto
}
set g(marked) ""
}
proc getPath {w node} {
set res ""
while {$node != "root"} {
set res [$w itemcget $node -text]/$res
set node [$w parent $node]
}
string range $res 1 end ;# avoid leading //
}
proc selectDir {w dir} {
global g
if ![file exists $dir] {
set dir [getPath $w $dir]
}
cd $dir
wm title . [set g(2) [pwd]]
$g(lb) delete [$g(lb) items]
set mode -dic
switch -- $g(sortby) {
Name {set index 1}
Type {set index 0}
Size {set index 3; set mode -integer}
Date {set index 5}
}
set n -1
set dirs ""
foreach i [glob -noc -type d *] {
set t [list . [format %-14s $i] -]
lappend t [llength [glob -noc $i/*]] files
lappend t [dateTime [file mtime $i]]
lappend dirs $t
}
foreach i [lsort $mode $g(dir) -index $index $dirs] {
set t [join [lrange $i 1 end]]
$g(lb) insert end [incr n] \
-image $g(folder) -text [string map {" - " \t} $t]
}
set files {}
foreach i [glob -noc -type f $g(filter)] {
set size [format %5d [file size $i]]
lappend files [list [file extension $i] \
[format %-14s $i] - $size B\
[dateTime [file mtime $i]]]
}
foreach i [lsort $mode $g(dir) -index $index $files] {
set t [join [lrange $i 1 end]]
$g(lb) insert end [incr n]\
-image $g([fileimage [lindex $i 0]]) \
-text [string map {" - " \t} $t]
}
.n raise 2
$g(lb) bindImage <1> [list after 9 selectFile $g(lb)]
$g(lb) bindText <ButtonRelease-1> [list after 9 markFile $g(lb)]
$g(lb) bindText <Double-1> [list after 9 selectFile $g(lb)]
set g(filterCmd) selectDir
}
proc fileimage f {
switch -- [file extension $f] {
.gif - .ppm - .xbm {return palette}
default {return file}
}
}When a file is tapped on, a displayer is selected depending on directory attribute or extension:
proc selectFile {w item} {
global g
set fn [$w itemcget $item -text]
regexp {(.+?) *\t} $fn -> fn
if [file isdir $fn] {
set g(filter) *
selectDir $g(tree) [file join [pwd] $fn]
return
}
$g(text) delete 1.0 end
switch -- [file extension $fn] {
.txt - .tcl - .cfg - .htm {set t [readFile $fn]}
.gif - .ppm {
set t [render $fn $g(text) photo]
}
.xbm {
set t [render $fn $g(text) bitmap]
}
default {set t [$g(unk) $fn]}
}
if {$g(enc) != [encoding system]} {
$g(text) config -font $g(ufont) \
-height 14 -width 30
} else {
$g(text) config -font $g(font) \
-height 21 -width 43
}
$g(text) insert end $t
focus $g(text)
wm title . [set g(3) $fn]
.n raise 3
}
proc hexdump fn {
set res ""
set fp [open $fn]
fconfigure $fp -translation binary
for {set i 0} {$i<64} {incr i} {
set s [read $fp 16]
if {$s==""} break
binary scan $s H* hex
regsub -all (..) $hex {\1 } hex
regsub -all {[^ -~]} $s . asc
set hexpos [format %.3X0 $i]
append res $hex \t\
[format %-16s $asc] \t\
$hexpos \n
}
close $fp
set res
}
proc copyFile fn {
if {$fn==""} return
set n [llength [glob -noc "Copy*$fn"]]
set no [expr {$n? " [incr n]": ""}]
file copy $fn "Copy$no of $fn"
selectDir - .
}
proc deleteFile fn {
if {$fn==""} return
set msg "OK to delete file\n[infoFile $fn 1]?"
set answer [tk_messageBox -type yesno -default no -icon question -message $msg]
if {$answer} {
file delete -force $fn
selectDir - .
}
}
proc markFile {w item} {
global g
set fn [$w itemcget $item -text]
regexp {(.+?) *\t} $fn -> fn
if ![file exists $fn] return
set g(marked) $fn
$g(props) delete 1.2 end ;# keep icon
$g(props) insert end [infoFile $fn]
}
proc readFile fn {
set fp [open $fn]
set t [read $fp 2]
if {$t=="\xff\xfe"} {
set ::g(enc) unicode
} else {seek $fp 0}
fconfigure $fp -encoding $::g(enc)
set res [read $fp]
close $fp
set res
}
proc newFolder w {
file mkdir "New Folder"
selectDir - .
}
proc renameFile w {
set item [$w selection get]
set fn [$w itemcget $item -text]
regexp {(.+?) *\t} $fn -> fn
set fn2 [$w edit $item $fn newname]
if {$fn2!=""} {
file rename $fn $fn2
selectDir - .
}
}
proc newname fn {expr ![file exists $n]}
proc listProcs {w {filt ""}} {
global g
if {$filt !=""} {set g(filter) $filt}
$w delete [$w items]
set n -1
foreach i [lsort [info procs $g(filter)]] {
$w insert end [incr n] -text $i
}
$w bindText <ButtonRelease-1> [list after 9 selectProc $w]
set g(2) "iFile: procs"
.n raise 2
set g(filterCmd) listProcs
}
proc selectProc {w item} {
global g
set t [$w itemcget $item -text]
$g(text) delete 1.0 end
$g(text) insert end [showProc $t]
set g(3) "iFile: proc $t"
.n raise 3
}
proc showProc name {
set args {}
foreach arg [info args $name] {
if [info default $name $arg t] {
lappend arg $t
}
lappend args $arg
}
set body [expr {[info exists ::auto_index($name)]?
"\n# $::auto_index($name)\n"
: ""}]
append body [info body $name]
list proc $name $args $body
}
proc render {fn w type} {
global g
catch {image delete $g(i)}
set i [image create $type -file $fn]
$w image create end -image $i
set g(i) $i
return [image width $i]x[image height $i]
}
proc infoFile {fn {brief 0}} {
set res $fn\n\n
append res "Folder:\t[pwd]\n"
append res "Size:\t"
append res "[file size $fn] Bytes\n"
foreach i {atime mtime} {
append res \
"$i:\t[dateTime [file $i $fn]]\n"
}
if {!$brief} {
foreach {key val} [file attr $fn] {
set k [format %-12s $key:]
append res \n$k\t$val
}
}
set res
}
proc dateTime t {
clock format $t \
-format %y-%m-%d,%H:%M:%S
}
#------------------------- Image scaling
proc scaleImage {im xfactor {yfactor 0}} {
set mode -subsample
if {abs($xfactor) < 1} {
set xfactor [expr round(1./$xfactor)]
} elseif {$xfactor>=0 && $yfactor>=0} {
set mode -zoom
}
if {$yfactor == 0} {set yfactor $xfactor}
set t [image create photo]
$t copy $im
$im blank
$im copy $t -shrink $mode $xfactor $yfactor
image delete $t
}
#------ borrow images from BWidget:
set g(images) {folder info palette}
foreach i $g(images) {
set g($i) [image create photo -file $BWIDGET::LIBRARY/images/$i.gif]
}
set g(file) [image create photo -data {
R0lGODlhEAAQAIUAAPwCBFxaXNze3Ly2rJSWjPz+/Ozq7GxqbJyanPT29HRy
dMzOzDQyNIyKjERCROTi3Pz69PTy7Pzy7PTu5Ozm3LyqlJyWlJSSjJSOhOzi
1LyulPz27PTq3PTm1OzezLyqjIyKhJSKfOzaxPz29OzizLyidIyGdIyCdOTO
pLymhOzavOTStMTCtMS+rMS6pMSynMSulLyedAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAACH5BAEAAAAALAAAAAAQABAAAAaQ
QIAQECgajcNkQMBkDgKEQFK4LFgLhkMBIVUKroWEYlEgMLxbBKLQUBwc52Hg
AQ4LBo049atWQyIPA3pEdFcQEhMUFYNVagQWFxgZGoxfYRsTHB0eH5UJCJAY
ICEinUoPIxIcHCQkIiIllQYEGCEhJicoKYwPmiQeKisrKLFKLCwtLi8wHyUl
MYwM0tPUDH5BACH+aENyZWF0ZWQgYnkgQk1QVG9HSUYgUHJvIHZlcnNpb24g
Mi41DQqpIERldmVsQ29yIDE5OTcsMTk5OC4gQWxsIHJpZ2h0cyByZXNlcnZl
ZC4NCmh0dHA6Ly93d3cuZGV2ZWxjb3IuY29tADs=}]
#-------- The notebook and its pages:
NoteBook .n -internalborderwidth 0
pack .n
set 1 [.n insert end 1 -text Tree -raisecmd {wm title . iFile}]
set 2 [.n insert end 2 -text Files -raisecmd {wm title . $g(2)}]
set 3 [.n insert end 3 -text File -raisecmd {wm title . $g(3)}]
set g(3) "iFile - No file selected"
set 4 [.n insert end 4 -text Props -raisecmd {wm title . "iFile properties"}]
set 5 [.n insert end 5 -text % -raisecmd {
wm title . "iFile console"
focus $g(ce)
}]
set 6 [.n insert end 6 -text Setup -raisecmd {wm title . "iFile setup"}]
#-----------------------------Tree page
set g(tree) [Tree $1.t -width 27 -height 19 \
-deltax 16 -deltay 13 \
-yscrollcommand "$1.y set" \
-opencmd [list openDir $1.t]]
scrollbar $1.y -command "$1.t yview"
grid $1.t $1.y -sticky ns
$1.t bindImage <1> [list + after 9 selectDir $1.t]
$1.t bindText <1> [list + after 9 selectDir $1.t]
#----------------------------- Files page
frame $2.f
label $2.f.0 -text "Filter: "
entry $2.f.e -textvar g(filter) -width 5
bind $2.f.e <Return> {$g(filterCmd) $g(lb) .}
set g(filter) *
button $2.f.c -text * -command {set g(filter) *}
button $2.f.up -text Up -command {
if {[pwd]!="\\"} {
set g(filter) *
selectDir $g(tree) ..
}}
set g(ab) [ArrowButton $2.f.ab -fg blue -activeforeground blue \
-command toggleOrder -relief flat]
label $2.f.1 -text "Sort by: "
ComboBox $2.f.cb -width 5 -editable 0 -textvariable g(sortby) -values {Name Type Size Date}
set g(dir) -incr
proc toggleOrder {} {
global g
switch -- [$g(ab) cget -dir] {
top {set g(dir) -decr; set t bottom}
bottom {set g(dir) -incr; set t top}
}
$g(ab) configure -dir $t
after 50 {selectDir - .}
}
eval pack [winfo children $2.f] -side left
grid $2.f - -sticky news
set g(lb) [ListBox $2.l -bg white -height 15 -padx 18 \
-width 27 -yscrollcommand "$2.y set" -selectmode single]
scrollbar $2.y -command "$2.l yview"
grid $2.l $2.y -sticky ns
#------------------------------- File page
grid [ScrolledWindow $3.sw -auto both] -sticky news
set g(text) [text $3.sw.t -wrap word -height 21 -width 43]
$3.sw setwidget $3.sw.t
proc saveText {w {name ""}} {
if {$name==""} {set name [tk_getSaveFile]}
if {$name!=""} {
set fp [open $name w]
fconfigure $fp -encoding $::g(enc)
if {$::g(enc)=="unicode"} {puts -nonewline $fp \ufeff}
puts $fp [$w get 1.0 end-1c]
close $fp
selectDir - .
}
}
#--------------------- Prop(ertie)s page
set g(props) [text $4.t -bg [.n cget -bg] \
-height 20 -width 45 -relief flat]
grid $4.t -sticky news
$4.t image create 1.0 -image $g(info)
$4.t insert end $g(about)
#-------------------- % (Console) page
set g(ce) [ComboBox $5.e -textvariable g(cmd)]
set g(chist) {{}}
$5.e bind <Return> "ceval $5.t"
set g(ct) [text $5.t -height 14 -width 43 -yscrollcommand "$5.y set"]
foreach c {red blue black} {
$5.t tag config $c -foreground $c
}
redef_puts $g(ct)
scrollbar $5.y -command "$5.t yview"
label $5.l -text "\n\nIntentionally\nleft\nblank\n\n"
grid $5.e - -sticky ew
grid $5.t $5.y -sticky ns
grid $5.l
proc ceval {text} {
global g
set cmd $g(cmd)
$text insert end $cmd\n blue
if [catch {uplevel #0 $cmd} res] {
set tag red
} else {
set tag black
if {[lsearch -exact $g(chist) $cmd]<0} {
set g(chist) [lrange \
[linsert $g(chist) 1 $cmd] 0 511]
$g(ce) configure -values $g(chist)
set g(cmd) ""
}
}
set dir [file tail [pwd]]
if {$res!=""} {$text insert end $res\n $tag}
$text insert end "($dir) % " blue
$text see end
}
#---------------------------- Setup page
label $6.info -image $g(info)
message $6.00 -text $g(about) -aspect 1000
grid $6.info $6.00 - -sticky nw
label $6.0 -text Encoding
ComboBox $6.enc -text Encoding \
-textvariable g(enc) \
-values [lsort -dic [encoding names]] -editable 0
set g(enc) [encoding system]
button $6.c -text system -command {
set g(enc) [encoding system]
}
grid $6.0 $6.enc $6.c -sticky news
label $6.1 -text "ASCII font"
entry $6.af -textvariable g(font)
grid $6.1 $6.af -sticky ew
label $6.2 -text "Unicode font"
entry $6.uf -textvariable g(ufont)
grid $6.2 $6.uf -sticky ew
label $6.3 -text Unknown?
ComboBox $6.uk -values {
readFile hexdump
} -textvariable g(unk) -editable 0
set g(unk) hexdump
grid $6.3 $6.uk -sticky ew
trace variable g(sortby) w "selectDir $1.t .;#"
label $6.4 -text File/wrap
checkbutton $6.wr -onvalue word \
-offvalue none -command {
$g(text) config -wrap $g(wrap)
after 10 .n raise 3
} -variable g(wrap)
set g(wrap) word
grid $6.4 $6.wr -sticky w
#---- place-holder to push others up:
grid [label $6.end -text \n\n\n\n]
#------------------------------------Menu
proc m+ {menu label cmd} {
.m.$menu add command -label $label -command $cmd
}
proc m++ {menu label} {
.m add casc -label $label -menu \
[menu .m.$menu -tearoff 0]
}
. config -menu [menu .m]
m++ file File
m+ file Hexdump {
$g(text) delete 1.0 end
$g(text) insert end [hexdump $g(marked)]
.n raise 3
}
m+ file "New Folder" {newFolder $g(lb)}
m+ file Rename {renameFile $g(lb)}
m+ file Run {exec wish $g(marked) &}
m+ file Copy {copyFile $g(marked)}
m+ file Delete {deleteFile $g(marked)}
.m.file add separator
m+ file Restart {exec wish $argv0 &; exit}
m+ file Exit exit
m++ image Image
foreach i {3 2 0.5 0.33} {
m+ image "Zoom x $i" "scaleImage \$g(i) $i"
}
.m.image add separator
m+ image "Flip LR" {scaleImage $g(i) -1 1}
m+ image "Flip TB" {scaleImage $g(i) 1 -1}
m+ image "Flip both" {scaleImage $g(i) -1 -1}
m++ text Text
m+ text "Save as..." {saveText $g(text)}
m+ text Clear {$g(text) delete 1.0 end}
m+ text Eval {
set g(cmd) [$g(text) get 1.0 end-1c]
ceval $g(ct)
.n raise 5
}
m++ sel Select
m+ sel Color {append $g(cmd) " " [SelectColor .c]}
m+ sel Font {append $g(cmd) " {[SelectFont .f]}"}
m+ sel Proc {listProcs $g(lb) *}
#----------- Final steps to get started:
selectDir - /
drawTree $1.t
.n raise 1
wm geometry . +0+1
update
# 8.4a2 workaround: transparency
lappend g(images) file
foreach i $g(images) {
$g(text) image create end -image $g($i)
scaleImage $g($i) 2
scaleImage $g($i) 0.5
}