# 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
