Version 15 of iFile: a little file system browser
Updated 2003-02-24 17:52:50if 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}
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 -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 {\1 } hex
regsub -all {[^ -~]} $s . asc
append res [format "%48s\n%s\n" $hex $asc]
}
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, \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]
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\n\n
append res "Directory:\t[pwd]\n"
append res "Size:\t\t"
append res "[file size $fn] Bytes\n"
foreach i {atime mtime} {
append res \
"$i:\t\t[dateTime [file $i $fn]]\n"
}
foreach {key value} [file attr $fn] {
set k [format %-12s $key:]
append res $k\t$value\n
}
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 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 "\n\nIntentionally\nleft\nblank\n"
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\n blue \
$res $tag "\n($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.}
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 \n\n\n\n\n\n]
#----------- 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.