- "New" (blank paper): clear text
- "Open" (open folder): brings up Files page, to select another file
- "Save" (diskette): does "Save as", with filename and extension defaulted
- Position: when tapping in the text, shows line.column of insert cursor (a rare luxury in M$ editors..) This is a camouflaged entry widget - select it, type a line number and <Return> to go to that line
- Find button and entry: Type search term into entry, tap <Return> or the Find button. Found strings are highlighted in yellow (which comes out orange on iPAQ). The search wraps from end to 1.0 again. If the string is not found at all, "no find" is reported in the Position field.
#Title: iFile - a little file system browser set version 1.1 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 wantUnicode 1 ;# 0 if not set tcl_interactive 1 set dir [file dir [info script]] proc source? name {if [file exists $name] {source $name}} 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 *Button*padX 0 option add *padY 0 set g(sortby) Name#---- Directory tree routines
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] { if [file att [string trim [lindex $i 1]] -hidden] { set fill blue} else {set fill black} set t [join [lrange $i 1 end]] $g(lb) insert end [incr n]\ -image $g([fileimage [lindex $i 0]]) \ -text [string map {" - " \t} $t] -fill $fill } .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} } }if 0 {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] { 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 20 -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 ::g(3) $fn set res }#--- File processing routines
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 $fn]}#--- Procedure introspection
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 }#--- Image viewer
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 new openfold save} 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 Info -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"}] if $wantUnicode { set 7 [.n insert end 7 -text U+ -raisecmd {focus $g(uc)}] }#-----------------------------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]!="\\"} { 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} -borderwidth 0 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 [frame $3.f -border 0] -sticky ew button $3.f.new -image $g(new) -command {$g(text) delete 1.0 end} button $3.f.open -image $g(openfold) -command {selectDir . .} button $3.f.save -image $g(save) -command {saveText $g(text)} entry $3.f.pos -width 7 -textvar g(textpos) \ -borderw 0 -bg [$3.f cget -bg] \ -just center bind $3.f.pos <Return> { $g(text) mark set insert [expr double($g(textpos))] $g(text) see insert focus $g(text) } button $3.f.bf -text Find -command findText entry $3.f.find -textvar g(find) bind $3.f.find <Return> findText eval pack [winfo children $3.f] -side left -fill y grid [ScrolledWindow $3.sw -auto both] -sticky news set g(text) [text $3.sw.t -wrap word -height 18 -width 43] $3.sw setwidget $3.sw.t $g(text) tag config hilite -background yellow bind $g(text) <ButtonRelease-1> {+ set g(textpos) [$g(text) index insert] } set g(textpos) 1.0 proc findText {} { global g set w $g(text) $w tag remove hilite 1.0 end set from [eval $w search $g(findopt) -count len -- [list $g(find) "insert + 1 c"]] if {$from!=""} { set g(textpos) $from $w mark set insert $from $w see insert $w tag add hilite insert "insert + $len c" } else {set g(textpos) "no find"} } proc saveText {w {name ""}} { global g if {$name==""} { set ext [file extension $g(3)] set name [tk_getSaveFile -initialfile $g(3) \ -filetypes [list "{$ext file} $ext" {All *.*}]] } 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 - . } }#------------------- (Propert)i(es) 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) ;# see [puts workaround] 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 } ceval $g(ct)#---------------------------- 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.35 -text File/find ComboBox $6.fs -values { -exact {-exact -nocase} -regexp {-regexp -nocase} } -textvariable g(findopt) -editable 0 set g(findopt) -exact grid $6.35 $6.fs -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]#-------------------------- Unicode page
if $wantUnicode { proc upages {} { for {set i 0} {$i<256} {incr i} {set a($i) ""} array set a {0 iso8859-1 1 "Extended Latin" 3 Greek 4 Cyrillic 5 Hebrew 6 Arabic 14 Thai 30 Vietnamese 32 Currency 33 Symbols,arrows 34 Math 36 "Circled char.s" 37 "Block graphics" 38 Dingbats 48 Hiragana,Katakana 49 Bopomofo,Jamo 50 "Circled symbols" 51 Units 52 "1.0 Hangul..." 61 "...1.0 Hangul" 78 "CJK ideographs..." 159 ...CJK 172 Hangul... 248 ...Hangul 249 Hanja 251 "Hebrew dotted" 252 "Arab ligatures" 254 "Arab glyphs" 255 Double-width } set res "" for {set i 0} {$i<256} {incr i} { lappend res [format "%.2X %s" $i $a($i)] } set res } set g(upages) [upages] set g(ul) [ComboBox $7.l -textvariable g(up) -values $g(upages) -editable 0] trace var g(up) w {selectUnicode $g(up) ;#} set g(upage) 0 label $7.0 entry $7.e -textvar g(uselect) -font $g(ufont) -width 12 set g(uc) [canvas $7.c -bg yellow \ -width 230 -height 230 \ -borderwidth 0 -highlightth 1 -takefocus 1] grid $g(ul) $7.0 $7.e grid $g(uc) - - -sticky news $g(uc) create text 110 100 -text " This page will display a Unicode page Select a page (00..FF) in combobox. Browse neighboring pages with Up/Down. Tapping on a character zooms it. Tapping on a zoomed character appends it to the selection, so you can build up a Unicode string and later paste it. " bind $g(uc) <Down> { incr g(upage); selectUnicode} bind $g(uc) <Up> { incr g(upage) -1; selectUnicode} proc selectUnicode {{page -1}} { global g if {$page==-1} { set page $g(upage) set g(up) [lindex $g(upages) $page] } else { set page [lsearch $g(upages) $page] set g(upage) $page } set f $g(ufont) set c $g(uc) set y 6 set 0_15 {0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15} $c delete all foreach row $0_15 { set x 10 $c create text $x $y -text [format %.1X0 $row] -tag x -fill blue -font $g(font) foreach col $0_15 { incr x 13 set d [expr {$page*256+$row*16+$col}] $c create text $x $y -text [format %c $d] -font $f\ -tag c } set x 10; incr y 14 } .n raise 7 wm title . "iFile: U+[format %.2X.. $page]" $c bind c <1> "zoomChar $c" $c bind x <1> "$c delete zoom" focus $c } proc zoomChar w { set it [$w find withtag current] $w delete zoom set pos [lrange [$w bbox $it] 0 1] set c [$w itemcget $it -text] set font [list [lindex $::g(ufont) 0] 30] $w create text $pos -text $c\ -font $font -tags {zoom z} set pos2 [lrange [$w bbox z] 0 1] $w create text $pos2 -anchor nw -text \ [format %5.4X [scan $c %c]] \ -tag {zoom z} -font $::g(font) -fill blue set bbox [$w bbox zoom] $w create rect $bbox -fill white \ -outline white -tag zoom $w raise z foreach {x y} $bbox break if {$x<0} {$w move zoom [expr {-$x}] 0} if {$y<0} {$w move zoom 0 [expr {-$y}]} $w bind zoom <1> [list append g(uselect) $c] } }#------------------------------------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++ edit Edit foreach i {Cut Copy Paste} { m+ edit $i "event generate \[focus] <<$i>>" } m+ edit "Select all" { [focus] tag add sel 1.0 end event generate [focus] <<Copy>> } 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+ text Undo {$g(text) edit undo} #m+ text Redo {$g(text) edit redo} 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) *} if $wantUnicode { m+ sel "Unicode page" {listUnicode $g(lb)} } #----------- Final steps to get started: wm geometry . +0+1 .n raise 4 ;# Props page at startup update drawTree $1.t selectDir - / .n raise 1# 8.4a2 workaround: transparency
lappend g(images) file text .dummy foreach i $g(images) { .dummy image create end -image $g($i) scaleImage $g($i) 2 scaleImage $g($i) 0.5 }if 0 {# suggest maximising some of the elements CMCc:
grid columnconfigure $1 0 -weight 1 grid rowconfigure $1 0 -weight 1 grid columnconfigure $2 0 -weight 1 grid rowconfigure $2 1 -weight 1# RS: For bigger screens, yes; on a 240x320 screen, I think it's not necessary.
2004-03-25: added "set tcl_interactive 1" for abbreviation convenience - RS
2004-7-31: There was a typo on proc newname
proc newname fn {expr ![file exists $n]}it should read:
proc newname fn {expr ![file exists $fn]}I already edited it in the main code.is there a way to modify file extensions using the iPAQ windows explorer itself? JM - RS No, not that I'm aware of... but in iFile or tkCon you can always call Tcl's file rename ... :)
See also Command completion in the iFile console. Sepp is the successor to iFile, at least for RS.
[ Category Application | PocketPC | Arts and crafts of Tcl-Tk programming | Category File ] }