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.
}
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 {}
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 {}
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 {}
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 {}
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" }
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 {}
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 {}
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 exitif {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.
}
