if 0 {[Richard Suchenwirth] 2003-03-03 - Here is an enhanced development snapshot of [iFile: a little file system browser] - see that page for detailed explanations - I stripped lengthy comments from the source for faster editing. Many new features, the biggest chunk being proc introspection. No warranties, but enjoy! In place of the files font_ce.txt (see [Font families workaround]) and puts_ce.txt (see [puts workaround]) sourced below, one might of course just include them here: } if ![llength [info command ::tk::font]] { rename font ::tk::font proc font {cmd args} { switch -- $cmd { f - fa - fam - families { list Bookdings {Courier New}\ Frutiger Tahoma\ {Bitstream Cyberbit}\ {MS Gothic} Sorawin } default { eval ::tk::font $cmd $args } } } } proc redef_puts w { set ::putsw $w if ![llength [info command ::tcl::puts]] { rename puts ::tcl::puts proc puts args { set la [llength $args] if {$la<1 || $la>3} { error "usage: puts ?-nonewline? ?channel? string" } set nl \n if {[lindex $args 0]=="-nonewline"} { set nl "" set args [lrange $args 1 end] } if {[llength $args]==1} { set args [list stdout $args] } foreach {channel s} $args break set s [join $s] ;# (1) prevent braces at leading/tailing spaces if {$channel=="stdout" || $channel=="stderr"} { $::putsw insert end $s$nl } else { set cmd ::tcl::puts if {$nl==""} {lappend cmd -nonewline} lappend cmd $channel $s eval $cmd } } } } #Title: iFile - a little file system browser set version 1.0 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 dir [file dir [info script]] #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 *padY 0 set g(sortedby) [set g(sortby) Name] 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] { set t [join [lrange $i 1 end]] $g(lb) insert end [incr n]\ -image $g([fileimage [lindex $i 0]]) \ -text [string map {" - " \t} $t] } .n raise 2 $g(lb) bindImage <1> [list after 9 selectFile $g(lb)] $g(lb) bindText [list after 9 markFile $g(lb)] $g(lb) bindText [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] { set g(filter) * 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 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 res } 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 $n]} 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 [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 } 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} 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 Props -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"}] #-----------------------------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 {$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]!="\\"} { set g(filter) * 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} 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 [ScrolledWindow $3.sw -auto both] -sticky news set g(text) [text $3.sw.t -wrap word -height 21 -width 43] $3.sw setwidget $3.sw.t 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 selectDir - . } } #--------------------- 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 $g(about) #-------------------- % (Console) page set g(ce) [ComboBox $5.e -textvariable g(cmd)] set g(chist) {{}} $5.e bind "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) 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 } #---------------------------- 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.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] #------------------------------------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++ 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++ sel Select m+ sel Color {append $g(cmd) " " [SelectColor .c]} m+ sel Font {append $g(cmd) " {[SelectFont .f]}"} m+ sel Proc {listProcs $g(lb) *} #----------- Final steps to get started: selectDir - / drawTree $1.t .n raise 1 wm geometry . +0+1 update # 8.4a2 workaround: transparency lappend g(images) file foreach i $g(images) { $g(text) image create end -image $g($i) scaleImage $g($i) 2 scaleImage $g($i) 0.5 }