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. [http://mini.net/files/ifile1.jpg] 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 { [http://mini.net/files/ifile2.jpg] 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 { [http://mini.net/files/ifile7.jpg] 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 { [http://mini.net/files/ifile6.jpg] 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 { [http://mini.net/files/ifile3.jpg] 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: [http://mini.net/files/Ifile5.jpg] } 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 { [http://mini.net/files/ifile4.jpg] 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 "ceval $5.e $5.t" bind $5.e {set g(cmd) $g(last)} set g(last) "" bind $5.e 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 { [http://mini.net/files/ifile9.jpg] 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 \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 . " 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 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 \ufeff} puts $fp [$w get 1.0 end-1c] close $fp } } .m.text add comm -label "Save as..." -command {saveText $g(text)} if 0 { ---- [Arts and crafts of Tcl-Tk programming] }