Run this Tcl code editor and tester from your Tcl console: Change to the examples directory and
enter "source ed.tcl". The file spynergy.tcl must be in the same directory as ed.tcl.
Source code for the Ed Tcl Code Editor:
#===========================================================================
# "Ed" -- Tcl Editor and Code Tester
# by Mike Doyle
# Copyright (c) 1997 Eolas Technologies Inc.
# Freely modifiable/redistributable under the "Standard Tcl License"
# See http://www.eolas.com/tcl/license.txt for details
wm iconify .
#===========================================================================
# Start / Stop ED GUI Session
#===========================================================================
#----------
# ed_start_gui -- initialize application, start main GUI form
proc ed_start_gui {} {
global _ED ed_mainf tcl_platform new open save copy cut paste search test
#- TOP LEVEL -----------------------------------------
toplevel .ed_mainFrame -background lightgray
wm withdraw .ed_mainFrame
wm title .ed_mainFrame {Ed -- Tcl Editor}
wm geometry .ed_mainFrame +[winfo screenwidth .]+0
#------------------------------------------
set Parent .ed_mainFrame
#------------------------------------------
set Name $Parent.menuframe
frame $Name -background white
pack $Name -anchor nw -expand 0 -fill x -ipadx 0 -ipady 0 \
-padx 0 -pady 0 -side top
#------------------------------------------
set Name $Parent.menuframe.file
set Menu_string($Name) {
{{command} {New} {-command ed_edit_clear -accelerator "ctrl+N" -underline 0}}
{{command} {Open} {-command ed_file_load -accelerator "ctrl+O" -underline 0}}
{{command} {Save} {-command ed_file_save -accelerator "ctrl+S" -underline 0}}
{{separator} {} {}}
{{command} {Exit} {-command ed_stop_gui -underline 1}}
}
construct_menu $Name File $Menu_string($Name)
#------------------------------------------
set Name $Parent.menuframe.edit
set Menu_string($Name) {
{{command} {Copy} {-command ed_edit_copy -accelerator "Ctrl+C" -underline 0}}
{{command} {Cut} {-command "ed_edit_cut" -accelerator "Ctrl+X" -underline 2}}
{{command} {Paste} {-command "ed_edit_paste" -accelerator "Ctrl+V" -underline 0}}
{{separator} {} {}}
{{command} {Search} {-command "ed_edit_searchf" -accelerator "Ctrl+R" -underline 0}}
{{separator} {} {}}
{{command } {Test} {-command "ed_run_package" -accelerator "Ctrl+T" -underline 0}}
}
construct_menu $Name Edit $Menu_string($Name)
#------------------------------------------
set Name $Parent.menuframe.web
set Menu_string($Name) {
{{command} {Get URL} {-command "ed_get_url" -accelerator "Ctrl+G" -underline 0}}
{{tearoff} {no} {}}
}
construct_menu $Name Web $Menu_string($Name)
;##########################################################################
;# This is a test/demo of the cascading menu code.
;# It should be deleted from 'real' code.
# set Name $Parent.menuframe.testcascade
# set Menu_string($Name) {
# {{command} {Get URL} {-command "ed_get_url" -accelerator "Ctrl+G" -underline 0}}
# {{tearoff} {} {no}}
# {{cascade} {Cascading Edits} {
# {{command} {Copy} {-command ed_edit_copy -accelerator "Ctrl+C" -underline 0}}
# {{command} {Cut} {-command "ed_edit_cut" -accelerator "Ctrl+X" -underline 2}}
# {{command} {Paste} {-command "ed_edit_paste" -accelerator "Ctrl+V" -underline 0}}
# {{separator} {} {}}
# {{command} {Search} {-command "ed_edit_searchf" -accelerator "Ctrl+R" -underline 0}}
# }}
# {{cascade} {Cascading File} {
# {{command} {New} {-command ed_edit_clear -accelerator "ctrl+N" -underline 0}}
# {{command} {Open} {-command ed_file_load -accelerator "ctrl+O" -underline 0}}
# {{command} {Save} {-command ed_file_save -accelerator "ctrl+S" -underline 0}}
# {{separator} {} {}}
# {{command} {Exit} {-command ed_stop_gui -underline 1}}
# }}
# }
# construct_menu $Name menutst $Menu_string($Name)
;###########################################################################
set Name $Parent.buttons
frame $Name -background LightGray
pack $Name -anchor nw -side top -expand 0 -fill x -ipadx 0 -ipady 0 \
-padx 0 -pady 0
#-----------------------------------------
construct_button $Parent.buttons.clear $new new.ppm "ed_edit_clear" \
"Clear the screen and edit a new file"
#-----------------------------------------
construct_button $Parent.buttons.load $open open.ppm "ed_file_load" \
"Open an existing file"
#-----------------------------------------
construct_button $Parent.buttons.save $save save.ppm "ed_file_save" \
"Save current file"
#-----------------------------------------
set Name $Parent.buttons.l8
label $Name -background LightGray -text " "
pack $Name -anchor nw -side left -expand 0 -fill x
#-----------------------------------------
construct_button $Parent.buttons.copy $copy copy.ppm "ed_edit_copy"\
"Copy selected object or text"
#-----------------------------------------
construct_button $Parent.buttons.cut $cut cut.ppm "ed_edit_cut"\
"Cut selected object or text"
#-----------------------------------------
construct_button $Parent.buttons.paste $paste paste.ppm "ed_edit_paste" \
"Paste selected object or text"
#-----------------------------------------
construct_button $Parent.buttons.search $search search.ppm "ed_edit_searchf"\
"Search for string in text"
#-----------------------------------------
set Name $Parent.buttons.l15
label $Name -background LightGray -text " "
pack $Name -anchor nw -side left -expand 0 -fill x
#-----------------------------------------
construct_button $Parent.buttons.test $test test.ppm "ed_run_package" \
"Test current Tcl code"
#-----------------------------------------
set Name $Parent.buttons.l17
label $Name -background LightGray -text "0.0"
pack $Name -anchor nw -side right -expand 0 -fill x
set Name $Parent.buttons.l16
label $Name -background LightGray -text " Row.Col: "
pack $Name -anchor nw -side right -expand 0 -fill x
#----------------------------------------
set Name $Parent.mainwin
frame $Name -background white -borderwidth 2 -relief ridge
pack $Name -anchor sw -side left -expand 1 -fill both
#------------------------------------------
set Name $Parent.mainwin.statusframe
frame $Name -background black -borderwidth 0 -relief flat
pack $Name -anchor nw -side bottom -fill x -expand 0
#-------------------------------------------
set Name $Parent.mainwin.statusframe.currentstatus
set _ED(status_widget) $Name
label $Name -background black -font $_ED(courierfont) -foreground green \
-justify left -textvariable _ED(status) -relief ridge
pack $Name -anchor center
#------------------------------------------
wm geometry .ed_mainFrame 640x480+30+30
if {$tcl_platform(platform) == "windows"} {set y 0}
wm minsize .ed_mainFrame 320 240
ed_edit
wm deiconify .ed_mainFrame
update
}
#----------
# ed_stop_gui -- terminate ED GUI application, clean up session
proc ed_stop_gui {} {
ed_wait_if_blocked
exit
}
#; ------------------------------
#; Constructs and packs a menubutton and menu set
#; construct_menu {Name label cmd_list}
#; Name: The name of this menubutton
#; cmd_list: The list of commands defining the menu choices
#:
#; cmd_list Format: {menuID MenuName ExtraCmds}
#; menuID: Defines the type of menu to create. Options are:
#; separator - Makes a separator line
#: command - Creates a command menu
#; cascade - Creates a cascading menu
#; MenuName: The name to put in this menu
#: ExtraCmds: Extra args to define this menubutton
#; If menuID is cascade, then ExtraCmds is a list of ID, Name, Cmd lists
proc construct_menu {Name label cmd_list} {
global _ED
menubutton $Name -activebackground gray40 -activeforeground white \
-background white -foreground black -relief flat -text $label -underline 0
incr _ED(menuCount);
set newmenu $Name.m$_ED(menuCount)
$Name configure -menu $newmenu
;# Delete any old window that may be around from previous runs
catch "destroy $newmenu"
;# Create the new menu
eval "menu $newmenu"
eval [list add_items_to_menu $newmenu $cmd_list]
$newmenu configure -activebackground gray40 -activeforeground white \
-background white -foreground black
pack $Name -anchor nw -expand 0 -ipadx 4 -ipady 0 -padx 0 \
-pady 0 -side left
}
#;----------
#; Add a set of menu selections to a menu from a command list
#: add_items_to_menu {newmenu cmdList}
#; menubutton: Name of the window to create a menu in
#; cmdList: A list of commands defining menu items
proc add_items_to_menu {menubutton cmdList} {
global _ED
;# Evaluate each line in the cmdList
foreach cmd $cmdList {
switch [lindex $cmd 0] {
"separator" {
set doit "$menubutton add separator [lindex $cmd 2]"
eval $doit
}
"tearoff" {
if {[string match [lindex $cmd 2] "no"]} {
$menubutton configure -tearoff no
}
}
"command" {
set doit "$menubutton add [lindex $cmd 0] -label {[lindex $cmd 1]} \
[lindex $cmd 2]"
eval $doit
}
"cascade" {
incr _ED(menuCount);
set newmenu $menubutton.m$_ED(menuCount)
set doit "$menubutton add cascade -label {[lindex $cmd 1]} \
-menu $newmenu"
eval $doit
menu $newmenu
add_items_to_menu $newmenu [lindex $cmd 2]
}
}
}
}
#; -----------------------
#; construct_button {Name data cmd helpmsg}
#; Name: Name of the buttone to create
#; data: Hex data defining the button image
#; cmd: The command to execute when this is selected
#; helpmsg: Message to display when cursor passes over button
proc construct_button {Name data file cmd helpmsg} {
global tcl_version
if {[info exists tcl_version] == 0 || $tcl_version < 8.0} {
set im [image create photo -file $file -gamma 1 -height 16 -width 16 -palette 5/5/4]
} else {
set im [image create photo -data $data -gamma 1 -height 16 -width 16 -palette 5/5/4]
}
button $Name -background LightGray -foreground black -activebackground white -image $im \
-relief raised -command "$cmd"
pack $Name -anchor nw -side left -expand 0 -fill x
bind $Name [list ed_status_message -help $helpmsg]
bind $Name {ed_status_message -perm}
}
#===================================================================
# File Forms and functions
#===================================================================
#----------
# ed_file_load -- load a file
proc ed_file_load {} {
global _ED
set _ED(file) [ed_loadsave load]
if {$_ED(file) == ""} {return}
if {![file readable $_ED(file)]} {
ed_error "File \[$_ED(file)\] is not readable."
return
}
ed_wait_if_blocked
set _ED(blockflag) 1
ed_status_message -show "loading file: \"$_ED(file)\" ..."
update
if {[catch "open $_ED(file) r" fd]} {
ed_error "Error while opening $_ED(file): \[$fd\]"
ed_status_message -perm
set _ED(blockflag) 0
return
}
set _ED(package) "[read $fd]"
close $fd
set _ED(temppackage) $_ED(package)
set _ED(packagekeyname) [file tail $_ED(file)]
if {$_ED(packagekeyname) == ""} {set _ED(packagekeyname) $_ED(file)}
if {$_ED(packagekeyname) == ""} {set _ED(packagekeyname) "UNKNOWN"}
ed_edit
ed_status_message -perm
update
set _ED(blockflag) 0
}
#----------
# ed_file_save -- save package to a local file
proc ed_file_save {} {
global _ED
ed_wait_if_blocked
set _ED(blockflag) 1
set _ED(package) "[.ed_mainFrame.mainwin.textFrame.left.text get 1.0 end]"
set _ED(blockflag) 0
set $_ED(file) [ed_loadsave save]
if {$_ED(file) == ""} {return}
if {[file exists $_ED(file)]} {
if {![file writable $_ED(file)]} {
ed_error "File \[$_ED(file)\] is not writable."
return
}
}
ed_wait_if_blocked
set _ED(blockflag) 1
ed_status_message -show "saving file: \"$_ED(file)\" ..."
update
if {[catch "open $_ED(file) w" fd]} {
ed_error "Error opening $_ED(file): \[$fd\]"
ed_status_message -perm
update
set _ED(blockflag) 0
return
}
puts $fd "$_ED(package)"
close $fd
ed_status_message -perm
update
set _ED(blockflag) 0
}
#----------
proc ed_loadsave {loadflag} {
global ed_loadsave _ED
if {![info exists ed_loadsave(pwd)]} {
set ed_loadsave(pwd) [pwd]
set ed_loadsave(filter) "*"
set ed_loadsave(file) ""
}
set ed_loadsave(loadflag) $loadflag
set ed_loadsave(path) ""
set ed_loadsave(done) 0
#- TOP LEVEL -----------------------------------------
toplevel .ed_loadsave -background LightGray
wm withdraw .ed_loadsave
if {[string match $loadflag "load"]} {
wm title .ed_loadsave "Open File"
} else {
wm title .ed_loadsave "Save File"
}
wm geometry .ed_loadsave +[expr \
([winfo screenwidth .]/2) - 173]+[expr ([winfo screenheight .]/2) - 148]
#------------------------------------------
set Parent .ed_loadsave
#------------------------------------------
set Name $Parent.dir
frame $Name -background lightgray
pack $Name -anchor nw -side top
#------------------------------------------
set Name $Parent.dir.e3
entry $Name -background aliceblue -foreground black \
-highlightbackground LightGray -width 35 \
-textvariable ed_loadsave(pwd)
pack $Name -side right -anchor nw -padx 5
bind $Name {ed_loadsavegetentries}
bind $Name {
if [%W selection present] {
%W delete sel.first sel.last
} else {
%W delete insert
}
}
#----------
set Name $Parent.dir.l1
label $Name -background LightGray -text "Directory: "
pack $Name -side right -anchor nw
#------------------------------------------
set Name $Parent.type
frame $Name -background lightgray
pack $Name -anchor nw -side top -fill x
#------------------------------------------
set Name $Parent.type.e7
entry $Name -background aliceblue -foreground black \
-highlightbackground LightGray -width 35 \
-textvariable ed_loadsave(filter)
pack $Name -side right -anchor nw -padx 5
bind $Name {ed_loadsavegetentries}
bind $Name {
if [%W selection present] {
%W delete sel.first sel.last
} else {
%W delete insert
}
}
#
#----------
set Name $Parent.type.l5
label $Name -background LightGray -text "File Type: "
pack $Name -side right -anchor nw
#------------------------------------------
set Name $Parent.file
frame $Name -background lightgray
pack $Name -anchor nw -side top -fill x
#------------------------------------------
set Name $Parent.file.e11
entry $Name -background aliceblue -foreground black \
-highlightbackground LightGray -width 35 \
-textvariable ed_loadsave(file)
pack $Name -side right -anchor nw -padx 5
.ed_loadsave.file.e11 delete 0 end
.ed_loadsave.file.e11 insert 0 $_ED(packagekeyname)
bind $Name {
if [%W selection present] {
%W delete sel.first sel.last
} else {
%W delete insert
}
}
bind $Name {if {[ed_loadsavevalentry]} {set ed_loadsave(done) 1}}
#------------------------------------------
set Name $Parent.file.l9
label $Name -background LightGray -text "File: "
pack $Name -side right -anchor nw
#------------------------------------------
set Name $Parent.list
frame $Name -background LightGray -borderwidth 2 -height 50 \
-highlightbackground LightGray -relief raised -width 50
pack $Name -side top -anchor nw -expand yes -fill both
#------------------------------------------
set Name $Parent.list.lb1
listbox $Name -background aliceblue -font $_ED(courierfont) \
-foreground black \
-highlightbackground LightGray -selectbackground LightBlue \
-selectforeground black \
-yscrollcommand "$Parent.list.sb2 set" -selectmode browse
pack $Name -anchor center -expand 1 -fill both -ipadx 0 -ipady 0 \
-padx 2 -pady 2 -side left
bind $Name {ed_loadsaveselbegin %W %y}
bind $Name {ed_loadsaveselbegin2 %W}
bind $Name {ed_loadsaveselbegin %W %y}
bind $Name {ed_loadsaveselbegin %W %y}
bind $Name {set _ED(packagekeyname) \
$seld_file; ed_loadsaveselend %W %y}
bind $Name {break}
bind $Name {break}
bind $Name {ed_loadsaveselend %W %y}
bind $Name {
tkCancelRepeat
tkListboxBeginSelect %W [%W index active]
%W activate [%W index active]
}
bind $Name {
tkCancelRepeat
tkListboxBeginSelect %W [%W index active]
%W activate [%W index active]
}
#------------------------------------------
set Name $Parent.list.sb2
scrollbar $Name -activebackground plum -activerelief sunken \
-background LightGray -command "$Parent.list.lb1 yview" \
-highlightbackground LightGray -troughcolor gray40
pack $Name -anchor center -expand 0 -fill y -ipadx 0 -ipady 0 \
-padx 2 -pady 2 -side left
#----------
set Name $Parent.buttons
frame $Name -background lightgray
pack $Name -side top -anchor nw -fill x
#------------------------------------------
set Name $Parent.buttons.ok
button $Name -activebackground lavender -background gray40 \
-foreground white -highlightbackground LightGray -text OK \
-command {set _ED(packagekeyname) [.ed_loadsave.file.e11 get]; if \
{[ed_loadsavevalentry]} {set ed_loadsave(done) 1}}
pack $Name -side left -anchor nw -padx 3 -pady 3
#------------------------------------------
set Name $Parent.buttons.cancel
button $Name -activebackground lavender -background gray40 \
-foreground white -highlightbackground LightGray -text Cancel \
-command {destroy .ed_loadsave}
pack $Name -side right -anchor nw -padx 3 -pady 3
ed_loadsavegetentries
wm deiconify .ed_loadsave
vwait ed_loadsave(done)
destroy .ed_loadsave
if {[file isdirectory $ed_loadsave(path)]} {set ed_loadsave(path) ""}
return $ed_loadsave(path)
}
proc ed_loadsaveselbegin {win ypos} {
$win select anchor [$win nearest $ypos]
}
proc ed_loadsaveselbegin2 {win} {
global seld_file
set seld_file [$win get [$win curselection]]
.ed_loadsave.file.e11 delete 0 end
.ed_loadsave.file.e11 insert 0 $seld_file
set _ED(packagekeyname) $seld_file
}
proc ed_loadsaveselend {win ypos} {
global ed_loadsave
$win select set anchor [$win nearest $ypos]
set fil [.ed_loadsave.list.lb1 get [lindex [$win curselection] 0]]
if {-1 == [string last "/" $fil]} {
set ed_loadsave(file) $fil
set ed_loadsave(path) \
[eval file join $ed_loadsave(pwd) $ed_loadsave(file)]
set ed_loadsave(done) 1
return ""
}
set ed_loadsave(pwd) [ed_loadsavemergepaths \
$ed_loadsave(pwd) [string trimright $fil "/"]]
ed_loadsavegetentries
return ""
}
proc ed_loadsavegetentries {} {
global ed_loadsave tcl_version
set e 0
if {![file isdirectory $ed_loadsave(pwd)]} {
gui_error "\"$ed_loadsave(pwd)\" is not a valid directory"
.ed_loadsave configure -cursor {}
set e 1
}
.ed_loadsave configure -cursor watch
update
set sort_mode "-dictionary"
if {[info exists tcl_version] == 0 || $tcl_version < 8.0} {
set sort_mode "-ascii"
}
if {$ed_loadsave(filter) == ""} {set ed_loadsave(filter) "*"}
set files [lsort $sort_mode "[glob -nocomplain $ed_loadsave(pwd)/.*] \
[glob -nocomplain $ed_loadsave(pwd)/*]"]
.ed_loadsave.list.lb1 delete 0 end
if {$e} {
.ed_loadsave configure -cursor {}
update
return
}
set d "./ ../"
set fils ""
foreach f $files {
set ff [file tail $f]
if {$ff != "." && $ff != ".."} {
if {[file isdirectory $f]} {
lappend d "$ff/"
} else {
if {[string match $ed_loadsave(filter) $ff]} {
lappend fils "$ff"
}
}
}
}
set files "$d $fils"
foreach f $files {
.ed_loadsave.list.lb1 insert end $f
}
.ed_loadsave configure -cursor {}
update
}
proc ed_loadsavevalentry {} {
global ed_loadsave _ED
if {"." != [file dirname $ed_loadsave(file)]} {
set path [ed_loadsavemergepaths \
$ed_loadsave(pwd) $ed_loadsave(file)]
set ed_loadsave(pwd) [file dirname $path]
if {[file extension $path] != ""} {
set ed_loadsave(filter) "*[file extension $path]"
} else {
set ed_loadsave(filter) "*"
}
set ed_loadsave(file) [file tail $path]
ed_loadsavegetentries
return 0
}
set fil [ed_loadsavemergepaths $ed_loadsave(pwd) $ed_loadsave(file)]
if {[string match $ed_loadsave(loadflag) "load"]} {
if {(![file exists $fil]) || (![file readable $fil])} {
gui_error "\"$fil\" cannot be loaded."
set ed_loadsave(path) ""
return 0
} else {
set ed_loadsave(path) $fil
set _ED(file) $fil
set ed_loadsave(done) 1
return 1
}
} else {
set d [file dirname $fil]
if {![file writable $d]} {
gui_error "\"$d\" directory cannot be written to."
set ed_loadsave(path) ""
set _ED(file) ""
return 0
}
if {[file exists $fil] && (![file writable $fil])} {
gui_error "\"$file\" cannot be written to."
set ed_loadsave(path) ""
set _ED(file) ""
return 0
}
set ed_loadsave(path) $fil
set ed_loadsave(done) 1
set _ED(file) $fil
return 1
}
}
proc ed_loadsavemergepaths {patha pathb} {
set pa [file split $patha]
set pb [file split $pathb]
if {[string first ":" [lindex $pb 0]] != -1} {return [eval file join $pb]}
if {[lindex $pb 0] == "/"} {return [eval file join $pb]}
set i [expr [llength $pa] - 1]
foreach item $pb {
if {$item == ".."} {
incr i -1
set pa [lrange $pa 0 $i]
} elseif {$item == "."} {
# -- do nothing
} else {
lappend pa $item
}
}
return [eval file join $pa]
}
proc gui_error {message} {
catch "destroy .xxx"
bell
tk_dialog .xxx "Error" "$message" warning 0 Close
}
if {[info procs bgerror] == ""} {
proc bgerror {{message ""}} {
global errorInfo
puts stderr $errorInfo
}
}
#====================================================================
# Edit Selected Package
#====================================================================
#------------
# search form
proc ed_edit_searchf {} {
global _ED
catch "destroy .ed_edit_searchf"
#- TOP LEVEL -----------------------------------------
toplevel .ed_edit_searchf -background LightGray
wm withdraw .ed_edit_searchf
wm title .ed_edit_searchf {Search}
#------------------------------------------
set Parent .ed_edit_searchf
#------------------------------------------
set Name $Parent.f1
frame $Name -background lightgray
pack $Name -anchor nw -fill x -side top -padx 5
set Name $Parent.f1.l1
label $Name -text "Search for " -background lightgray
pack $Name -anchor nw -fill x -side left -padx 5
#------------------------------------------
set Name $Parent.f1.e1
entry $Name -background aliceblue -font $_ED(courierfont) \
-highlightbackground LightGray -selectbackground blue \
-selectforeground white -width 31
pack $Name -anchor nw -side left
bind .ed_edit_searchf.f1.e1 {
if [%W selection present] {
%W delete sel.first sel.last
} else {
%W delete insert
}
}
bind .ed_edit_searchf.f1.e1 {tk_focusNext %W}
$Name delete 0 end
#------------------------------------------
set Name $Parent.replace
frame $Name -background lightgray
pack $Name -anchor nw -side top -fill x -padx 5 -pady 5
set Name $Parent.replace.l1
label $Name -text "Replace with" -background lightgray
pack $Name -anchor nw -fill x -side left -padx 5
set Name $Parent.replace.e1
entry $Name -background aliceblue -font $_ED(courierfont) \
-highlightbackground LightGray -selectbackground blue \
-selectforeground white -width 30
pack $Name -anchor nw -side left
global Procs
set Procs($Name) { {bind .ed_edit_searchf.replace.e1 } \
{bind .ed_edit_searchf.replace.e1 } \
{bind .ed_edit_searchf.replace.e1 } \
{bind .ed_ediy_searchf.replace.e1 }}
bind .ed_edit_searchf.replace.e1 {tkEntryBackspace %W}
bind .ed_edit_searchf.replace.e1 {
if [%W selection present] {
%W delete sel.first sel.last
} else {
%W delete insert
}
}
bind .ed_edit_searchf.replace.e1 {tk_focusNext %W}
$Name delete 0 end
set Name $Parent.mainwin
frame $Name -background lightgray
pack $Name -anchor nw -side top -fill x -padx 5 -pady 5
#----------
set Name $Parent.mainwin.b1
button $Name -activebackground lavender -background gray40 \
-command {
set _ED(srch_new) [.ed_edit_searchf.f1.e1 get]
if {$_ED(srch_new) != $_ED(srch_old)} {set _ED(editcursor) 1.0}
ed_edit_search .ed_mainFrame.mainwin.textFrame.left.text $_ED(srch_new)
set _ED(srch_old) [.ed_edit_searchf.f1.e1 get]
focus .ed_mainFrame.mainwin.textFrame.left.text
raise .ed_edit_searchf
} \
-foreground white -highlightbackground LightGray \
-text {Search}
pack $Name -anchor nw -side left
#------------------------------------------
set Name $Parent.mainwin.b2
button $Name -activebackground lavender -background gray40 \
-command {
if {[.ed_mainFrame.mainwin.textFrame.left.text get sel.first sel.last] != ""} {
if {[.ed_mainFrame.mainwin.textFrame.left.text tag ranges sel] == ""} {
set _ED(rplc_term) [.ed_edit_searchf.replace.e1 get]
.ed_mainFrame.mainwin.textFrame.left.text insert $_ED(editcursor) $_ED(rplc_term)
.ed_mainFrame.mainwin.textFrame.left.text delete sel.first sel.last
raise .ed_edit_searchf
} }
} \
-foreground white -highlightbackground LightGray \
-text {Replace}
pack $Name -anchor nw -side left
#------------------------------------------
set Name $Parent.mainwin.b3
button $Name -activebackground Lavender -background gray40 \
-command {destroy .ed_edit_searchf} -foreground white \
-highlightbackground LightGray -text Close
pack $Name -anchor nw -side right
#----------
set x [expr [winfo rootx .ed_mainFrame] + 300]
set y [expr [winfo rooty .ed_mainFrame] + [winfo height .ed_mainFrame] - 300]
wm geometry .ed_edit_searchf +$x+$y
wm deiconify .ed_edit_searchf
raise .ed_edit_searchf
update
wm minsize .ed_edit_searchf [winfo width .ed_edit_searchf] \
[winfo height .ed_edit_searchf]
wm maxsize .ed_edit_searchf [winfo width .ed_edit_searchf] \
[winfo height .ed_edit_searchf]
}
#----------
# ed_edit_search -- search for entered text string
proc ed_edit_search {textwin srch_string} {
global _ED
if {$srch_string == ""} {set _ED(editcursor) 1.0; return}
set length 0;
set fail [catch {\
$textwin search -regexp -count length $srch_string $_ED(editcursor) end} \
_ED(editcursor) ]
if { ($length != 0) && (!$fail) } {
$textwin tag add sel $_ED(editcursor) "$_ED(editcursor) + $length char"
set _ED(editcursor) [$textwin index "$_ED(editcursor) + $length char"]
$textwin see $_ED(editcursor)
} else {set _ED(editcursor) 1.0}
if {$_ED(editcursor) == 1.0} {ed_error "No match for string"; return}
if {$_ED(editcursor) == $_ED(editcurold)} {ed_error "End of search"}
set _ED(editcurold) $_ED(editcursor)
}
#----------
# ed_edit_clear -- clear the edit area
proc ed_edit_clear {} {
global _ED
ed_wait_if_blocked
set _ED(blockflag) 1
set _ED(temppackage) ""
set _ED(blockflag) 0
if {[info commands .ed_mainFrame.mainwin.f1] != ""} {
.ed_mainFrame.mainwin.textFrame.left.text delete 1.0 end
set _ED(packagekeyname) [.ed_mainFrame.mainwin.f1.e5 get]
}
set _ED(package) ""
set _ED(packagekeyname) ""
ed_edit
}
#----------
# ed_edit_commit -- commit editing changes to the current package
proc ed_edit_commit {} {
global _ED
ed_wait_if_blocked
set _ED(blockflag) 1
set _ED(package) "[.ed_mainFrame.mainwin.textFrame.left.text get 1.0 end]"
set _ED(blockflag) 0
update
}
#-----------
# ed_edit_cut
proc ed_edit_cut {} {
tk_textCut .ed_mainFrame.mainwin.textFrame.left.text
}
#-----------
# ed_edit_copy
proc ed_edit_copy {} {
tk_textCopy .ed_mainFrame.mainwin.textFrame.left.text
}
#-----------
# ed_edit_paste
proc ed_edit_paste {} {
tk_textPaste .ed_mainFrame.mainwin.textFrame.left.text
}
#----------
# ed_edit -- bring up the edit window for the current package
proc ed_edit {} {
global _ED
global Menu_string
catch "destroy .ed_mainFrame.mainwin.mainwin"
catch "destroy .ed_mainFrame.mainwin.buttons"
catch "destroy .ed_mainFrame.mainwin.f1"
catch "destroy .ed_mainFrame.mainwin.textFrame"
#------------------------------------------
set Parent .ed_mainFrame.mainwin
#-----------------------------------------
set Name $Parent.mainwin
frame .ed_mainFrame.mainwin.mainwin -background lightgray
pack .ed_mainFrame.mainwin.mainwin -anchor nw -side bottom -fill x
#------------------------------------------
set Name $Parent.textFrame
frame $Name -background LightGray -borderwidth 2 \
-highlightbackground LightGray -relief raised
pack $Name -anchor sw -expand 1 -fill both -side bottom
#------------------------------------------
set Name $Parent.textFrame.right
frame $Name -background LightGray -height 10 \
-highlightbackground LightGray -width 15
pack $Name -anchor sw -expand 0 -fill x -ipadx 0 -ipady 0 -padx 0 \
-pady 0 -side bottom
#------------------------------------------
set Name $Parent.textFrame.right.vertScrollbar
scrollbar $Name -activebackground plum -activerelief sunken \
-background LightGray -command "$Parent.textFrame.left.text xview" \
-highlightbackground LightGray -orient horizontal -troughcolor gray40 \
-elementborderwidth 1
pack $Name -anchor center -expand 1 -fill x -ipadx 0 -ipady 0 -padx 0 \
-pady 0 -side left
#------------------------------------------
set Name $Parent.textFrame.right.buttons0
frame $Name -background LightGray -height 10 \
-highlightbackground LightGray -width 15
pack $Name -anchor se -expand 0 -fill x -ipadx 0 -ipady 0 -padx 2 \
-pady 2 -side bottom
#------------------------------------------
set Name $Parent.textFrame.left
frame $Name -background LightGray \
-highlightbackground LightGray
pack $Name -anchor center -expand 1 -fill both -ipadx 0 -ipady 0 \
-padx 0 -pady 0 -side top
#------------------------------------------
set Name $Parent.textFrame.left.horizScrollbar
scrollbar $Name -activebackground plum -activerelief sunken \
-background LightGray -command "$Parent.textFrame.left.text yview" \
-highlightbackground LightGray -troughcolor gray40 \
-elementborderwidth 1
pack $Name -anchor center -expand 0 -fill y -ipadx 0 -ipady 0 \
-padx 0 -pady 0 -side right
#------------------------------------------
set Name $Parent.textFrame.left.text
text $Name -background AliceBlue -borderwidth 2 -foreground black \
-highlightbackground LightGray -insertbackground black \
-selectbackground lightblue -selectforeground black \
-wrap none \
-xscrollcommand "$Parent.textFrame.right.vertScrollbar set" \
-yscrollcommand "$Parent.textFrame.left.horizScrollbar set"
$Name insert end {
}
pack $Name -anchor center -expand 1 -fill both -ipadx 0 -ipady 0 \
-padx 0 -pady 0 -side top
####-----------
bind $Parent.textFrame.left.text \
{.ed_mainFrame.buttons.l17 configure -text \
[.ed_mainFrame.mainwin.textFrame.left.text index insert]}
bind $Parent.textFrame.left.text \
{.ed_mainFrame.buttons.l17 configure -text \
[.ed_mainFrame.mainwin.textFrame.left.text index insert]}
$Name delete 1.0 end
$Name insert end $_ED(temppackage)
ed_edit_commit
#-----------
update
}
#====================================================================
# Run Selected Package
#====================================================================
# ed_change_button -- change the test button to stop button
proc ed_stop_button {} {
global _ED stop tcl_version
set Name .ed_mainFrame.buttons.test
if {[info exists tcl_version] == 0 || $tcl_version < 8.0} {
set im [image create photo -file stop.ppm -gamma 1 -height 16 -width 16 -palette 5/5/4]
} else {
set im [image create photo -data $stop -gamma 1 -height 16 -width 16 -palette 5/5/4]
}
$Name config -image $im -command "ed_kill_apps"
bind .ed_mainFrame.buttons.test {ed_status_message -help \
"Stop running code"}
}
proc ed_test_button {} {
global _ED test tcl_version
set Name .ed_mainFrame.buttons.test
if {[info exists tcl_version] == 0 || $tcl_version < 8.0} {
set im [image create photo -file test.ppm -gamma 1 -height 16 -width 16 -palette 5/5/4]
} else {
set im [image create photo -data $test -gamma 1 -height 16 -width 16 -palette 5/5/4]
}
$Name config -image $im -command "ed_run_package"
bind .ed_mainFrame.buttons.test {ed_status_message -help \
"Test current code"}
}
#----------
# ed_run_package -- run the currently loaded package
proc ed_run_package {} {
global _ED ed_loadsave argv argv0 argc embed_args
if {"$_ED(package)" == ""} {
ed_status_message -alert "No code currently in run buffer."
update
return
}
ed_kill_apps
ed_edit_commit
.ed_mainFrame configure -cursor watch
ed_status_message -show "running package: $_ED(packagekeyname)"
update
ed_stop_button
# -- create a slave tk interpreter to run the application in
set _ED(runslave) [interp create runslave]
runslave eval {load {} Tk}
set cmd "wm geometry . +100+100"
runslave eval $cmd
set cmd "wm title . [list "Main Window for $_ED(packagekeyname)"]"
runslave eval $cmd
runslave alias exit ed_kill_apps
# runslave eval set argv0 $argv0
# runslave eval set argc $argc
# if {![info exists argv]} {
# runslave eval set argv {}
# } else {
# runslave eval set argv [list "$argv"]
# }
# if {[info exists embed_args]} {
# runslave eval set embed_args $embed_args
# }
ed_wait_if_blocked
if {[catch "$_ED(runslave) eval [list $_ED(package)]" result]} {
ed_status_message -alert "Error occured while running
$_ED(packagekeyname)"
update
bgerror $result
}
ed_status_message -perm
.ed_mainFrame configure -cursor {}
update
set _ED(blockflag) 0
}
#====================================================================
# Stop Executing Apps
#====================================================================
#----------
# ed_kill_apps -- destroys Tk windows, procedures, and variables other
# than those marked as saved
proc ed_kill_apps {args} {
global _ED ed_mainf
if {$_ED(runslave) == ""} {return}
.ed_mainFrame configure -cursor watch
ed_status_message -show "... closing down active GUI applications ..."
update
ed_wait_if_blocked
set _ED(blockflag) 1
catch "interp delete $_ED(runslave)"
set _ED(blockflag) 0
set _ED(runslave) ""
.ed_mainFrame configure -cursor {}
ed_status_message -perm
ed_test_button
update
}
#============================================================================
# Utility Procedures
#============================================================================
#----------
# ed_get_url
proc ed_get_url {} {
global _ED
catch "destroy .ed_get_urlf"
#- TOP LEVEL -----------------------------------------
toplevel .ed_get_urlf -background LightGray
wm withdraw .ed_get_urlf
wm title .ed_get_urlf {Get URL}
#------------------------------------------
set Parent .ed_get_urlf
#------------------------------------------
set Name $Parent.f1
frame $Name -background lightgray
pack $Name -anchor nw -fill x -side top -padx 5
#------------------------------------------
set Name $Parent.f1.e1
entry $Name -background aliceblue -font $_ED(courierfont) \
-highlightbackground LightGray -selectbackground blue \
-selectforeground white -width 30
pack $Name -anchor nw -side right
bind .ed_get_urlf.f1.e1 {
if [%W selection present] {
%W delete sel.first sel.last
} else {
%W delete insert
}
}
bind .ed_get_urlf.f1.e1 {
set url_string [.ed_get_urlf.f1.e1 get]
ed_edit_clear
set _ED(package) [fetchURL $url_string]
.ed_mainFrame.mainwin.textFrame.left.text insert end $_ED(package)
destroy .ed_get_urlf
}
$Name delete 0 end
#------------------------------------------
set Name $Parent.mainwin
frame $Name -background lightgray
pack $Name -anchor nw -side top -fill x -padx 5 -pady 5
#----------
set Name $Parent.mainwin.b1
button $Name -activebackground lavender -background gray40 \
-command {
set url_string [.ed_get_urlf.f1.e1 get]
ed_edit_clear
set _ED(package) [fetchURL $url_string]
.ed_mainFrame.mainwin.textFrame.left.text insert end $_ED(package)
destroy .ed_get_urlf
} \
-foreground white -highlightbackground LightGray \
-text {Get URL}
pack $Name -anchor nw -side left
#------------------------------------------
set Name $Parent.mainwin.b2
button $Name -activebackground Lavender -background gray40 \
-command {destroy .ed_get_urlf} -foreground white \
-highlightbackground LightGray -text Cancel
pack $Name -anchor nw -side right
#----------
set x [expr [winfo rootx .ed_mainFrame] + 300]
set y [expr [winfo rooty .ed_mainFrame] + [winfo height .ed_mainFrame]\
-300]
wm geometry .ed_get_urlf +$x+$y
wm deiconify .ed_get_urlf
raise .ed_get_urlf
update
wm minsize .ed_get_urlf [winfo width .ed_get_urlf] [winfo height
.ed_get_urlf]
wm maxsize .ed_get_urlf [winfo width .ed_get_urlf] [winfo height
.ed_get_urlf]
}
#----------
# ed_status_message -- update the status message in the main form
proc ed_status_message {option {message ""}} {
global _ED
set _ED(status) "Now editing file: $_ED(packagekeyname)"
set _ED(permstatus) "Now editing file: $_ED(packagekeyname)"
switch -glob -- $option {
-setperm {
set _ED(permstatus) "$message"
set _ED(status) "$message"
}
-temp {
set _ED(status) "$message"
if {$_ED(permstatus) != ""} {
after 1000 "set _ED(status) [list $_ED(permstatus)]"
}
}
-show {
set _ED(status) "$message"
}
-help {
set _ED(status) "$message"
}
-perm {
set _ED(status) "$_ED(permstatus)"
}
-alert {
bell; bell
set _ED(status) "$message"
catch "$_ED(status_widget) configure -foreground white"
catch "$_ED(status_widget) configure -background red"
update
after 2000
catch "$_ED(status_widget) configure -foreground green"
catch "$_ED(status_widget) configure -background black"
if {$_ED(permstatus) != ""} {
set _ED(status) "$_ED(permstatus)"
}
update
}
default {ed_status_message -temp "$message"}
}
}
#----------
# ed_wait_if_blocked -- check and wait for blocked operation to complete
proc ed_wait_if_blocked {} {
global _ED
# -- disable this feature
set _ED(blockflag) 0
return
set i 0
while {$_ED(blockflag)} {
incr i
# -- allow a maximum of 10 seconds of blockage
if {$i > 20} {
set _ED(blockflag) 0
return
}
after 500
}
}
#----------
# ed_error -- display an error pop-up
proc ed_error {message} {
bell
bell
after 100 {
grab -global .xxx
}
tk_dialog .xxx "Weblet Developer - Alert" "$message" warning 0 Close
grab release .xxx
}
#-------------
# Icon image data
set new {
R0lGODlhEAAQAPcAAAAAAMbGxv//////////////////////////////////////////////////
////////////////////////////////////////////////////////////////////////////
////////////////////////////////////////////////////////////////////////////
////////////////////////////////////////////////////////////////////////////
////////////////////////////////////////////////////////////////////////////
////////////////////////////////////////////////////////////////////////////
////////////////////////////////////////////////////////////////////////////
////////////////////////////////////////////////////////////////////////////
////////////////////////////////////////////////////////////////////////////
////////////////////////////////////////////////////////////////////////////
////////////////////////////////////////////////////////////////////////////
////////////////////////////////////////////////////////////////////////////
////////////////////////////////////////////////////////////////////////////
/////////////////////////////////////////////////////yH5BAEAAAEALAAAAAAQABAA
AAhJAAMIHEiwIEEACBMiNCgQwL+HEBcadAjxoUMAEytaTFiQokaLHT9GDCnyH8aDJU2SFHlyoMeP
LRumjBngpUaaCnNKZMizJ8+AAAA7
}
set open {
R0lGODlhEAAPAPcAAAAAAMbGxv//AP//////////////////////////////////////////////
////////////////////////////////////////////////////////////////////////////
////////////////////////////////////////////////////////////////////////////
////////////////////////////////////////////////////////////////////////////
////////////////////////////////////////////////////////////////////////////
////////////////////////////////////////////////////////////////////////////
////////////////////////////////////////////////////////////////////////////
////////////////////////////////////////////////////////////////////////////
////////////////////////////////////////////////////////////////////////////
////////////////////////////////////////////////////////////////////////////
////////////////////////////////////////////////////////////////////////////
////////////////////////////////////////////////////////////////////////////
////////////////////////////////////////////////////////////////////////////
/////////////////////////////////////////////////////yH5BAEAAAEALAAAAAAQAA8A
AAhMAAMIHEiwoMGDCBMSBMBQoUAAAv4JYEix4UKJAiJq/AegIESJIDV2vCiyoskAHydmXMmyIwCJ
EFm2fKhS5sqRKGPanLjQ5EmHQIMGBAA7
}
set save {
R0lGODlhEAAQAPcAAAAAAAAAnAAA/8bGxs7Ozv//////////////////////////////////////
////////////////////////////////////////////////////////////////////////////
////////////////////////////////////////////////////////////////////////////
////////////////////////////////////////////////////////////////////////////
////////////////////////////////////////////////////////////////////////////
////////////////////////////////////////////////////////////////////////////
////////////////////////////////////////////////////////////////////////////
////////////////////////////////////////////////////////////////////////////
////////////////////////////////////////////////////////////////////////////
////////////////////////////////////////////////////////////////////////////
////////////////////////////////////////////////////////////////////////////
////////////////////////////////////////////////////////////////////////////
////////////////////////////////////////////////////////////////////////////
/////////////////////////////////////////////////////yH5BAEAAAMALAAAAAAQABAA
AAhhAAcIHEiwoMGDBgEEECAAgMOHAgIAGKiQIYGLAQIQiDhRYEUBFwlk3CiR4sKGDx1yNMmwpcuG
JlPKdBjzn82b/x7WxGlTp0eJPHvS/AkgaM6hAxQWDeozqUOjTWdKRUg1IAA7
}
set copy {
R0lGODlhEAAQAPcAAAAAAM7Ozv//////////////////////////////////////////////////
////////////////////////////////////////////////////////////////////////////
////////////////////////////////////////////////////////////////////////////
////////////////////////////////////////////////////////////////////////////
////////////////////////////////////////////////////////////////////////////
////////////////////////////////////////////////////////////////////////////
////////////////////////////////////////////////////////////////////////////
////////////////////////////////////////////////////////////////////////////
////////////////////////////////////////////////////////////////////////////
////////////////////////////////////////////////////////////////////////////
////////////////////////////////////////////////////////////////////////////
////////////////////////////////////////////////////////////////////////////
////////////////////////////////////////////////////////////////////////////
/////////////////////////////////////////////////////yH5BAEAAAEALAAAAAAQABAA
AAhSAAEIHEhwYICDAP4pXMjwH4CDARISbOgQokSBFCsidDiQ4sONFxNyLChSoUiMDFGmdNhQpcmX
KUuOdMlxoUyPJW+2zJnRJs+eM2m2hBiRZMGAAAA7
}
set cut {
R0lGODlhEAAQAPcAAAAAAMbGxv//////////////////////////////////////////////////
////////////////////////////////////////////////////////////////////////////
////////////////////////////////////////////////////////////////////////////
////////////////////////////////////////////////////////////////////////////
////////////////////////////////////////////////////////////////////////////
////////////////////////////////////////////////////////////////////////////
////////////////////////////////////////////////////////////////////////////
////////////////////////////////////////////////////////////////////////////
////////////////////////////////////////////////////////////////////////////
////////////////////////////////////////////////////////////////////////////
////////////////////////////////////////////////////////////////////////////
////////////////////////////////////////////////////////////////////////////
////////////////////////////////////////////////////////////////////////////
/////////////////////////////////////////////////////yH5BAEAAAEALAAAAAAQABAA
AAhEAAMIHCgQAMGDCA0iXBhAocB/DhMOhMiw4MOICw1SrFhwI8eGGAcCGEnSI8GIJBk6VBhS5EiX
LSU2/DizJkeWNEEeDAgAOw==
}
set paste {
R0lGODlhEAAQAPcAAAAAAAAAY2NjY8bGxv//////////////////////////////////////////
////////////////////////////////////////////////////////////////////////////
////////////////////////////////////////////////////////////////////////////
////////////////////////////////////////////////////////////////////////////
////////////////////////////////////////////////////////////////////////////
////////////////////////////////////////////////////////////////////////////
////////////////////////////////////////////////////////////////////////////
////////////////////////////////////////////////////////////////////////////
////////////////////////////////////////////////////////////////////////////
////////////////////////////////////////////////////////////////////////////
////////////////////////////////////////////////////////////////////////////
////////////////////////////////////////////////////////////////////////////
////////////////////////////////////////////////////////////////////////////
/////////////////////////////////////////////////////yH5BAEAAAMALAAAAAAQABAA
AAhgAAcIHEiwoMEBABICOIhQIQABAhwuFAjgn8WHCSNa/DexIkeIIDVypHhRYsKLJDeqVNlxZYCX
MF+m3BjAZYCZFmuqrHnTI81/MIHK9JlzZU6ENmPypOhQp8uDSmMyZBgQADs=
}
set search {
R0lGODlhEAAQAPcAAAAAAMbGxs7Ozv//////////////////////////////////////////////
////////////////////////////////////////////////////////////////////////////
////////////////////////////////////////////////////////////////////////////
////////////////////////////////////////////////////////////////////////////
////////////////////////////////////////////////////////////////////////////
////////////////////////////////////////////////////////////////////////////
////////////////////////////////////////////////////////////////////////////
////////////////////////////////////////////////////////////////////////////
////////////////////////////////////////////////////////////////////////////
////////////////////////////////////////////////////////////////////////////
////////////////////////////////////////////////////////////////////////////
////////////////////////////////////////////////////////////////////////////
////////////////////////////////////////////////////////////////////////////
/////////////////////////////////////////////////////yH5BAEAAAEALAAAAAAQABAA
AAg9AAMIHEiwoMGDCBMqXAigIYCCDh8GkCiQIsWJGBtirDjxoceOHR2C/DjQIkGSHFOmjAjRoYCF
MGPKnDkzIAA7
}
set test {
R0lGODlhEAAQAPcAAAAAAAD/AMbGxv//////////////////////////////////////////////
////////////////////////////////////////////////////////////////////////////
////////////////////////////////////////////////////////////////////////////
////////////////////////////////////////////////////////////////////////////
////////////////////////////////////////////////////////////////////////////
////////////////////////////////////////////////////////////////////////////
////////////////////////////////////////////////////////////////////////////
////////////////////////////////////////////////////////////////////////////
////////////////////////////////////////////////////////////////////////////
////////////////////////////////////////////////////////////////////////////
////////////////////////////////////////////////////////////////////////////
////////////////////////////////////////////////////////////////////////////
////////////////////////////////////////////////////////////////////////////
/////////////////////////////////////////////////////yH5BAEAAAIALAAAAAAQABAA
AAhTAAUIFAigoMGBCAkGWMgQQEKFDCM6RAggosUAEwVUvGhx4kaODQkaHEnSI8aTKE+arFgQY0uW
CllKVBnT5UiaGkFKHPiRY0aIF3/yDPqQJ8mEAQEAOw==
}
set stop {
R0lGODlhEAAQAPcAAAAAAMbGxv8AAP//////////////////////////////////////////////
////////////////////////////////////////////////////////////////////////////
////////////////////////////////////////////////////////////////////////////
////////////////////////////////////////////////////////////////////////////
////////////////////////////////////////////////////////////////////////////
////////////////////////////////////////////////////////////////////////////
////////////////////////////////////////////////////////////////////////////
////////////////////////////////////////////////////////////////////////////
////////////////////////////////////////////////////////////////////////////
////////////////////////////////////////////////////////////////////////////
////////////////////////////////////////////////////////////////////////////
////////////////////////////////////////////////////////////////////////////
////////////////////////////////////////////////////////////////////////////
/////////////////////////////////////////////////////yH5BAEAAAEALAAAAAAQABAA
AAhWAAMIFAigoMGBCAkKWMgQQEKFDCM6RAggokUBEwNUvGhxYkWDIA1iVLjxI8aTHjGa/FhwpMaF
K0/ChBhzo0uWKFvOfMlR4kCbHDNCvCj0J9GHP0MmDAgAOw==
}
#============================================================================
# Start it all up
#============================================================================
# -- make certain that we're running against the appropriate Tcl release
# version
if {[info exists tcl_version] == 0 || $tcl_version < 7.5} {
error "Error -- Tcl Editor: This program requires Tcl 7.5 or higher"
}
# -- verify that Tk is loaded and that it is the appropriate release version
if {[info exists tk_version] == 0 || $tk_version < 4.1} {
error "Error -- Tcl Editor: This program requires Tk 4.1 or higher"
}
# -- clear previous global variables
foreach globalvar [info globals *ED*] {
catch "unset $globalvar" dummy
}
foreach globalvar [info globals *ed*] {
catch "unset $globalvar" dummy
}
# -- initialize session global variables
set _ED(menuCount) 0;
set _ED(pwd) [pwd]
set _ED(editcursor) ""
set _ED(editcurold) ""
set _ED(srch_old) ""
set _ED(srch_new) ""
set _ED(file) ""
set _ED(runslave) ""
set _ED(package) ""
set _ED(temppackage) ""
set _ED(packagekeyname) ""
set _ED(status) "Now editing file: $_ED(file)"
set _ED(permstatus) "Now editing file: $_ED(file)"
set _ED(blockflag) 0
if {$tcl_platform(platform) == "windows"} {
set _ED(courierfont) {{Courier New} 11 {normal}}
} else {
set _ED(courierfont) "-*-Helvetica-Medium-R-Normal--12-*-*-*-*-*-*-*"
}
catch "destroy .ed_mainFrame"
source spynergy.tcl
bind Entry {tkEntryBackspace %W}
ed_start_gui
#--------- end of program