############################################################################### # TkMC clone of MC file manager. # Tested on MS Windows OS, it should be work on any Unix systems # Author: Grigoriy Abramov # Date: January, 2002 # comments,questions, bug reports send to: # [email protected] # Packages: # Entry with History and File Properties dialog by Richard Suchenwirth # Multiple scrollbars by Jeffrey Hobbs # # TkMC - MC like file manager with basic functionality. # # With TkMC you can browse,view, edit and run TCL application. # # DISCLAIMER and License Issues # # TkMC - is copyrighted by Grigoriy Abramov # # This program is free software; you can redistribute it and/or modify it # without restriction. # This program is distributed in the hope that it will be useful, # but WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. # # ################################################################################ package require Tk global tcl_platform if {$tcl_platform(platform) == "windows"} { package require registry package require opt } else { package require opt } wm resizable . 0 0 wm title . "TkMC v1.0" ###################################### #Disable default Error messages proc bgerror {errmsg} { global errorInfo errorCode set msg [format "Error: %s." $errmsg $errorCode] tk_messageBox -parent . -title "Error" -type ok -icon error -message $msg } ######################### #Proc centering windows proc center_win {w} { set x [expr [winfo rootx .]+250] set y [expr [winfo rooty .]+150] wm geometry $w "+$x+$y" } ############################### #Proc entry history namespace eval history { proc add? {w} { variable $w variable n$w upvar 0 $w hist set s [set ::[$w cget -textvariable]] if {$s == ""} return if [string compare $s [lindex $hist end]] { lappend hist $s set n$w [llength $hist] } } proc move {w where} { variable $w variable n$w upvar 0 $w hist incr n$w $where if {[set n$w]<0} {set n$w 0} if {[set n$w]>=[llength $hist]+1} { set n$w [llength $hist] } set ::[$w cget -textvar] [lindex $hist [set n$w]] } proc for {type name args} { switch -- $type { entry { uplevel $type $name $args bind $name <Up> {history::move %W -1} bind $name <Down> {history::move %W 1} bind $name <Next> {history::move %W 99999} bind $name <Return> {history::add? %W} variable $name {} variable n$name 0 } default {error "usage: history::for entry <w> <args>"} } } } ############################## frame .top frame .top.f -relief groove -bd 2 pack .top.f -fill x -expand true -side left foreach x [file volume] { button .top.f.f$x -text [file native $x] -font {arial 8 {bold} } -relief groove -command "" pack .top.f.f$x -side left .top.f.f$x config -command "cd $x ; read_dir_l ; refresh_left" } ########################################### #Frame and entry areas for directory names frame .top2 entry .top2.e_l -relief groove -bg grey80 -cursor arrow -font {arial 8 {bold}} entry .top2.e_r -relief groove -bg grey80 -cursor arrow -font {arial 8 {bold}} pack .top2.e_l .top2.e_r -side left -fill x -expand true ########################################## #Fake entry (for some reason it should be exists to separate #readings from dif directories entry .fake_l entry .fake_r #pack .fake_l .fake_r -side top -fill x ################################################## #Buttons,entry, text,scrollbar for text on bottom frame .bot -relief groove -bd 2 frame .bot.2 -relief groove -bd 2 pack .bot.2 -fill x entry .bot.2.e_l -bg grey -relief groove -font {arial 8 {bold}} entry .bot.2.e_r -bg grey -relief groove -font {arial 8 {bold}} pack .bot.2.e_l .bot.2.e_r -side left -fill x -expand true text .bot.t -wrap none -height 10 -bg bisque -fg blue -font {monaco 12 {}} -cursor arrow -yscrollcommand [list .bot.scr set] scrollbar .bot.scr -orient vertical -command [list .bot.t yview] history::for entry .bot.comm -font {monaco 12} -bd 1 -bg bisque -cursor arrow -textvariable command_var pack .bot.scr -side right -fill y pack .bot.t .bot.comm -side top -fill x -expand true bind .bot.comm <Return> {+ ; .bot.t delete 1.0 end ; \ .bot.t insert end [exec_cmd [.bot.comm get]]; \ .bot.comm delete 0 end ; after 100 focus .bot.comm } bind .bot.comm <Enter> {focus .bot.comm} foreach bot {.b1 .b2 .b3 .b4 .b5 .b6 .b7 .b8 .b9 .b10} { button .bot$bot -relief groove pack .bot$bot -side left -fill x -expand true } .bot.b1 config -text "Help F1" -command About .bot.b2 config -text "Menu F2" -command {} .bot.b3 config -text "View F3" -command {} .bot.b4 config -text "Editor F4" -command {editor} .bot.b5 config -text "Copy F5" -command "" .bot.b6 config -text "RenMv F6" -command "" .bot.b7 config -text "MkDir F7" -command "" .bot.b8 config -text "Delete F8" -command "" .bot.b9 config -text "Run Tcl Code F9" -command {focus .bot.t ; run_tcl .bot.t} .bot.b10 config -text "Exit F10" -command exit pack .bot -side bottom -fill both -expand true ######################### ############################# #Right drive lists frame .top.f_r -relief groove -bd 2 pack .top.f_r -fill x -expand true -fill x -side left foreach x [file volume] { button .top.f_r.f$x -text [file native $x] -font {arial 8 {bold} } -relief groove -command "" pack .top.f_r.f$x -side left .top.f_r.f$x config -command "cd $x ; read_dir_r ; refresh_right" } pack .top -side top -fill x -expand true pack .top2 -side top -fill x -expand true ############################## ################################# #Left listboxes listbox .l -bg bisque -width 20 -export no -bd 0 -relief raised -selectmode browse -yscrollcom LBscroll -font {monaco 10} listbox .sz -bg bisque -width 8 -export no -bd 0 -selectmode browse -yscrollcom LBscroll -font {monaco 10} listbox .time -bg bisque -export no -width 15 -bd 0 -selectmode browse -yscrollcom LBscroll -font {monaco 10} pack .l .sz .time -side left -fill both -expand true ############################ #Right side listboxes listbox .l_r -bg bisque -width 20 -export no -bd 0 -relief raised -selectmode browse -yscrollcom LBscroll_r -font {monaco 10} listbox .sz_r -bg bisque -width 8 -export no -bd 0 -selectmode browse -yscrollcom LBscroll_r -font {monaco 10} listbox .time_r -bg bisque -export no -width 15 -bd 0 -selectmode browse -yscrollcom LBscroll_r -font {monaco 10} pack .l_r .sz_r .time_r -side left -fill both -expand true ################### #Fill all listboxes proc read_dir_l {} { #clean all listboxes .l delete 0 end .sz delete 0 end .time delete 0 end .l insert end ".." .sz insert end ".." .time insert end ".." ### set dir [glob -nocomplain ./*] set files [glob -nocomplain ./*] set dirs {} set others {} set dsize {} set dtime {} set fsize {} set ftime {} foreach f [lsort -dictionary $files] { if { ![file isdirectory $f] && ![file isfile $f] } { lappend others [file tail $f] lappend fsize "NOT A FILE" lappend ftime "------" } elseif [file isdirectory $f] { lappend dirs [file tail $f] lappend dsize "DIR" lappend dtime [clock format [file mtime $f] -format {%b-%d-%y %H:%M}] } else { lappend others [file tail $f] lappend fsize [file size $f] lappend ftime [clock format [file mtime $f] -format {%b-%d-%y %H:%M}] } } foreach f [concat $dirs $others] { .l insert end $f } foreach z [concat $dsize $fsize] { .sz insert end $z } foreach t [concat $dtime $ftime] { .time insert end $t } .top2.e_l delete 0 end .top2.e_l insert end [file native [pwd]] .fake_l delete 0 end .fake_l insert end [pwd] } ########################## #Fill right listboxes proc read_dir_r {} { #clean all listboxes .l_r delete 0 end .sz_r delete 0 end .time_r delete 0 end .l_r insert end ".." .sz_r insert end ".." .time_r insert end ".." ### set dir_r [glob -nocomplain ./*] set files_r [glob -nocomplain ./*] set dirs_r {} set others_r {} set dsize_r {} set dtime_r {} set fsize_r {} set ftime_r {} foreach f [lsort -dictionary $files_r] { if { ![file isdirectory $f] && ![file isfile $f] } { lappend others_r [file tail $f] lappend fsize_r "NOT A FILE" lappend ftime_r "------" } elseif [file isdirectory $f] { lappend dirs_r [file tail $f] lappend dsize_r "DIR" lappend dtime_r [clock format [file mtime $f] -format {%b-%d-%y %H:%M}] } else { lappend others_r [file tail $f] lappend fsize_r [file size $f] lappend ftime_r [clock format [file mtime $f] -format {%b-%d-%y %H:%M}] } } foreach f [concat $dirs_r $others_r] { .l_r insert end $f } foreach z [concat $dsize_r $fsize_r] { .sz_r insert end $z } foreach t [concat $dtime_r $ftime_r] { .time_r insert end $t } .top2.e_r delete 0 end .top2.e_r insert end [file native [pwd]] .fake_r delete 0 end .fake_r insert end [pwd] } ################################## read_dir_l read_dir_r ################################# ################################ #Left scroolbar and procs to scroll scrollbar .sy -orient v -command "LBset yview" pack .sy -fill y -after .time -side left proc LBset args { foreach lb {.l .sz .time} { eval $lb $args } } proc LBscroll args { eval .sy set $args LBset yview moveto [lindex $args 0] } foreach lb {.l .sz .time} { bind $lb <ButtonPress-1> { LBset select clear 0 end LBset select set [%W nearest %y] set show [.l curselection] .bot.2.e_l delete 0 end .bot.2.e_l insert end [.l get $show ] } bind $lb <B1-Motion> { LBset select clear 0 end LBset select set [%W nearest %y] LBset see [%W nearest %y] set show [.l curselection] .bot.2.e_l delete 0 end .bot.2.e_l insert end [.l get $show ] } bind $lb <ButtonRelease-1> { LBset select clear 0 end LBset select set [%W nearest %y] set show [.l curselection] .bot.2.e_l delete 0 end .bot.2.e_l insert end [.l get $show ] } } ################################################ #Right scroolbar and proc for scroll scrollbar .sy_r -orient v -command "LBset_r yview" pack .sy_r -fill y -after .time_r -side right proc LBset_r args { foreach lb_r {.l_r .sz_r .time_r} { eval $lb_r $args } } proc LBscroll_r args { eval .sy_r set $args LBset_r yview moveto [lindex $args 0] } foreach lb_r {.l_r .sz_r .time_r} { bind $lb_r <ButtonPress-1> { LBset_r select clear 0 end LBset_r select set [%W nearest %y] set show [.l_r curselection] .bot.2.e_r delete 0 end .bot.2.e_r insert end [.l_r get $show ] } bind $lb_r <B1-Motion> { LBset_r select clear 0 end LBset_r select set [%W nearest %y] LBset_r see [%W nearest %y] set show [.l_r curselection] .bot.2.e_r delete 0 end .bot.2.e_r insert end [.l_r get $show ] } bind $lb_r <ButtonRelease-1> { LBset_r select clear 0 end LBset_r select set [%W nearest %y] set show [.l_r curselection] .bot.2.e_r delete 0 end .bot.2.e_r insert end [.l_r get $show ] } } ####################################################### #Proc to show file names on bottom entry right and left #Scroll selected lines in all listboxes in left proc showItemDown {w w2} { set item [$w curselection] set item2 [expr $item+1] $w2 delete 0 end; $w2 insert end [$w get $item2] foreach sel {.l .sz .time} { $sel selection clear $item $sel selection set $item2 ; $sel selection clear $item } } proc showItemUp {w w2} { set item [$w curselection] set item2 [expr $item-1] $w2 delete 0 end; $w2 insert end [$w get $item2] foreach sel {.l .sz .time} { $sel selection clear $item $sel selection set $item2 ; $sel selection clear $item } } ##################### #Proc to scroll all selection in right side proc showItemDown_r {w w2} { set item [$w curselection] set item2 [expr $item+1] $w2 delete 0 end; $w2 insert end [$w get $item2] foreach sel {.l_r .sz_r .time_r} { $sel selection clear $item $sel selection set $item2 ; $sel selection clear $item } } proc showItemUp_r {w w2} { set item [$w curselection] set item2 [expr $item-1] $w2 delete 0 end; $w2 insert end [$w get $item2] foreach sel {.l_r .sz_r .time_r} { $sel selection clear $item $sel selection set $item2 ; $sel selection clear $item } } proc edit_file {w} { global fileex set fileex [$w get active] if [file isdirectory $fileex] { tk_messageBox -parent . -title "Error" -type ok -icon error -message "This is directory" } else { editor set openfile [open $fileex "r"] .ed.text.t delete 1.0 end .ed.text.t insert end [read $openfile] close $openfile } } ################## #Proc to change left directory list proc read_left {} { #focus .l global fileex set old_dir [.fake_l get] cd $old_dir set dir [.l get active] if [file isdirectory $dir] { cd $dir ; read_dir_l .l selection set 0; .sz selection set 0; .time selection set 0 .l activate 0 .top2.e_l delete 0 end .top2.e_l insert end [file native [pwd]] } else { set fileex [.l get active] if [file executable $fileex] { catch {exec $fileex &} result #.bot.t insert end [eval exec command /c $fileex] } if {[id_giffile] == 1} { img_view $fileex } if {[id_txtfile] == 1} { set openfile [open $fileex "r"] .bot.t delete 1.0 end .bot.t insert end [read $openfile] close $openfile } if {[id_tclfile] == 1} { set dir [pwd] showTcl $dir/$fileex } if {[id_htmlfile] == 1} { set dir [pwd] showHtml $dir/$fileex } } } proc read_right {} { # Get selected list item global fileex focus .l_r set old_dir [.fake_r get] cd $old_dir set dir_r [.l_r get active] if [file isdirectory $dir_r] { cd $dir_r ; read_dir_r .l_r selection set 0; .sz_r selection set 0; .time_r selection set 0 .top2.e_r delete 0 end .top2.e_r insert end [file native [pwd]] } else { set fileex [.l_r get active] if [file executable $fileex] { catch {exec $fileex &} result #.bot.t insert end [eval exec command /c $fileex] } if {[id_giffile] == 1} { img_view $fileex } if {[id_txtfile] == 1} { set openfile [open $fileex "r"] .bot.t delete 1.0 end .bot.t insert end [read $openfile] close $openfile } if {[id_tclfile] == 1} { set dir [pwd] showTcl $dir/$fileex } if {[id_htmlfile] == 1} { set dir [pwd] showHtml $dir/$fileex } } } proc copy_file_to_r {} { set file_l [.l get active] set left_dir [.fake_l get] set right_dir [.fake_r get] set choise [tk_messageBox -parent . -type yesno -default yes \ -message "Copy\n [file native $left_dir/$file_l]\nto\n \ [file native $right_dir]" \ -icon question] if {$choise == "yes"} { if [file isdirectory $file_l] { file copy -force $left_dir/$file_l $right_dir refresh_right ; refresh_left cd [.fake_l get] } else { file copy $left_dir/$file_l $right_dir after 100 refresh_left; refresh_right cd [.fake_l get] } } } proc copy_file_to_l {} { set file_r [.l_r get active] set left_dir [.fake_l get] set right_dir [.fake_r get] set choise [tk_messageBox -parent . -type yesno -default yes \ -message "Copy\n [file native $right_dir/$file_r] \nto\n \ [file native $left_dir]" \ -icon question] if {$choise == "yes"} { if [file isdirectory $file_r] { file copy $right_dir/$file_r $left_dir; refresh_left ; refresh_right cd [.fake_r get] } else { file copy $right_dir/$file_r $left_dir refresh_left cd [.fake_r get] } } } #################### #Rename move files and Directories proc ren_move {w} { catch [destroy .move] toplevel .move wm resizable .move 0 0 wm title .move "Rename" grab .move center_win .move global file_move set file_move [$w get active] label .move.l -text "Current name is: \n$file_move \n\n Enter new name: " -relief groove -font {arial 8 {bold}} entry .move.e -font {arial 8 {bold}} .move.e insert end $file_move focus .move.e frame .move.ok -relief sunken -bd 2 button .move.ok.ok -text " Ok " -padx 10 -pady 5 -command {file rename $file_move [.move.e get]; \ after 1 "refresh_right; refresh_left; destroy .move"} button .move.cancel -text Cancel -command "destroy .move" pack .move.l .move.e -side top -fill x -expand true pack .move.ok .move.ok.ok .move.cancel -side left -padx 10 -pady 5 bind .move.e <Return> {file rename $file_move [.move.e get]; \ after 30 refresh_right; refresh_left; after 35 destroy .move } } ############## proc delete_file_l {} { set file_l [.l get active] set left_dir [.fake_l get] if [file isdirectory $file_l] { set cur [.l curselection] set question [tk_messageBox -type okcancel -default cancel \ -message " Delete directory and files in \n [file native $left_dir/$file_l]" \ -icon question] switch -- $question { ok { file delete -force $file_l ; refresh_left ; refresh_right} } } else { set cur [.l curselection] set question [tk_messageBox -type okcancel -default cancel \ -message " Delete files \n [file native $left_dir/$file_l]" \ -icon question] switch -- $question { ok { file delete $left_dir/$file_l; refresh_left; refresh_right} } #.l selection set $curent #.l see $curent } } proc delete_file_r {} { set file_r [.l_r get active] set right_dir [.fake_r get] if [file isdirectory $file_r] { set curent [.l_r curselection] set question [tk_messageBox -type okcancel -default cancel \ -message " Delete directory and files in \n [file native $right_dir/$file_r] " \ -icon question] switch -- $question { ok { file delete -force $file_r ; refresh_left ; refresh_right } } } else { set curent [.l_r curselection] set question [tk_messageBox -type okcancel -default cancel \ -message " Delete files \n [file native $right_dir/$file_r]" \ -icon question] switch -- $question { ok { file delete $right_dir/$file_r; refresh_right; refresh_left } } } } proc mk_dir {w} { catch [destroy .mkdir] toplevel .mkdir wm resizable .mkdir 0 0 wm title .mkdir "Create new Directory" grab .mkdir center_win .mkdir label .mkdir.l -text " Current directory is: \n[file native [pwd]] \n\n Enter new directory name " -relief groove -font {arial 8 {bold}} entry .mkdir.e -font {arial 8 {bold}} focus .mkdir.e frame .mkdir.ok -relief sunken -bd 2 button .mkdir.ok.ok -text " Ok " -padx 10 -pady 5 -command {file mkdir [.mkdir.e get]; \ after 1 "refresh_right; refresh_left; destroy .mkdir"} button .mkdir.cancel -text Cancel -command "destroy .mkdir" pack .mkdir.l .mkdir.e -side top -fill x -expand true pack .mkdir.ok .mkdir.ok.ok .mkdir.cancel -side left -padx 10 -pady 5 bind .mkdir.e <Return> {file mkdir [.mkdir.e get]; \ after 30 refresh_right; refresh_left; after 35 destroy .mkdir } } #end mk_dir proc find_win {w} { catch [destroy .find] toplevel .find center_win .find wm title .find "Find" wm resizable .find 0 0 grab .find label .find.l -text "\tCurrent directory is:\t\n\t[file native [pwd]]\t\t\n\nSearch Filename:" -relief groove -font {arial 10 {bold}} entry .find.e pack .find.l .find.e -fill x focus .find.e frame .find.ok -relief sunken -bd 1 button .find.ok.ok -padx 10 -pady 5 -text Find \ -command {.bot.t delete 1.0 end ; find_file [pwd] [.find.e get] ; \ destroy .find} button .find.cancel -text Cancel -command "destroy .find" pack .find.ok .find.ok.ok .find.cancel -side left -padx 10 -pady 5 } ######################## #Proc find file proc find_file { startDir namePat} { #set namePat [.find.e get] set pwd [pwd] if [catch {cd $startDir} err] { puts stderr $err return } foreach match [glob -nocomplain -- $namePat] { .bot.t insert end "[file native $startDir/$match]\n" if {$namePat != $match } { #.bot.t insert end "$startDir$match\n" #.bot.t insert end "no match" } else { #.bot.t insert end "no files found" } } foreach file [glob -nocomplain *] { if [file isdirectory $file] { find_file $startDir/$file $namePat update } } cd $pwd } #################################################### #Refresh left listbox after copy or deleting a file proc refresh_left {} { set left_dir [.fake_l get] set cur [.l curselection] if {$cur == "" } { focus .l after 3 ".l selection set 0 ; .sz selection set 0 ; .time selection set 0" .l see 0 .l activate 0 } else { cd $left_dir ; read_dir_l .l selection set $cur ; .sz selection set $cur ; .time selection set $cur .l see $cur .l activate $cur .top2.e_l delete 0 end .bot.2.e_l delete 0 end .top2.e_l insert end [file native [pwd]] } } refresh_left proc refresh_right {} { set right_dir [.fake_r get] set cur [.l_r curselection] if {$cur == ""} { .l_r selection set 0 ; .sz_r selection set 0; .time_r selection set 0 .l_r see 0 .l_r activate 0 } else { cd $right_dir ; read_dir_r .l_r selection set $cur; .sz_r selection set $cur; .time_r selection set $cur .l_r see $cur .l_r activate $cur .top2.e_r delete 0 end .bot.2.e_r delete 0 end .top2.e_r insert end [file native [pwd]] } } proc viewFile {w} { #global fileex set fileex [$w get active] if [file isdirectory $fileex] { tk_messageBox -parent . -title "Error" -type ok -icon error -message "This is directory" } else { set openfile [open $fileex "r"] .bot.t delete 1.0 end .bot.t insert end [read $openfile] close $openfile } } refresh_right ######################### ######################## #Bindings global #bind .bot.t <Enter> "focus .bot.t" bind . <F4> "editor" bind . <F9> {focus .bot.t ; run_tcl .bot.t} ######################### #Bindings keys for left side foreach bind_left { .l .sz .time} { bind $bind_left <Enter> {focus .l ; set old_dir [.fake_l get] ; cd $old_dir ; \ .bot.b2 config -command {}; \ .bot.b3 config -command {viewFile .l} ; \ .bot.b5 config -command copy_file_to_r ; \ .bot.b6 config -command {ren_move .l} ; \ .bot.b7 config -command {mk_dir .l} ; \ .bot.b8 config -command delete_file_l} } bind .l <Double-Button-1> "read_left;" bind .l <Return> {read_left} bind .l <Down> {showItemDown .l .bot.2.e_l} bind .l <Up> {showItemUp .l .bot.2.e_l} bind .l <KeyPress-r> "focus .l_r" bind .l <F3> {viewFile .l} bind .l <F5> copy_file_to_r bind .l <F6> {ren_move .l} bind .l <F7> {mk_dir .l} bind .l <F8> delete_file_l ############################################# #Bindings keys for right side bind .l_r <Double-Button-1> "read_right" bind .l_r <Return> {read_right} foreach bind_right {.l_r .sz_r .time_r} { bind $bind_right <Enter> {focus .l_r; set old_dir [.fake_r get] ; cd $old_dir ; \ .bot.b3 config -command {viewFile .l_r}; \ .bot.b8 config -command delete_file_r; \ .bot.b5 config -command copy_file_to_l ; \ .bot.b6 config -command {ren_move .l_r} ; \ .bot.b7 config -command {mk_dir .l_r}} } bind .l_r <KeyPress-r> "focus .l" bind .l_r <F3> {viewFile .l_r} bind .l_r <F5> copy_file_to_l bind .l_r <F6> {ren_move .l_r} bind .l_r <F7> {mk_dir .l_r} bind .l_r <F8> delete_file_r bind .l_r <Down> {showItemDown_r .l_r .bot.2.e_r} bind .l_r <Up> {showItemUp_r .l_r .bot.2.e_r} #################################### #Txt, ASCII and bat files viewer proc id_allfiles {} { global fileex set ext_txt [file extension $fileex] switch $ext_txt { .doc {return 1} .txt {return 1} .jpeg {return 1} .jpg {return 1} .txt {return 1} .htm {return 1} .html {return 1} } return 0 } proc id_txtfile {} { global fileex set ext_txt [file extension $fileex] switch $ext_txt { .txt {return 1} .TXT {return 1} .bat {return 1} .BAT {return 1} .c {return 1} .C {return 1} .h {return 1} .H {return 1} } return 0 } proc id_tclfile {} { global fileex set ext_tcl [file extension $fileex] switch $ext_tcl { .tcl {return 1} .TCL {return 1} .tk {return 1} .TK {return 1} } return 0 } ####################################### proc id_giffile {} { global fileex set ext_gif [file extension $fileex] switch $ext_gif { .gif {return 1} .GIF {return 1} .jpeg {return 1} .jpg {return 1} .JPEG {return 1} .JPG {return 1} .tif {return 1} } return 0 } proc id_htmlfile {} { global fileex set ext_html [file extension $fileex] switch $ext_html { .htm {return 1} .html {return 1} .HTM {return 1} .HTML {return 1} } return 0 } ############################# #Proc file atributes and properties proc fileprop pathname { set padx 6 if {$pathname=="."} {set pathname [pwd]} set pathname [file join [pwd] $pathname] set checkbuttons [list] file stat $pathname a ;# may error out if no such file set w .[clock clicks] set ::$w\(dir) [file dir $pathname] set ::$w\(file) [file tail $pathname] toplevel $w grab $w wm title $w [file nativename $pathname] wm resizable $w 0 0 wm geometry $w +300+150 set size [file size $pathname] if {$size < 0} { set size [format "%2.2f GB" [expr ($size/-1024.0)/-1024.0/-1024.0*10.0]] } else { if {$size > 1073741824.0} { set size [format "%2.2f GB" [expr ($size/1024.0)/1024.0/1024.0]] } else { if { $size > 1048576.0 } { set size [format "%2.2f MB" [expr ($size/1024.0) /1024.0 ]] } else { if {$size > 1024} { set size [ format "%2.2f KB" [expr $size / 1024.0 ]] } } } } set textual [list Name [file tail $pathname] \ Directory [file nativename [file dir $pathname]] \ Type [file type $pathname]\ Size $size \ Created [date,time $a(ctime)]\ "Last modified" [date,time $a(mtime)]\ "Last accessed" [date,time $a(atime)]\ ] foreach {name value} [file attr $pathname] { if [regexp {^[01]$} $value] { lappend checkbuttons $name $value } else { lappend textual $name [file nativename $value] } } set n 0 foreach {name value} $textual { grid [label $w.${n}n -text $name:] [label $w.${n}v -text $value]\ -sticky w -padx $padx incr n } grid [hr $w.$n] -sticky we -columnspan 2 -padx $padx -pady 6 set n0 [incr n] foreach {name value} $checkbuttons { incr n set ::$w\($name) $value grid [checkbutton $w.$n -text $name -var $w\($name) -borderwidth 0]\ -sticky w -col 1 -padx $padx } grid [label $w.att -text Attributes:]\ -row $n0 -sticky w -padx $padx grid [hbuttons $w.b [list \ OK "fileprop:apply $w; destroy $w; unset $w" \ Cancel "destroy $w; unset $w" \ Apply "fileprop:apply $w" \ ]] -col 1 -padx $padx wm protocol $w WM_DELETE_WINDOW "destroy $w; unset $w" focus $w } proc fileprop:apply {w} { upvar #0 $w a set cmd [list file attributes [file join $a(dir) $a(file)]] foreach {name value} [array get a] { if [regexp {^-} $name] {lappend cmd $name $value} } eval $cmd } proc hbuttons {w tc} { frame $w set n 1 foreach {t c} $tc { button $w.$n -text $t -command $c -width 8 incr n } eval pack [winfo children $w] -side left -padx 3 -pady 6\ -fill x -anchor e return $w } proc hr {w} {frame $w -height 2 -borderwidth 1 -relief sunken} proc date,time {{when {}}} { if {$when == ""} {set when [clock seconds]} return [clock format $when -format "%Y-%m-%d,%H:%M:%S"] } ####################### #Proc popup menus proc pop_upmen_l {w} { global act set act [$w curselection] menu .popup_l -tearoff 0 .popup_l add separator .popup_l add command -label Info -command {fileprop [.bot.2.e_l get]} .popup_l add separator .popup_l add command -label View -command "viewFile .l" .popup_l add command -label Edit -command "edit_file .l" .popup_l add separator .popup_l add command -label Find -command {find_win .l} .popup_l add command -label Copy -command copy_file_to_r .popup_l add command -label NewDir -command "mk_dir .l" .popup_l add separator .popup_l add command -label Rename -command "ren_move .l" .popup_l add command -label Delete -command delete_file_l .popup_l add separator bind $w <ButtonPress-3> {tk_popup .popup_l %X %Y } } proc pop_upmen_r {w} { global act set act [$w curselection] menu .popup_r -tearoff 0 .popup_r add separator .popup_r add command -label Info -command {fileprop [.bot.2.e_r get]} .popup_r add separator .popup_r add command -label View -command "viewFile .l_r" .popup_r add command -label Edit -command "edit_file .l_r" .popup_r add separator .popup_r add command -label Find -command {find_win .r} .popup_r add command -label Copy -command copy_file_to_l .popup_r add command -label NewDir -command "mk_dir .l_r" .popup_r add separator .popup_r add command -label Rename -command "ren_move .l_r" .popup_r add command -label Delete -command delete_file_r .popup_r add separator bind $w <ButtonPress-3> {tk_popup .popup_r %X %Y } } pop_upmen_l .l pop_upmen_r .l_r ##################### #Image viewer procs #Var set set i 1 set im 1 ###################### #image viewer procedure proc img_view {fileex} { global i global im incr i incr im toplevel .img$i wm title .img$i $fileex #wm minsize .img$i 800 640 image create photo $im $im read $fileex set im_y [image height $im] set im_x [image width $im] wm minsize .img$i 200 100 canvas .img$i.c -relief groove -bd 2 -scrollregion {0 0 3000 3000} \ -yscrollcommand [list .img$i.scr set] \ -xscrollcommand [list .img$i.xscr set] scrollbar .img$i.scr -orient vertical -command [list .img$i.c yview] scrollbar .img$i.xscr -orient horizontal -command [list .img$i.c xview] .img$i.c create image 5 5 -image $im -anchor nw update pack .img$i.scr -side right -fill y pack .img$i.xscr -side bottom -fill x pack .img$i.c -side left -fill both -expand true } ###################################### #Procedure to run command from entry proc exec_cmd {command} { global tcl_platform set result " " set check_cmd [lindex $command 0] set cmd [info commands $check_cmd] if {[string length $cmd ] > 0} { .bot.t insert end [set result [eval $command]] refresh_left #refresh_right } else { if {$tcl_platform(platform) == "windows"} { eval exec command /c [.bot.comm get] } else { eval exec [.bot.comm get] } } } ############################# #Procedure for running tcl from text widgets proc run_tcl {w} { if {[interp exists eval_env]} { interp delete eval_env run_tcl $w } else { interp create eval_env load {} Tk eval_env set all [$w get 1.0 end] eval_env eval $all } } ########################## ############################################ #Registry procedure #Evaluate file extensions and execute applcation ::tcl::OptProc perSub { {string -string "" "String to work on"} {pattern -string "" "What to substitute for, e.g., %v"} {subst -string "" "What to put in for $pattern"} {args -list {} "More pattern/subst pairs"} } { # Add the required instances to the optional list set args [linsert $args 0 $pattern $subst] # Process the list foreach {pattern subst} $args { # Validate pattern if { ! [string match %* $pattern]} { error "Bad pattern <<$pattern>>: Should be %something" } # Escape dangerous characters ('\' and '&') in substitution string regsub -all {\\|&} $subst {\\\0} subst # Do substitutions on string regsub -all $pattern $string $subst string } # foreach return $string } proc showHtml {htmlFile} { global tcl_platform if {$tcl_platform(platform) == "windows"} { set root HKEY_CLASSES_ROOT set appKey [registry get $root\\.html ""] set appCmd [registry get \ $root\\$appKey\\shell\\open\\command ""] set appCmd [perSub $appCmd %1 $htmlFile] regsub -all {\\} $appCmd {\\\\} appCmd eval exec $appCmd & } else { } } proc showTcl {tclFile} { global tcl_platform if {$tcl_platform(platform) == "windows"} { set root HKEY_CLASSES_ROOT set appKey [registry get $root\\.tcl ""] set appCmd [registry get \ $root\\$appKey\\shell\\open\\command ""] set appCmd [perSub $appCmd %1 $tclFile] regsub -all {\\} $appCmd {\\\\} appCmd eval exec $appCmd & } else { } } ########################################## proc editor {} { catch [destroy .ed] toplevel .ed wm resizable .ed 0 0 wm title .ed "TclMC Editor" menu .ed.menubar -relief raised -borderwidth 1 menu .ed.menubar.file -tearoff 0 .ed.menubar add cascade -label "File" -menu .ed.menubar.file -underline 0 .ed.menubar.file add separator .ed.menubar.file add command -label "New" -command {clear_all .ed.text.t} .ed.menubar.file add separator .ed.menubar.file add command -label "Open" \ -command {clear_all .ed.text.t ; textOpen} .ed.menubar.file add separator .ed.menubar.file add command -label "Close" \ -command {clear_all .ed.text.t} .ed.menubar.file add separator .ed.menubar.file add command -label "Save as..." \ -command {textSaveAs} .ed.menubar.file add separator .ed.menubar.file add command -label "Print" \ -command {printFormat} .ed.menubar.file add separator .ed.menubar.file add command -label "Exit" \ -command {bell ; prompt_close .} ###################### .ed.menubar add cascade -label "Edit" -menu .ed.menubar.editt -underline 0 menu .ed.menubar.editt -tearoff 0 .ed.menubar.editt add separator .ed.menubar.editt add command -label "Select All" -command {.ed.text.t tag add sel 1.0 end} .ed.menubar.editt add separator .ed.menubar.editt add command -label "Copy" -command {tk_textCopy .ed.text.t} .ed.menubar.editt add separator .ed.menubar.editt add command -label "Paste" -command "tk_textPaste .ed.text.t" .ed.menubar.editt add separator .ed.menubar.editt add command -label "Cut" -command "tk_textCut .ed.text.t" .ed.menubar.editt add separator .ed.menubar.editt add command -label "Clear" -command "clear_all .ed.text.t" .ed.menubar.editt add separator #################################### .ed.menubar add cascade -label "Test Tcl" -menu .ed.menubar.run -underline 0 menu .ed.menubar.run -tearoff 0 .ed.menubar.run add separator .ed.menubar.run add command -label "Run Tcl" -command {run_tcl .ed.text.t} .ed.menubar.run add separator ############################ .ed.menubar add cascade -label "Font Size" -menu .ed.menubar.font -underline 0 menu .ed.menubar.font -tearoff 0 .ed.menubar.font add separator .ed.menubar.font add command -label "Small" -command ".ed.text.t config -font {Monaco 8 {}}" .ed.menubar.font add separator .ed.menubar.font add command -label "Medium" -command ".ed.text.t config -font {Monaco 9 {}}" .ed.menubar.font add separator .ed.menubar.font add command -label "Large" -command ".ed.text.t config -font {Monaco 12 {}}" ############################# .ed.menubar add cascade -label "Help" -menu .ed.menubar.help -underline 0 menu .ed.menubar.help -tearoff 0 .ed.menubar.help add separator .ed.menubar.help add command -label "Help" -command {About} .ed.menubar.help add separator .ed.menubar.help add command -label "About" -command {About} .ed conf -menu .ed.menubar proc clear_all { widgetname } { $widgetname delete 1.0 end } ##################################### proc textOpen { { fn ""} } { global .ed.text.t set types { {{All Files} *} {{Text Files} {.txt}} } if { [string match {} $fn] && ([catch {tk_getOpenFile -filetypes $types \ -title "Source File" -parent .ed} fn] || [string match {} $fn]) } { return } set fp [open $fn] while {![eof $fp]} { .ed.text.t insert end [read $fp] } close $fp } ##################################### # Handles window manager Close choice. proc prompt_close { widgetname } { # If main window, prompt. if { $widgetname == "." } { set result [tk_messageBox -parent .ed \ -title {Exit?} -type yesno\ -icon warning \ -message "Do you really want to quit?"] if { $result == "yes" } { destroy .ed } } else { # Not the main window, destroy it. destroy $widgetname } } wm protocol . WM_DELETE_WINDOW "prompt_close .ed" #################################### #save as command proc textSaveAs {} { global .ed.text.t set types { {{Tcl Files} {.tcl}} {{Text Files} {.txt}} {{All Files} *} } set filename [tk_getSaveFile -title "Save as..." -filetypes $types] if {$filename !=""} { set file_open [open $filename w] puts -nonewline $file_open [.ed.text.t get 1.0 end] close $file_open refresh_left refresh_right } } #################################### #Print using ms Write application proc printFormat {} { global tcl_platform if {$tcl_platform(platform) == "unix"} { } if {[file exists c:/windows/write.exe]} { set file [open c:/tmp/out.txt w] puts $file [.ed.text.t get 1.0 end] close $file exec start /m write /p c:/tmp/out.txt & } else { if {[file exists c:/progra~1/accessories/wordpad.exe]} { set file [open c:/tmp/out.txt w] puts $file [.ed.text.t get 1.0 end] close $file exec start /m c:/progra~1/accessories/wordpad.exe /p c:/tmp/out.txt & } else { if {[file exists c:/winnt/system32/write.exe]} { set file [open c:/tmp/out.txt w] puts $file [.ed.text.t get 1.0 end] close $file exec c:/winnt/system32/write.exe /p c:/tmp/out.txt & } else { ## catch [destroy .formated] toplevel .formated wm title .formated "" wm resizable .formated 0 0 label .formated.l -text "You need install MS Windows \n WordPad application!\n Press Ok button to continue" \ -relief groove button .formated.b -text Ok -command "destroy .formated" pack .formated.l -side top pack .formated.b -side bottom } } } } ############################### #Image Buttons set imnew { R0lGODlhEAAQAPcAAAAAAMbGxv////////////////////////////////////////////////// //////////////////////////////////////////////////////////////////////////// //////////////////////////////////////////////////////////////////////////// //////////////////////////////////////////////////////////////////////////// //////////////////////////////////////////////////////////////////////////// //////////////////////////////////////////////////////////////////////////// //////////////////////////////////////////////////////////////////////////// //////////////////////////////////////////////////////////////////////////// //////////////////////////////////////////////////////////////////////////// //////////////////////////////////////////////////////////////////////////// //////////////////////////////////////////////////////////////////////////// //////////////////////////////////////////////////////////////////////////// //////////////////////////////////////////////////////////////////////////// /////////////////////////////////////////////////////yH5BAEAAAEALAAAAAAQABAA AAhJAAMIHEiwIEEACBMiNCgQwL+HEBcadAjxoUMAEytaTFiQokaLHT9GDCnyH8aDJU2SFHlyoMeP LRumjBngpUaaCnNKZMizJ8+AAAA7 } #End New ################ #Open button image set imopen { R0lGODlhEAAPAPcAAAAAAMbGxv//AP////////////////////////////////////////////// //////////////////////////////////////////////////////////////////////////// //////////////////////////////////////////////////////////////////////////// //////////////////////////////////////////////////////////////////////////// //////////////////////////////////////////////////////////////////////////// //////////////////////////////////////////////////////////////////////////// //////////////////////////////////////////////////////////////////////////// //////////////////////////////////////////////////////////////////////////// //////////////////////////////////////////////////////////////////////////// //////////////////////////////////////////////////////////////////////////// //////////////////////////////////////////////////////////////////////////// //////////////////////////////////////////////////////////////////////////// //////////////////////////////////////////////////////////////////////////// /////////////////////////////////////////////////////yH5BAEAAAEALAAAAAAQAA8A AAhMAAMIHEiwoMGDCBMSBMBQoUAAAv4JYEix4UKJAiJq/AegIESJIDV2vCiyoskAHydmXMmyIwCJ EFm2fKhS5sqRKGPanLjQ5EmHQIMGBAA7 } #End open image ####################################### #Save Image set imsave { R0lGODlhEAAQAPcAAAAAAAAAnAAA/8bGxs7Ozv////////////////////////////////////// //////////////////////////////////////////////////////////////////////////// //////////////////////////////////////////////////////////////////////////// //////////////////////////////////////////////////////////////////////////// //////////////////////////////////////////////////////////////////////////// //////////////////////////////////////////////////////////////////////////// //////////////////////////////////////////////////////////////////////////// //////////////////////////////////////////////////////////////////////////// //////////////////////////////////////////////////////////////////////////// //////////////////////////////////////////////////////////////////////////// //////////////////////////////////////////////////////////////////////////// //////////////////////////////////////////////////////////////////////////// //////////////////////////////////////////////////////////////////////////// /////////////////////////////////////////////////////yH5BAEAAAMALAAAAAAQABAA AAhhAAcIHEiwoMGDBgEEECAAgMOHAgIAGKiQIYGLAQIQiDhRYEUBFwlk3CiR4sKGDx1yNMmwpcuG JlPKdBjzn82b/x7WxGlTp0eJPHvS/AkgaM6hAxQWDeozqUOjTWdKRUg1IAA7 } #End Save Image ######################### #image Select all set imselectall { R0lGODdhFAARAPcAAAAAALa2qtu2qrbbqtvbqrOzs7a2/9u2/7bb/9vb/////wBMWTQJAAAAAAAA AAAAAKgF9xcAABwANAkFAAAApG0/A1r4AgBk6wIACAAjAacrAAABAMk7AAAFAOA/AAAAAAAAAAAA AEAGAAAAAAAA9wPWFE4ifwMJAAAA1hRa+AIAkOwCAAAyVwQBAA5gAAAAAAAAVuvHMaj4twVQUiAD WAJABgEQAAAAAEAGAAAAAAAAAAAAABMBCeAABDAA1hQfBR8DWAUfAwAAAAACAOrrAgAIAB8BpysA AAEANQIBAQYAAQAAANYUZAAAAAIANQIAAC8AFAAaAFYAJwBlAAAAAAAAQPdeAAC3BSHsAAAAAAAA AADHMQAAAADc68cxqPi3BUIAnhcEAMjsxzEGAAEAJQAfAHoCSezg60nsTiOvBwgD3xOPEwwFSO0a AC8A///3/wAACAPfE8cDAAD//wAAHwAgAPLrCiavBxjsxzF6At8TUezHMeDsJwHXExjsxzGLax8B jxPg7EsB1xPc7McxSO3HMRjsxzEBAACAQXBwRXZlbnRzXFNjaGVtZXNcQXBwc1wuRGVmYXVsdFxN QUdJQ01lbnVDb21tYW5kXC5DdXJyZW50AAngAACDAP4ABgG3BbDsS3tXBKj4twVwLtcFIQDwAAEA BgAfAEMBAAAAACYAHwAAANYUBQDEFvcXWvisAx8DhAxDAR8AJgAlACcAHwAmACUAJwAAAK41AADE Na41jwcfAgAAAADHAP1VrjUCAAAAAgCvNQDzrjUGGwcL4uzAHZUG9xf7Bq41AABI7boAAAA27TgC SO3HMfTsxzEbA98TAACuNU1BR0lDTWVudUNvbW1hbmQAAwAAQO0tJG8YAAD+////BRAczyRFAgDH MSRFAgDC7gIAiwAAANYUDQBO9wAAACAFANztnQOTAAEQSO3HMQwF9xcAAAD///8FEBzPFAIkRQIA VAAM7hQL9zUAAP7///8FEBzPFAIQAhIAAAB+7RkAQwEYABkAPwwvASwAAAAAFAARAAAIiwALCBxI sKDBgwgPAlioQMFChg4XGgQQoKKAigEEXKwIYCLGjRk1ZuxYUMGAAwMMnEyZkkABBQYVJAgwsybN mzALUrRYcQDIACQJAkAgAEEAokaTAp04M6kAA0eLCgg6UAHGq1hzErQasifIAVoH7sz4kSdVgQCa RoVKFOrZAg8bPgQgV2LCu3jzBgQAOw== } #end image Select all ######################## #Copy Image set imcopy { R0lGODlhEAAQAPcAAAAAAM7Ozv////////////////////////////////////////////////// //////////////////////////////////////////////////////////////////////////// //////////////////////////////////////////////////////////////////////////// //////////////////////////////////////////////////////////////////////////// //////////////////////////////////////////////////////////////////////////// //////////////////////////////////////////////////////////////////////////// //////////////////////////////////////////////////////////////////////////// //////////////////////////////////////////////////////////////////////////// //////////////////////////////////////////////////////////////////////////// //////////////////////////////////////////////////////////////////////////// //////////////////////////////////////////////////////////////////////////// //////////////////////////////////////////////////////////////////////////// //////////////////////////////////////////////////////////////////////////// /////////////////////////////////////////////////////yH5BAEAAAEALAAAAAAQABAA AAhSAAEIHEhwYICDAP4pXMjwH4CDARISbOgQokSBFCsidDiQ4sONFxNyLChSoUiMDFGmdNhQpcmX KUuOdMlxoUyPJW+2zJnRJs+eM2m2hBiRZMGAAAA7 } #End Copy Image ############################ #Image Cut set imcut { R0lGODlhEAAQAPcAAAAAAMbGxv////////////////////////////////////////////////// //////////////////////////////////////////////////////////////////////////// //////////////////////////////////////////////////////////////////////////// //////////////////////////////////////////////////////////////////////////// //////////////////////////////////////////////////////////////////////////// //////////////////////////////////////////////////////////////////////////// //////////////////////////////////////////////////////////////////////////// //////////////////////////////////////////////////////////////////////////// //////////////////////////////////////////////////////////////////////////// //////////////////////////////////////////////////////////////////////////// //////////////////////////////////////////////////////////////////////////// //////////////////////////////////////////////////////////////////////////// //////////////////////////////////////////////////////////////////////////// /////////////////////////////////////////////////////yH5BAEAAAEALAAAAAAQABAA AAhEAAMIHCgQAMGDCA0iXBhAocB/DhMOhMiw4MOICw1SrFhwI8eGGAcCGEnSI8GIJBk6VBhS5EiX LSU2/DizJkeWNEEeDAgAOw== } #End Image Cut ####### #Image Paste set impaste { R0lGODlhEAAQAPcAAAAAAAAAY2NjY8bGxv////////////////////////////////////////// //////////////////////////////////////////////////////////////////////////// //////////////////////////////////////////////////////////////////////////// //////////////////////////////////////////////////////////////////////////// //////////////////////////////////////////////////////////////////////////// //////////////////////////////////////////////////////////////////////////// //////////////////////////////////////////////////////////////////////////// //////////////////////////////////////////////////////////////////////////// //////////////////////////////////////////////////////////////////////////// //////////////////////////////////////////////////////////////////////////// //////////////////////////////////////////////////////////////////////////// //////////////////////////////////////////////////////////////////////////// //////////////////////////////////////////////////////////////////////////// /////////////////////////////////////////////////////yH5BAEAAAMALAAAAAAQABAA AAhgAAcIHEiwoMEBABICOIhQIQABAhwuFAjgn8WHCSNa/DexIkeIIDVypHhRYsKLJDeqVNlxZYCX MF+m3BjAZYCZFmuqrHnTI81/MIHK9JlzZU6ENmPypOhQp8uDSmMyZBgQADs= } #End Image Past ####################### ######################## #Image Ptint set imprint { R0lGODdhEwATAPcAAAAAAP8AAABtAACSAG1tVZJtVW2SVZKSVW1tqpJtqm2SqpKSqra2qtu2qrbb qtvbqrOzs7a2/7bb/9v//////20/Azb1AgBk6wIACAD/AacrAAABAMk7AADzAuA/AAAAAAAAAAAA AEAGAAAAAAAA9wPWFE4ifwMJAAAA1hQ29QIAkOwCAAAyVwQBAA5gAAAAAAAAVuvHMYT1twVQUiAD WAJABgEQAAAAAEAGAAAAAAAAAAAAABMBCeAABDAA1hQfBR8DWAUfAwAAAAACAOrrAgAIAB8BpysA AAEANQIBAQYAAQAAANYUZAAAAAIANQIAAC8AFAAaAFYAJwBlAAAAAAAAQPdeAAC3BSHsAAAAAAAA AADHMQAAAADc68cxhPW3BUIAnhcEAMjsxzEGAAEAJQAfAHoCSezg60nsTiOvBwgD3xOPEwwFSO0a AC8A///3/wAACAPfE8cDAAD//wAAHwAgAPLrCiavBxjsxzF6At8TUezHMeDsJwHXExjsxzGLax8B jxPg7EsB1xPc7McxSO3HMRjsxzEBAACAQXBwRXZlbnRzXFNjaGVtZXNcQXBwc1wuRGVmYXVsdFxN QUdJQ01lbnVDb21tYW5kXC5DdXJyZW50AAngAACDAP4ABgG3BbDsS3tXBIT1twVwLtcFIQDwAAEA BgAfAEMBAAAAACYAHwAAANYUBQDEFvcXNvWsAx8DRAhDAR8AJgAlACcAHwAmACUAJwAAAK41AADE Na41jwcfAgAAAADHAP1VrjUCAAAAAgCvNQDzrjUGGwcL4uzAHZUG9xf7Bq41AABI7boAAAA27TgC SO3HMfTsxzEbA98TAACuNU1BR0lDTWVudUNvbW1hbmQAAwAAQO0tJG8YAAD+////BRAczyRFAgDH MSRFAgDC7gIAiwAAANYUDQBC9gAAACAFANzt9xcUAiRF9xddJrcHOwCBAFLtxzGEAAIAFAIFACsA GwNTAhQL9zUAAP7///8FEBzPFAKa7Q9Hnwc7AIEAJEUCAPcXgEUCACwAAAAAEwATAAAIjAAhCBxI sKDBgwgLAljIsOHCgwAoSJxIEQBECgspTrRoMCLFCRRAYrzokOHIjhJFauSoEGPJiCwHZpwIsqZL hS9LEly4gIACAgkIHEBQwEACAw8heNTIdKNSCgyiNmDgIOoAAQwCBIhqMWLUr2DBRnDQFWoDCQwi NFCL1kGEtA+65pwrkGFCpUnvJgwIADs= } #End Pint Image ########################### #Image Protocol set improtocol { R0lGODdhEgASAPcAAAAAAG0AAJIAAP8AAG0AVZIAVW1tVZJtVW2SVZKSVW0AqpIAqm1tqpJtqm2S qpKSqra2qtu2qrbbqrOzs7a2/9u2/7bb/9vb/9v//////6crAAABAMk7AADzAuA/AAAAAAAAAAAA AEAGAAAAAAAA9wPWFE4ifwMJAAAA1hQ6+gIAkOwCAAAyVwQBAA5gAAAAAAAAVuvHMYj6twVQUiAD WAJABgEQAAAAAEAGAAAAAAAAAAAAABMBCeAABDAA1hQfBR8DWAUfAwAAAAACAOrrAgAIAB8BpysA AAEANQIBAQYAAQAAANYUZAAAAAIANQIAAC8AFAAaAFYAJwBlAAAAAAAAQPdeAAC3BSHsAAAAAAAA AADHMQAAAADc68cxiPq3BUIAnhcEAMjsxzEGAAEAJQAfAHoCSezg60nsTiOvBwgD3xOPEwwFSO0a AC8A///3/wAACAPfE8cDAAD//wAAHwAgAPLrCiavBxjsxzF6At8TUezHMeDsJwHXExjsxzGLax8B jxPg7EsB1xPc7McxSO3HMRjsxzEBAACAQXBwRXZlbnRzXFNjaGVtZXNcQXBwc1wuRGVmYXVsdFxN QUdJQ01lbnVDb21tYW5kXC5DdXJyZW50AAngAACDAP4ABgG3BbDsS3tXBIj6twVwLtcFIQDwAAEA BgAfAEMBAAAAACYAHwAAANYUBQDEFvcXOvqsAx8DeAtDAR8AJgAlACcAHwAmACUAJwAAAK41AADE Na41jwcfAgAAAADHAP1VrjUCAAAAAgCvNQDzrjUGGwcL4uzAHZUG9xf7Bq41AABI7boAAAA27TgC SO3HMfTsxzEbA98TAACuNU1BR0lDTWVudUNvbW1hbmQAAwAAQO0tJG8YAAD+////BRAczyRFAgDH MSRFAgDC7gIAiwAAANYUDQBO9wAAACAFANztnQOTAAEQSO3HMQwF9xcAAAD///8FEBzPFAIkRQIA VAAM7hQL9zUAAP7///8FEBzPFAIQAhIAAAB+7RkAQwEYABkADwwvASwAAAAAEgASAAAItAAnCBxI sKDBgwMBAEB4EMCChQYVFnQIcaKAigoVVCQIQMAAhQofFICQQWJCAQoGPIDwwMACBxkwZIBgsmNK BywVMsjAM0MAAQI7LlBJcyXPCxAuLAA6oSOBAQcYJICA4AACqkMhOh1wFQIECV55mmyKkqtXChQg UBDLEaUAnF4thC3ZVsEBChEsRJCwl23CBSR7Zqjw4IDXjQICOEiwmMEBBw0cRN3YNMBPAZgx/wzA sPPAgAA7 } #Emd Img Protocol ########################### #Image Chart Loader set imchart { R0lGODdhFQATAPcAAAAAAG1tVZKSVW1tqpKSqra2qrbbqtvbqrOzs8zMzLa2/9vb/////xdkPrcH AACmAsABAgAFAIQKAgAFAAAApG0/Azr6AgBk6wIACAACAacrAAABAMk7AAAG6+A/AAAAAAAAAAAA AEAGAAAAAAAA9wPWFE4ifwMJAAAA1hQ6+gIAkOwCAAAyVwQBAA5gAAAAAAAAVuvHMYj6twVQUiAD WAJABgEQAAAAAEAGAAAAAAAAAAAAABMBCeAABDAA1hQfBR8DWAUfAwAAAAACAOrrAgAIAB8BpysA AAEANQIBAQYAAQAAANYUZAAAAAIANQIAAC8AFAAaAFYAJwBlAAAAAAAAQPdeAAC3BSHsAAAAAAAA AADHMQAAAADc68cxiPq3BUIAnhcEAMjsxzEGAAEAJQAfAHoCSezg60nsTiOvBwgD3xOPEwwFSO0a AC8A///3/wAACAPfE8cDAAD//wAAHwAgAPLrCiavBxjsxzF6At8TUezHMeDsJwHXExjsxzGLax8B jxPg7EsB1xPc7McxSO3HMRjsxzEBAACAQXBwRXZlbnRzXFNjaGVtZXNcQXBwc1wuRGVmYXVsdFxN QUdJQ01lbnVDb21tYW5kXC5DdXJyZW50AAngAACDAP4ABgG3BbDsS3tXBIj6twVwLtcFIQDwAAEA BgAfAEMBAAAAACYAHwAAANYUBQDEFvcXOvqsAx8DqAdDAR8AJgAlACcAHwAmACUAJwAAAK41AADE Na41jwcfAgAAAADHAP1VrjUCAAAAAgCvNQDzrjUGGwcL4uzAHZUG9xf7Bq41AABI7boAAAA27TgC SO3HMfTsxzEbA98TAACuNU1BR0lDTWVudUNvbW1hbmQAAwAAQO0tJG8YAAD+////BRAczyRFAgDH MSRFAgDC7gIAiwAAANYUDQBa+AAAACAFANztnQOTAAEQSO3HMQwF9xcAAAD///8FEBzPFAIkRQIA VAAM7hQL9zUAAP7///8FEBzPFAIQAhIAAAB+7RkAQwEYABkArwsvASwAAAAAFQATAAAIgQARCBxI sKDBgwgTEgTAkKHChQASSDyQAMBDBAAIHFCwcSMBiwoBFFBQYAGDkwUACEgI4ECBlxsLMBgJ8qDI Ai5fynxZ0yCABSWDAgXas2DLkUFJ0mQ5IChMnEV9EtCJ08DHqEZv8ryJNatDlTwvGp2aUuxCsl1Z BnBodiDbtgcDAgA7 } #End Loader ########################### #Image Image loader set imeye { R0lGODdhFAARAPcAAAAAAAAAVW1tVZKSVQAAqm1tqpKSqra2qtvbqrOzswAA/////7cFBwCu68cx XwA/ADr65gUAAHLrAAEFAAAApG0/A0L2AgBk6wIACAD/AacrAAABAMk7AADzAuA/AAAAAAAAAAAA AEAGAAAAAAAA9wPWFE4ifwMJAAAA1hRC9gIAkOwCAAAyVwQBAA5gAAAAAAAAVuvHMZD2twVQUiAD WAJABgEQAAAAAEAGAAAAAAAAAAAAABMBCeAABDAA1hQfBR8DWAUfAwAAAAACAOrrAgAIAB8BpysA AAEANQIBAQYAAQAAANYUZAAAAAIANQIAAC8AFAAaAFYAJwBlAAAAAAAAQPdeAAC3BSHsAAAAAAAA AADHMQAAAADc68cxkPa3BUIAnhcEAMjsxzEGAAEAJQAfAHoCSezg60nsTiOvBwgD3xOPEwwFSO0a AC8A///3/wAACAPfE8cDAAD//wAAHwAgAPLrCiavBxjsxzF6At8TUezHMeDsJwHXExjsxzGLax8B jxPg7EsB1xPc7McxSO3HMRjsxzEBAACAQXBwRXZlbnRzXFNjaGVtZXNcQXBwc1wuRGVmYXVsdFxN QUdJQ01lbnVDb21tYW5kXC5DdXJyZW50AAngAACDAP4ABgG3BbDsS3tXBJD2twVwLtcFIQDwAAEA BgAfAEMBAAAAACYAHwAAANYUBQDEFvcXQvasAx8DMApDAR8AJgAlACcAHwAmACUAJwAAAK41AADE Na41jwcfAgAAAADHAP1VrjUCAAAAAgCvNQDzrjUGGwcL4uzAHZUG9xf7Bq41AABI7boAAAA27TgC SO3HMfTsxzEbA98TAACuNU1BR0lDTWVudUNvbW1hbmQAAwAAQO0tJG8YAAD+////BRAczyRFAgDH MSRFAgDC7gIAiwAAANYUDQA6+gAAACAFANztnQOTAAEQSO3HMQwF9xcAAAD///8FEBzPFAIkRQIA VAAM7hQL9zUAAP7///8FEBzPFAIQAhIAAAB+7RkAQwEYABkA7wsvASwAAAAAFAARAAAIewATCBxI sKBBggASKlR4UODChwsNQgRQkCHCiQkvVlRooGJDjAkFCKD4UWEAAgE4ktyYkIBLAghUsjQgQMHJ kwUWRByocOQBlCgPLNCZ8SKAAzSDDt3pEABNAwAGGJBqAGpRowaQGihw4IBFiQsFFBhwtWECiGbB li0YEAA7 } ####################### #Image Help set imhelp { R0lGODdhDgARAPcAAAAAAAAAVQAAqgAA/wAkAAAkVQAkqgAk/wBJAABJVQBJqgBJ/wBtAABtVQBt qgBt/wCSAACSVQCSqgCS/wC2AAC2VQC2qgC2/wDbAADbVQDbqgDb/wD/AAD/VQD/qgD//yQAACQA VSQAqiQA/yQkACQkVSQkqiQk/yRJACRJVSRJqiRJ/yRtACRtVSRtqiRt/ySSACSSVSSSqiSS/yS2 ACS2VSS2qiS2/yTbACTbVSTbqiTb/yT/ACT/VST/qiT//0kAAEkAVUkAqkkA/0kkAEkkVUkkqkkk /0lJAElJVUlJqklJ/0ltAEltVUltqklt/0mSAEmSVUmSqkmS/0m2AEm2VUm2qkm2/0nbAEnbVUnb qknb/0n/AEn/VUn/qkn//20AAG0AVW0Aqm0A/20kAG0kVW0kqm0k/21JAG1JVW1Jqm1J/21tAG1t VW1tqm1t/22SAG2SVW2Sqm2S/222AG22VW22qm22/23bAG3bVW3bqm3b/23/AG3/VW3/qm3//5IA AJIAVZIAqpIA/5IkAJIkVZIkqpIk/5JJAJJJVZJJqpJJ/5JtAJJtVZJtqpJt/5KSAJKSVZKSqpKS /5K2AJK2VZK2qpK2/5LbAJLbVZLbqpLb/5L/AJL/VZL/qpL//7YAALYAVbYAqrYA/7YkALYkVbYk qrYk/7ZJALZJVbZJqrZJ/7ZtALZtVbZtqrZt/7aSALaSVbaSqraS/7a2ALa2Vba2qra2/7bbALbb Vbbbqrbb/7b/ALb/Vbb/qrb//9sAANsAVdsAqtsA/9skANskVdskqtsk/9tJANtJVdtJqttJ/9tt ANttVdttqttt/9uSANuSVduSqtuS/9u2ANu2Vdu2qtu2/9vbANvbVdvbqtvb/9v/ANv/Vdv/qtv/ //8AAP8AVf8Aqv8A//8kAP8kVf8kqv8k//9JAP9JVf9Jqv9J//9tAP9tVf9tqv9t//+SAP+SVf+S qv+S//+2AP+2Vf+2qv+2///bAP/bVf/bqv/b////AP//Vf//qv///yH5BAAAAAAALAAAAAAOABEA QAiLAP8JHEiwYJt/3/7x+zZgwEJbAApKNIjwX8OG3P5BFChnIDcBAxRqjPjv4L99/P5t+4etTaSB jQQ2lBly47+OCTP+85fSZhtbQIMKJSkpkqRGRd1IWkrwYMaEKb8BmCrQjcKZ/GbajCNSILcBAkYK jMltH8OQAm1aTfkPpFmx/7iy7Qp3qt27dv8FBAA7 } #End Image Help image create photo imnew -data $imnew -gamma 1 -height 16 -width 16 -palette 5/5/4 image create photo imopen -data $imopen -gamma 1 -height 16 -width 16 -palette 5/5/4 image create photo imsave -data $imsave -gamma 1 -height 16 -width 16 -palette 5/5/4 image create photo imselectall -data $imselectall #-gamma 1 -palette 5/5/4 image create photo imcopy -data $imcopy -gamma 1 -height 16 -width 16 -palette 5/5/4 image create photo imcut -data $imcut -gamma 1 -height 16 -width 16 -palette 5/5/4 image create photo impaste -data $impaste -gamma 1 -height 16 -width 16 -palette 5/5/4 image create photo imprint -data $imprint image create photo improtocol -data $improtocol image create photo imchart -data $imchart image create photo imeye -data $imeye image create photo imhelp -data $imhelp frame .ed.menubuttons -relief groove -borderwidth 1 pack .ed.menubuttons -side top -fill x -expand yes button .ed.menubuttons.new -image imnew -command {clear_all .ed.text.t} button .ed.menubuttons.open -image imopen -command "clear_all .ed.text.t ; textOpen" button .ed.menubuttons.save -image imsave -command "textSaveAs" button .ed.menubuttons.selectall -image imselectall -height 16 -width 16 -command {.ed.text.t tag add sel 1.0 end} button .ed.menubuttons.copy -image imcopy -command {tk_textCopy .ed.text.t} button .ed.menubuttons.cut -image imcut -command "tk_textCut .ed.text.t" button .ed.menubuttons.paste -image impaste -command "tk_textPaste .ed.text.t" button .ed.menubuttons.print -image imprint -command "printFormat" -width 16 -height 16 button .ed.menubuttons.run -image improtocol -command {run_tcl .ed.text.t} -width 16 -height 16 button .ed.menubuttons.help -image imhelp -command "About" -width 16 -height 16 label .ed.menubuttons.l -text "" -font {Arial 8 normal} pack .ed.menubuttons.new .ed.menubuttons.open .ed.menubuttons.save \ .ed.menubuttons.print .ed.menubuttons.selectall .ed.menubuttons.copy \ .ed.menubuttons.cut .ed.menubuttons.paste .ed.menubuttons.run .ed.menubuttons.help -side left -fill x pack .ed.menubuttons.l -side left -fill x ##################################### bind .ed.menubuttons.new <Enter> ".ed.menubuttons.l config -text {New}" bind .ed.menubuttons.new <Leave> ".ed.menubuttons.l config -text {}" bind .ed.menubuttons.open <Enter> ".ed.menubuttons.l config -text {Open File}" bind .ed.menubuttons.open <Leave> ".ed.menubuttons.l config -text {}" bind .ed.menubuttons.save <Enter> ".ed.menubuttons.l config -text {Save as...}" bind .ed.menubuttons.save <Leave> ".ed.menubuttons.l config -text {}" bind .ed.menubuttons.selectall <Enter> ".ed.menubuttons.l config -text {Select all}" bind .ed.menubuttons.selectall <Leave> ".ed.menubuttons.l config -text {}" bind .ed.menubuttons.copy <Enter> ".ed.menubuttons.l config -text {Copy selected text}" bind .ed.menubuttons.copy <Leave> ".ed.menubuttons.l config -text {}" bind .ed.menubuttons.cut <Enter> ".ed.menubuttons.l config -text {Cut selected text}" bind .ed.menubuttons.cut <Leave> ".ed.menubuttons.l config -text {}" bind .ed.menubuttons.paste <Enter> ".ed.menubuttons.l config -text {Paste selected text}" bind .ed.menubuttons.paste <Leave> ".ed.menubuttons.l config -text {}" bind .ed.menubuttons.print <Enter> ".ed.menubuttons.l config -text {Print formated text}" bind .ed.menubuttons.print <Leave> ".ed.menubuttons.l config -text {}" bind .ed.menubuttons.run <Enter> ".ed.menubuttons.l config -text {Run Tcl}" bind .ed.menubuttons.help <Enter> ".ed.menubuttons.l config -text {Help}" bind .ed.menubuttons.help <Leave> ".ed.menubuttons.l config -text {}" ##################################### #Text widget frame .ed.text text .ed.text.t -wrap none -font {monaco 12} -cursor arrow -yscrollcommand {.ed.text.scrl set} \ -xscrollcommand {.ed.text.scrl2 set} scrollbar .ed.text.scrl -command ".ed.text.t yview" scrollbar .ed.text.scrl2 -command ".ed.text.t xview" -orient hor pack .ed.text.scrl -side right -fill y pack .ed.text.scrl2 -side bottom -fill x pack .ed.text.t -fill both -expand yes pack .ed.text -side left -fill both -expand true bind .ed.text <Enter> "focus .ed.text" } proc About {} { catch [destroy .about] toplevel .about wm resizable .about 0 0 center_win .about grab .about label .about.l -relief groove -bd 3 -font {arial 11 {bold}} -text "\n TkMC v1.0\n Author: Grigoriy Abramov\n \ System Administrator of The Center For Population Economics \n \ The University of Chicago\n \ Questions and bug report send to: \n \ [email protected]\n " pack .about.l bind .about <Enter> "destroy .about" }
ZB If in a current directory there is any broken symlink, the code breaks. So I'm improving it a little...
chw 2017-01-14: this little gem even runs in a slightly modified version on a tablet or smartphone near to you, see http://www.androwish.org/index.html/finfo?name=assets/TkMC1.0/tkmc.tcl