iFile: a little file system browser
if 0 {
Richard Suchenwirth 2003-02-22 - Another weekend fun project on the iPAQ, but with changes in geometry (and maybe added drive letters ;-), it should be usable on more platforms: a partial reinterpretation of a File Explorer, using BWidget capabilities. In contrast to the CE file explorer, it shows extensions and detailed file sizes and dates, and "hidden files". Here I encountered another problem of the 8.4a2 Windows/CE port: transparency in GIF images seems not to be supported, and the file icon comes distorted. Other GIF images are finely rendered, and weekday Dilberts fit perfectly to the small screen ;-)
Another idea in the back of my head was to experiment how to do Literate programming in a Wiki, with generous explanations and screenshots placed next to the respective source, to make it easier understood.
Because of the smallness of the iPAQ screen, I chose a notebook as toplevel widget. On the "Tree" page you can navigate the directory tree. Clicking on a directory brings up the "Files" page and shows its contents, first subdirectories, then files. Clicking on a file displays its contents as text or image or hex dump on the "File" page, and file attributes on the "Props" page.
With these few KB of Tcl code up and running, suddenly little iPAQ feels less like a toy, more like a real machine... This is certainly not a "killer app", but it well thrilled me to enjoy the power of Tcl/Tk/BWidget on the palm of my hand.
}
package require BWidget
set g(font) {Tahoma 7}
option add *Font $g(font)
set g(ufont) {{Bitstream Cyberbit} 10}if 0 {
This plants the root of the tree, and the first layer of "children". Others will be opened later when demanded, to save start-up time.
}
proc drawTree {w} {
$w insert end root _ -text /
-drawcross allways -image $::g(folder)
openDir $w _
$w itemconfigure _ -open 1
}if 0 {
The -drawcross attributes tells us if a node has been opened before: then it is set to auto, else allways (bad English, but required in BWidget). Child directories with no subdirectories get the never attribute, so a fake cross box is not displayed.
}
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 -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
}
}
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 //
}if 0 {
When a directory is selected, its contents (subdirectories, then files, both in alphabetic order) are shown in a BWidget ListBox which allows icons for items. Some brief size and date information is added, but not formatted into columns:
}
proc selectDir {w dir} {
global g
if ![file exists $dir] {
set dir [getPath $w $dir]
}
cd $dir
wm title . [pwd]
set g(2) [pwd]
$g(lb) delete [$g(lb) items]
set n -1
foreach i [lsort -dic [glob -noc -type d *]] {
set t [list $i -]
lappend t [llength [glob -noc $i/*]] file(s)
$g(lb) insert end [incr n]
-image $g(folder) -text $t
}
foreach i [lsort -dic [glob -noc -type f *]] {
set text [list $i - [file size $i] B]
lappend text [dateTime [file mtime $i]]
$g(lb) insert end [incr n]
-image $g(file) -text $text
}
.n raise 2
}if 0 {
When a file is tapped on, a displayer is selected depending on directory attribute or extension. Directories are sent to the "Files" page; other files use the text widget on the "File" page to display text (plainly in system encoding, Unicode or other outlandish encodings, hex dump) or image.
}
proc selectFile {w item} {
global g
set fn [$w itemcget $item -text]
set fn [lindex $fn 0]
if [file isdir $fn] {
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
wm title . [set g(3) $fn]
$g(props) delete 1.2 end
$g(props) insert end [infoFile $fn]
.n raise 3
}if 0 {
Files of unknown type can always be inspected in a hex dump (note that the hex and the ASCII part come on separate lines, again because of screen space limitations):
}
proc hexdump fn {
set res ""
set fp [open $fn]
fconfigure $fp -translation binary
for {set i 0} {$i<32} {incr i} {
set s [read $fp 16]
binary scan $s H* hex
regsub -all {..(?=.)} $hex {& } hex
regsub -all {[^ -~]} $s . asc
append res $hex\n$asc\n
}
close $fp
set res
}if 0 {
This tiny text file reader honors the configured encoding, but overrides it if it detects the Unicode-specific byte order mark (here Windows-typical little-endian, "ÿþ" or \xff\xfe) at beginning of file. This is necessary because the font used for display depends on the configured encoding (auto-font finding is sorrily not implemented in the CE port). Make sure to reset it on the Setup page for later non-Unicode files:
}
proc readFile fn {
set fp [open $fn]
fconfigure $fp -encoding binary
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
}if 0 {
These few lines make a bitmap or photo image viewer, by inserting it into the given text widget:
}
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]
}if 0 {
This produces a descriptive string for a file, to be displayed on the Props page:
}
proc infoFile fn {
set res $fn
- append res "Directory
- pwd
"
- append res "Size
- "
append res "[file size $fn] Bytes
"
foreach i {atime mtime} {
append res - "$i
- [dateTime [file $i $fn]
"
}
foreach {key value} [file attr $fn] {
set k [format %-12s $key:]
append res $k $value
}
set res
}
proc dateTime t {
clock format $t
-format %y-%m-%d,%H:%M:%S
}
#------ borrow images from BWidget:
foreach i {folder file info} {
set g($i) [image create photo -file $BWIDGET::LIBRARY/images/$i.gif]
}#-------- 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 . $g(3)}]
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
#drawTree $1.t
$1.t bindImage <1> [list + after 9 selectDir $1.t]
$1.t bindText <1> [list + after 9 selectDir $1.t]
#----------------------------- Files page
set g(lb) [ListBox $2.l -bg white -height 16
-width 27 -yscrollcommand "$2.y set"]
scrollbar $2.y -command "$2.l yview"
grid $2.l $2.y -sticky ns
$2.l bindImage <1> [list + after 9 selectFile $2.l]
$2.l bindText <1> [list + after 9 selectFile $2.l]#------------------------------- File page
set g(text) [text $3.t -wrap word
-height 21 -width 43
-xscrollcommand "$3.x set"
-yscrollcommand "$3.y set"]
scrollbar $3.x -ori hori -command "$3.t xview"
scrollbar $3.y -command "$3.t yview"
grid $3.t $3.y -sticky ns
grid $3.x -sticky ew#--------------------- 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 " iFile - a little file system explorer
Richard Suchenwirth, Konstanz 2003
Tcl/Tk: [info patchlevel]
BWidget: [package provide BWidget]"if 0 {
The next few lines create a tiny console - far less powerful than Tkcon, but useful for interactive tests, and debugging iFile itself. Also, for now this is the only place in iFile where you can delete, rename or move files, create directories, etc., because here you can do anything Tcl allows.
}
set g(ce) [entry $5.e -textvar g(cmd)]
bind $5.e <Return> "ceval $5.e $5.t"
bind $5.e <Up> {set g(cmd) $g(last)}
set g(last) ""
bind $5.e <Down> cClear
set g(ct) [text $5.t -height 14 -width 42 -yscrollcommand "$5.y set"]
foreach c {red blue black} {
$5.t tag config $c -foreground $c
}
scrollbar $5.y -command "$5.t yview"
label $5.l -text "Intentionally left blank "
grid $5.e - -sticky ew
grid $5.t $5.y -sticky ns
grid $5.l
proc ceval {entry text} {
global g
set cmd $g(cmd)
if [catch {uplevel #0 $cmd} res] {
set tag red
} else {
set tag black
cClear
}
set dir [file tail [pwd]]
$text insert end $cmd
blue
$res $tag "($dir) % " blue
$text see end
}
proc cClear {} {
global g
if {$g(cmd)!=""} {
set g(last) $g(cmd)
set g(cmd) ""
}
}if 0 {
The last page (for now) contains user-settable parameters: which encoding for text files, which fonts, and how to treat files with unknown extension (readFile or hexdump). Font selection is a bit too simple, but font families doesn't work right on the iPaq - but see Font families workaround.
}
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 ns
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
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
]
#----------- Final steps to get started:
drawTree $1.t
selectDir - /
.n raise 1
wm geometry . +0+1
# Rapid development aid:
bind . <Left> "
exec wish [list [info script]] &; exit"if 0 {
MPJ ~ Very nice little app for the PocketPc. It needs a way to exit it that does not involve a <Left> binding for my Jornada. So using the Menu bar (located in the lower left corner) we can add a File->Exit menu item. (RS provided the brevity):
}
. config -menu [menu .m] .m add casc -label File -menu [menu .m.file] .m.file add command -label Exit -command exit
if {0} {
RS: Thanks Michael! You brought me back on the track of using the menu, which costs no extra screen estate - see the code at Image scaling which just plugs in here, or my most recent additions, which give powerful possibilites in minimal code:
- Text/Clear clears the text widget of the File page (obviously)
- Text/Eval sends the contents of it through guarded eval - see results on "%"
}
.m add casc -label Text -menu [menu .m.text -tearoff 0]
.m.text add comm -label Clear -command {$g(text) delete 1.0 end}
.m.text add comm -label Eval -command {
set g(cmd) [$g(text) get 1.0 end-1c]
ceval $g(ct)
}if 0 {
...and more goodies coming up: A handful LOC more allows to save the content of the text window in the configured encoding, with again special care being taken of Unicode:
}
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 Feff}
puts $fp [$w get 1.0 end-1c]
close $fp
}
}
.m.text add comm -label "Save as..." -command {saveText $g(text)}if 0 {
See iFile 1.0 - iFile 1.1 for enhanced versions.
}