" $1]
for {set trn 0} {$trn < $trnumber} {incr trn} {
insert_code "$1 $2 \n"
}
destroy_trow
focus $textname
}
proc destroy_trow {} {
.trow.ent5 delete 0 end
.trow.ent7 delete 0 end
.trow.check5 deselect
set tralign "---"
set trvalign "---"
destroy .trow
}
}
# Create table cells.
proc table_cell {} {
# Check if the dialog already exists, and if it does, raise it.
if { [winfo exists .tcell] == 1 } then {
wm deiconify .tcell
return
}
global textname tcalign tcvalign
toplevel .tcell
dialog_position .tcell
wm title .tcell "Create table cells"
wm protocol .tcell WM_DELETE_WINDOW {destroy_tcell}
wm resizable .tcell 0 0
set tcalign "---"
set tcvalign "---"
label .tcell.lab1 -text "Align"
label .tcell.lab2 -text "Valign"
checkbutton .tcell.check3 -text "Rowspan:" -variable setrow -command\
{on_off $setrow .tcell.ent3}
checkbutton .tcell.check4 -text "Colspan:" -variable setcol -command\
{on_off $setcol .tcell.ent4}
checkbutton .tcell.check5 -text "Bg color:" -variable settcol -command\
{on_off $settcol .tcell.ent5}
checkbutton .tcell.check6 -text "Cell width:" -variable setwidth -command\
{on_off $setwidth .tcell.ent6}
checkbutton .tcell.check7 -text "Nowrap" -variable tcsetwrap -onvalue\
"yes" -offvalue "no"
label .tcell.lab3 -text "Number of cells"
tk_optionMenu .tcell.opt1 tcalign --- LEFT RIGHT CENTER
tk_optionMenu .tcell.opt2 tcvalign --- TOP BOTTOM MIDDLE
entry .tcell.ent3 -width 20 -background grey -textvariable tcrowspan\
-state disabled
entry .tcell.ent4 -width 20 -background grey -textvariable tccolspan\
-state disabled
entry .tcell.ent5 -width 20 -background grey -textvariable tccolor\
-state disabled
button .tcell.colorbtn -image color -command {color_code_insert .tcell.ent5}
entry .tcell.ent6 -width 20 -background grey -textvariable tcwidth\
-state disabled
entry .tcell.ent7 -width 20 -background white -textvariable tcnumber
button .tcell.button1 -text "OK" -command {ins_tcell}
button .tcell.button2 -text "Cancel" -command {destroy_tcell}
grid configure .tcell.lab1 -row 2 -column 1 -sticky "w" -padx 3 -pady 2
grid configure .tcell.lab2 -row 3 -column 1 -sticky "w" -padx 3 -pady 2
grid configure .tcell.check3 -row 4 -column 1 -sticky "w" -padx 3 -pady 2
grid configure .tcell.check4 -row 5 -column 1 -sticky "w" -padx 3 -pady 2
grid configure .tcell.check5 -row 6 -column 1 -sticky "w" -padx 3 -pady 2
grid configure .tcell.check6 -row 8 -column 1 -sticky "w" -padx 3 -pady 2
grid configure .tcell.check7 -row 9 -column 1 -sticky "w" -padx 3 -pady 2
grid configure .tcell.lab3 -row 10 -column 1 -sticky "w" -padx 3 -pady 2
grid configure .tcell.opt1 -row 2 -column 2 -sticky "w" -padx 3 -pady 2
grid configure .tcell.opt2 -row 3 -column 2 -sticky "w" -padx 3 -pady 2
grid configure .tcell.ent3 -row 4 -column 2 -sticky "snew" -padx 3 -pady 2
grid configure .tcell.ent4 -row 5 -column 2 -sticky "snew" -padx 3 -pady 2
grid configure .tcell.ent5 -row 6 -column 2 -sticky "snew" -padx 3 -pady 2
grid configure .tcell.colorbtn -row 7 -column 2 -sticky "snew" -padx 3\
-pady 2
grid configure .tcell.ent6 -row 8 -column 2 -sticky "snew" -padx 3 -pady 2
grid configure .tcell.ent7 -row 10 -column 2 -sticky "snew" -padx 3 -pady 2
grid configure .tcell.button1 -row 11 -column 1 -sticky "snew" -padx 3\
-pady 2
grid configure .tcell.button2 -row 11 -column 2 -sticky "snew" -padx 3\
-pady 2
.tcell.ent7 insert end "1"
proc ins_tcell {} {
global tcsetwrap tcalign tcvalign tcrowspan tccolspan tccolor tcwidth\
tcnumber textname
set var1 ""
set 2 ""
if {$tcalign != "---"} then {
set tca [subst {ALIGN="$tcalign"}]
set var1 [linsert $var1 end $tca]
}
if {$tcvalign != "---"} then {
set tcb [subst {VALIGN="$tcvalign"}]
set var1 [linsert $var1 end $tcb]
}
if {$tcrowspan != ""} then {
set tcc [subst {ROWSPAN="$tcrowspan"}]
set var1 [linsert $var1 end $tcc]
}
if {$tccolspan != ""} then {
set tcd [subst {ROWSPAN="$tccolspan"}]
set var1 [linsert $var1 end $tcd]
}
if {$tccolor != ""} then {
set tce [subst {BGCOLOR="$tccolor"}]
set var1 [linsert $var1 end $tce]
}
if {$tcwidth != ""} then {
set tcf [subst {WIDTH="$tcwidth"}]
set var1 [linsert $var1 end $tcf]
}
if {$tcsetwrap != "no"} then {
set tcg "NOWRAP"
set var1 [linsert $var1 end $tcg]
}
set var1 [subst $var1]
regsub -all "{" "$var1" "" var2
regsub -all "}" "$var2" "" 1
set 1 [format "" $1]
for {set tcn 0} {$tcn < $tcnumber} {incr tcn} {
insert_code "$1 $2 \n"
}
destroy_tcell
focus $textname
}
proc destroy_tcell {} {
.tcell.ent3 delete 0 end
.tcell.ent4 delete 0 end
.tcell.ent5 delete 0 end
.tcell.ent6 delete 0 end
.tcell.ent7 delete 0 end
.tcell.check3 deselect
.tcell.check4 deselect
.tcell.check5 deselect
.tcell.check6 deselect
.tcell.check7 deselect
set tcalign "---"
set tcvalign "---"
destroy .tcell
}
}
# Change font size and/or color dialog.
proc font_style {} {
# Check if the dialog already exists, and if it does, raise it.
if { [winfo exists .font] == 1 } then {
wm deiconify .font
return
}
catch {
global fsize fsizerel textname
set fsize "---"
set fsizerel "---"
toplevel .font
dialog_position .font
wm title .font "Set font size and color"
wm protocol .font WM_DELETE_WINDOW {destroy_font}
wm resizable .font 0 0
label .font.label1 -text "Set fontsize:"
label .font.labelrel -text "Set fontsize (relative):"
checkbutton .font.check1 -text "Set color:" -variable setcol -command\
{on_off $setcol .font.ent2}
checkbutton .font.check2 -text "Set font:" -variable setfont -command\
{on_off_font $setfont}
label .font.label2 -text "1"
label .font.label3 -text "2"
label .font.label4 -text "3"
label .font.label5 -text "4"
tk_optionMenu .font.ent1 fsize 1 2 3 4 5 6 7 ---
tk_optionMenu .font.entrel fsizerel -2 -1 +1 +2 +3 +4 ---
entry .font.ent2 -width 20 -background grey -textvariable colorcode\
-state disabled
entry .font.ent3 -width 20 -background grey -textvariable fontone\
-state disabled
entry .font.ent4 -width 20 -background grey -textvariable fonttwo\
-state disabled
entry .font.ent5 -width 20 -background grey -textvariable fontthree\
-state disabled
entry .font.ent6 -width 20 -background grey -textvariable fontfour\
-state disabled
button .font.colorbutton -image color -command\
{color_code_insert .font.ent2}
button .font.button1 -text "OK" -command {ins_style}
button .font.button2 -text "Cancel" -command {destroy_font}
grid configure .font.label1 -row 0 -column 1 -sticky "e" -padx 3 -pady 2
grid configure .font.labelrel -row 1 -column 1 -sticky "e" -padx 3 -pady 2
grid configure .font.check1 -row 2 -column 1 -sticky "e" -padx 3 -pady 2
grid configure .font.check2 -row 4 -column 1 -sticky "w" -padx 3 -pady 2
grid configure .font.ent1 -row 0 -column 2 -sticky "snew" -padx 3\
-pady 2
grid configure .font.entrel -row 1 -column 2 -sticky "snew" -padx 3\
-pady 2
grid configure .font.ent2 -row 2 -column 2 -sticky "snew" -padx 3\
-pady 2
grid configure .font.colorbutton -row 3 -column 2 -sticky "n" -padx 3\
-pady 2
grid configure .font.label2 -row 4 -column 1 -sticky "e" -padx 3 -pady 2
grid configure .font.label3 -row 5 -column 1 -sticky "e" -padx 3 -pady 2
grid configure .font.label4 -row 6 -column 1 -sticky "e" -padx 3 -pady 2
grid configure .font.label5 -row 7 -column 1 -sticky "e" -padx 3 -pady 2
grid configure .font.ent3 -row 4 -column 2 -sticky "snew" -padx 3\
-pady 2
grid configure .font.ent4 -row 5 -column 2 -sticky "snew" -padx 3\
-pady 2
grid configure .font.ent5 -row 6 -column 2 -sticky "snew" -padx 3\
-pady 2
grid configure .font.ent6 -row 7 -column 2 -sticky "snew" -padx 3\
-pady 2
grid configure .font.button1 -row 8 -column 1 -sticky "snew" -padx 3\
-pady 2
grid configure .font.button2 -row 8 -column 2 -sticky "snew" -padx 3\
-pady 2
proc ins_style {} {
global fsize fsizerel colorcode fontone fonttwo fontthree fontfour
if {$fsize != "---" && $fsizerel != "---"} then {
notice_box "You cannot use two ways of setting the font size at once..."
return
}
set var1 ""
set 2 ""
if {$fsize != "---" && $fsizerel == "---"} then {
set sz [subst {SIZE="$fsize"}]
set var1 [linsert $var1 end $sz]
}
if {$fsizerel != "---" && $fsize == "---"} then {
set szr [subst {SIZE="$fsizerel"}]
set var1 [linsert $var1 end $szr]
}
if {$colorcode != ""} then {
set co [subst {COLOR="$colorcode"}]
set var1 [linsert $var1 end $co]
}
if {$fontone != ""} then {
set fo [subst {FACE="$fontone"}]
set var1 [linsert $var1 end $fo]
}
if {$fonttwo != ""} then {
set fo [subst {FACE="$fontone, $fonttwo"}]
set var1 [lreplace $var1 end end]
set var1 [linsert $var1 end $fo]
}
if {$fontthree != ""} then {
set fo [subst {FACE="$fontone, $fonttwo, $fontthree"}]
set var1 [lreplace $var1 end end]
set var1 [linsert $var1 end $fo]
}
if {$fontfour != ""} then {
set fo [subst {FACE="$fontone, $fonttwo, $fontthree,\
$fontfour"}]
set var1 [lreplace $var1 end end]
set var1 [linsert $var1 end $fo]
}
set var1 [subst $var1]
regsub -all "{" "$var1" "" var2
regsub -all "}" "$var2" "" 1
set 1 [format "" $1]
set fsize "---"
set fsizerel "---"
.font.ent2 delete 0 end
formating $1 $2
destroy_font
}
proc destroy_font {} {
set fsize "---"
set fsizerel "---"
.font.ent2 delete 0 end
.font.ent3 delete 0 end
.font.ent4 delete 0 end
.font.ent5 delete 0 end
.font.ent6 delete 0 end
.font.check1 deselect
.font.check2 deselect
destroy .font
}
}
proc on_off_font {optvar} {
if {$optvar == 1} then {
.font.ent3 configure -state normal -background white
.font.ent4 configure -state normal -background white
.font.ent5 configure -state normal -background white
.font.ent6 configure -state normal -background white
focus .font.ent3
} else {
.font.ent3 delete 0 end
.font.ent4 delete 0 end
.font.ent5 delete 0 end
.font.ent6 delete 0 end
.font.ent3 configure -state disabled -background grey
.font.ent4 configure -state disabled -background grey
.font.ent5 configure -state disabled -background grey
.font.ent6 configure -state disabled -background grey
}
}
}
# Read file.
proc file_read {filename} {
set filename [file join $filename]
# Default value
global data
set data ""
if {[file readable $filename]} then {
set fd [open $filename "r"]
# I18N experiment
# fconfigure $fd -encoding big5
# fconfigure $fd -encoding shiftjis
set data [read $fd]
close $fd
}
return $data
}
# Saves data to disk
proc file_write {filename data} {
set filename [file join $filename]
return [catch {
set fileid [open $filename "w"]
puts -nonewline $fileid $data
close $fileid
}]
}
# Loads a file into text widget.
proc file_load {toplevel textwidget filename} {
set filename [file join $filename]
set data [file_read $filename]
file_clear $toplevel $textwidget $filename
$textwidget insert end $data
}
# Deletes all text in text widget, sets toplevel to have given
# title.
proc file_clear {toplevel textwidget title} {
$textwidget delete 1.0 end
wm title $toplevel $title
focus $textwidget
}
# Updates content in editor from original file.
proc file_reload { } {
global filename textname
set result [tk_messageBox -parent .ed -title {Reload File?} -type yesnocancel \
-icon warning -message "Are you sure you want to reload this file?"]
if {$result == "yes"} then {
set data [file_read $filename]
$textname delete 1.0 end
$textname insert end $data
}
if {$result == "no"} then {
return
}
}
# This proc is run every time the editor is started.
# Slightly modified version of file_new.
proc file_first {toplevel textwidget name} {
global textname data filelist filesel filename filebuffer temp
set filename [file join $filename]
set content [$textname get 1.0 {end -1c}]
set filebuffer($filelist) "$filelist"
set fileid [open $temp/$filebuffer($filelist)[pid].bf "w+"]
puts -nonewline $fileid $content
close $fileid
set filename Untitled
$filesel add command -label "$filename" -command\
"load_buffer $temp/$filebuffer($filelist)[pid].bf $filelist Untitled"
incr filelist
$textwidget delete 1.0 end
wm title .ed "August ($name)"
focus $textwidget
$textwidget mark set insert 1.0
}
# Edit a new file.
proc file_new {toplevel textwidget name tpldialog} {
global textname data filelist filesel filesave filename filebuffer current temp\
August
set content [$textname get 1.0 {end -1c}]
set filebuffer($filelist) "$filelist"
set fileid [open $temp/$filebuffer($current)[pid].bf "w+"]
puts -nonewline $fileid $content
close $fileid
set current $filelist
if {$name == "Untitled"} then {
set filename Untitled
} else {
set filename [file join $name]
}
set shortname [file tail $filename]
set filesave($filename) $filename
$filesel add command -label "$shortname" -command\
"load_buffer $temp/$filebuffer($filelist)[pid].bf $filelist $filename"
incr filelist
$textwidget delete 1.0 end
wm title $toplevel "August ($filename)"
if {$tpldialog == "yes"} then {
use_template
.template.lbox insert 0 "Empty"
.template.lbox selection clear 1
.template.lbox selection set 0
}
focus $textwidget
$textwidget mark set insert 1.0
}
# Proc used by file_open.
proc file_open_get {} {
global textedit August lastdir
set file_types {
{ "Html Files" { .htm .html .HTM .HTML } }
{ "Stylesheet" { .css .CSS } }
{ "PHP" { .php .php3 .PHP .PHP3 } }
{ "Text Files" { .txt .TXT } }
{ "All Files" * }
}
if {$August(openlastdir) == "yes" && $lastdir == "none"} then {
set opendir $August(docpath)
}
if {$August(openlastdir) == "no"} then {
set opendir $August(docpath)
}
if {$August(openlastdir) == "yes" && $lastdir != "none"} then {
set opendir $lastdir
}
set fname [tk_getOpenFile -initialdir $opendir \
-filetypes $file_types -title "Select a file to load" -parent .]
if {$fname != ""} then {
set lastdir [file dirname $fname]
}
return $fname
}
# Asks user for filename, loads it.
proc file_open {toplevel textwidget cmdline cmdname} {
global textname filename filesel filelist filebuffer filesave current\
filenamelist temp actions
set filename [file join $filename]
set oldfile $filename
set content [$textname get 1.0 {end -1c}]
set filebuffer($filelist) "$filelist"
set fileid [open $temp/$filebuffer($current)[pid].bf "w+"]
puts -nonewline $fileid $content
close $fileid
set current $filelist
if {$cmdline == "no"} then {
set filename [file_open_get]
} else {
set filename $cmdname
}
set filestatus [lsearch -exact $filenamelist $filename]
if {$filename == ""} then {
set filename $oldfile
return
}
if {$filename == "Untitled"} then {
set filestatus -1
}
if {$filestatus == -1} then {
} else {
notice_box "This file is already open!"
return
}
set filenamelist [linsert $filenamelist end $filename]
if {$filename != ""} then {
file_load $toplevel $textwidget $filename
after idle run_tags
focus $textwidget
$textwidget mark set insert 1.0
set filesave($filename) [file join $filename]
set longname $filename
set shortname [file tail $longname]
$filesel add command -label "$shortname" -command\
"load_buffer $temp/$filebuffer($filelist)[pid].bf $filelist\
{$filesave($filename)}"
incr filelist
set actions [lreplace $actions end end]
set actions [lreplace $actions end end]
wm title .ed "August ($filename)"
}
}
# Loads in a file and inserts data at cursor. Does
# not delete old data.
proc file_insert {toplevel textwidget} {
set insfname [file_open_get]
if {$insfname != ""} then {
set data [file_read $insfname]
if {$data != ""} then {
$textwidget insert insert $data
focus $textwidget
$textwidget mark set insert 1.0
update
run_tags
}
}
}
# Save file.
proc file_save {textwidget} {
global textedit data filesel filename filelist current filesave filebuffer\
filenamelist temp August lastdir
set filename [file join $filename]
set data [$textwidget get 1.0 {end -1c}]
if {$filename == "Untitled"} then {
set file_types {
{ "Html Files" { .htm .html .HTM .HTML } }
{ "Stylesheet" { .css .CSS } }
{ "PHP" { .php .php3 .PHP .PHP3 } }
{ "Text Files" { .txt .TXT } }
{ "All Files" * }
}
if {$August(openlastdir) == "yes" && $lastdir == "none"} then {
set opendir $August(docpath)
}
if {$August(openlastdir) == "no"} then {
set opendir $August(docpath)
}
if {$August(openlastdir) == "yes" && $lastdir != "none"} then {
set opendir $lastdir
}
set filename [tk_getSaveFile -initialdir $opendir \
-filetypes $file_types -title "Select file name to save" -parent .]
if {$filename != ""} then {
set text [string trimright $data]
set filesave($filename) $filename
set longname $filename
set filenamelist [linsert $filenamelist end $filename]
set shortname [file tail $longname]
$filesel entryconfigure $current -label "$shortname" -command\
"load_buffer $temp/$filebuffer($current)[pid].bf $current\
{$filesave($filename)}"
wm title .ed "August ($filename)"
set lastdir [file dirname $filename]
return [file_write $filesave($filename) $data]
# This prevents the fileneame becoming "" if the user hits cancel in the file save dialog.
} else {
set filename "Untitled"
return $filename
}
} else {
set data [$textwidget get 1.0 {end -1c}]
set text [string trimright $data]
wm title .ed "August ($filename)"
return [file_write $filesave($filename) $data]
}
}
# Save all files.
proc save_all_files { } {
global textname filesel current wcontent
set openfile $current
set savefiles [$filesel index end]
for {set f 1} {$f <= $savefiles} {incr f} {
set fileinfo [$filesel entrycget $f -command]
set fpath [lindex $fileinfo 3]
set bpath [lindex $fileinfo 1]
# If the first file to save is loaded into the text widget, run regular file_save.
if {$openfile == {$current}} then {
check_text
} elseif {$fpath == "Untitled"} then {
# If the filename is Untitled then load it into textwidget and run regular file_save.
$filesel invoke $f
check_text
} else {
# Read buffert file.
set ntext [file_read $bpath]
# Write the contents of the buffer file to a filename.
file_write $fpath $ntext
}
}
# Load the last edited file.
$filesel invoke $openfile
}
proc check_text { } {
global textname
set wcontent [$textname get 1.0 "end -1c"]
if {$wcontent != ""} then {
file_save $textname
return
}
}
# Close file.
proc file_close { textwidget status} {
global textname filesel current filename filenamelist temp
set filename [file join $filename]
if [file exists $temp/$current[pid].bf] then {
} else {
set fake [open $temp/$current[pid].bf "w+"]
close $fake
}
if {$filename == "Untitled"} then {
set buffer [open $temp/$current[pid].bf "r"]
set old [read $buffer]
close $buffer
} else {
set filestatus [file readable $filename]
if {$filestatus == "1"} then {
set file [open $filename "r"]
set old [read $file]
close $file
} else {
set new ""
set old "deleted"
notice_box "This file has been deleted from disk. You can still save the contents of the editor if you want to."
}
}
set new [$textname get 1.0 {end -1c}]
if {$new == ""} then {
} elseif {$filename == "Untitled"} then {
set result [tk_messageBox -parent .ed -title {Save File?} -type yesnocancel \
-icon warning -message "Do you want to save this file?"]
if {$result == "yes"} then { file_save $textwidget
}
} elseif {$old != $new} then {
set result [tk_messageBox -parent .ed -title {Save File?} -type yesnocancel \
-icon warning -message "Do you want to save this file?"]
if {$result == "yes"} then { file_save $textwidget
}
}
set var [lsearch $filenamelist $filename]
if {$var != "-1"} then {
set filenamelist [lreplace $filenamelist $var $var]
}
set fileselentries [$filesel index end]
for {set fe 1} {$fe <= $fileselentries} {incr fe} {
set result [$filesel entrycget $fe \-command]
set buffer [lindex $result 2]
if {$buffer == $current} then {
$filesel delete $fe
break
}
}
$textwidget delete 1.0 end
set latest $current
$filesel configure -tearoff 0
wm title .ed "August (Untitled)"
if {$fe > 1} then {
$filesel invoke [incr fe -1]
$filesel configure -tearoff 1
} elseif {$fe == 1} then {
file_new .ed $textname Untitled no
$filesel configure -tearoff 1
}
}
# Save file as...
proc file_save_as {textwidget} {
global textedit data filesel filename filelist current filesave filebuffer\
temp August textname actions filenamelist lastdir
set filename [file join $filename]
set oldfilename $filename
set data [$textwidget get 1.0 {end -1c}]
set file_types {
{ "Html Files" { .htm .html .HTM .HTML } }
{ "Stylesheet" { .css .CSS } }
{ "PHP" { .php .php3 .PHP .PHP3 } }
{ "Text Files" { .txt .TXT } }
{ "All Files" * }
}
if {$August(openlastdir) == "yes" && $lastdir == "none"} then {
set opendir $August(docpath)
}
if {$August(openlastdir) == "no"} then {
set opendir $August(docpath)
}
if {$August(openlastdir) == "yes" && $lastdir != "none"} then {
set opendir $lastdir
}
set filename [tk_getSaveFile -initialdir $opendir \
-filetypes $file_types -title "Select file name to save" -parent .]
# Saving a new file...
if {$oldfilename == "Untitled"} then {
set filesave($filename) $filename
set longname $filename
set shortname [file tail $longname]
$filesel entryconfigure $current -label "$shortname" -command\
"load_buffer $temp/$filebuffer($current)[pid].bf $current\
{$filesave($filename)}"
wm title .ed "August ($filename)"
set lastdir [file dirname $filename]
return [file_write $filesave($filename) $data]
# When saving an already existing file under a different name...:
} elseif {$filename != ""} then {
set filebuffer($filelist) "$filelist"
set fileid [open $temp/$filebuffer($current)[pid].bf "w+"]
puts -nonewline $fileid $data
close $fileid
set current $filelist
set filesave($filename) $filename
set longname $filename
set filenamelist [linsert $filenamelist end $filename]
set shortname [file tail $longname]
$filesel add command -label "$shortname" -command\
"load_buffer $temp/$filebuffer($filelist)[pid].bf $filelist\
{$filesave($filename)}"
incr filelist
set actions [lreplace $actions end end]
set actions [lreplace $actions end end]
wm title .ed "August ($filename)"
set lastdir [file dirname $filename]
return [file_write $filesave($filename) $data]
# If user cancels out of the "Save file as..." dialog make sure filename variable is reset.
} else {
set filename $oldfilename
return $filename
}
}
# Called to exit editor/close all files.
proc exit_files {exitfiles} {
global filesel textname filebuffer Augustdir August
for {set arraysize [array size filebuffer]} {$arraysize > 0}\
{incr arraysize -1} {
file_close $textname no
}
if {$exitfiles == "yes"} then {
eval file delete [glob $Augustdir/*[pid].bf]
exit
}
if {$exitfiles == "no"} then {
# file_new .ed $textname Untitled $August(tpldialog)
}
}
# Handles window manager Close choice.
proc prompt_close {widgetname} {
if {$widgetname == ".ed"} then {
exit_files yes
} else {
destroy $widgetname
}
}
# Find & replace dialog.
proc SearchDialog { textwidget } {
# Create find dialog.
set dlg .finddialog
# Check if the dialog already exists, and if it does, raise it.
if { [winfo exists $dlg] == 1 } then {
wm deiconify $dlg
return
}
global find_case find_regexp find_last_indx textname filesel files sfiles sstatus mode no_prompt oldpattern find_stat replace_stat version newtext npstat indxbtn indxstat
# Don't require exact case match.
set find_case 0
# Don't search all open files.
set mode 0
# Don't use regexp-style searches.
set find_regexp 0
# Last place searched, line 1 column 0 (start).
set find_last_indx 1.0
# Check number of entries in window menu
set files [$filesel index end]
# Set startindex for multiple file search
set sfiles 1
# Set var for helping start search with the right file
set sstatus 0
# Don't replace without prompting
set no_prompt 0
# Set variable that contains previously used search pattern
set oldpattern ""
# Set variable that keeps track of the number of matches found.
set find_stat 0
# Set variable that keeps track of the number of replacements.
set replace_stat 0
# Set status for "From cursor" button.
set indxbtn 0
# Set control variable for "From cursor" button.
set indxstat 1
toplevel $dlg
dialog_position $dlg
wm protocol $dlg WM_DELETE_WINDOW "destroy_findrep"
wm title $dlg Find
wm resizable $dlg 0 0
label $dlg.l_findwhat -text "Find what:" -anchor w
label $dlg.l_replacewhat -text "Replace with:" -anchor w
entry $dlg.findwhat -background white -width 30
if {$version == "replace"} then {
entry $dlg.replacewhat -background white -textvariable newtext -width 30
}
grid config $dlg.l_findwhat -column 0 -row 0 -sticky "w" -pady 8
grid config $dlg.findwhat -column 1 -row 0 -sticky "snew" -pady 8
if {$version == "replace"} then {
grid config $dlg.l_replacewhat -column 0 -row 1 -sticky "w" -pady 8
grid config $dlg.replacewhat -column 1 -row 1 -sticky "snew" -pady 8
}
checkbutton $dlg.mode -text "All open files" -variable mode
if {$version == "replace"} then {
checkbutton $dlg.prompt -text "Replace without prompting" -variable no_prompt -command {set npstat 1; dis_able $no_prompt}
}
proc dis_able { status } {
if {[list $status] == 1} then {
.finddialog.buttons.replace configure -state disabled -disabledforeground ""
} else {
.finddialog.buttons.replace configure -state normal -disabledforeground black
}
}
checkbutton $dlg.matchcase -text "Match case" -variable find_case
checkbutton $dlg.regexp -text "Regexp search" -variable find_regexp
checkbutton $dlg.cursor -text "From cursor" -variable indxbtn
grid config $dlg.mode -column 1 -row 2 -sticky "ws"
if {$version == "replace"} then {
grid config $dlg.prompt -column 1 -row 3 -sticky "ws"
}
grid config $dlg.matchcase -column 1 -row 4 -sticky "ws"
grid config $dlg.regexp -column 1 -row 5 -sticky "ws"
grid config $dlg.cursor -column 1 -row 6 -sticky "ws"
set fr $dlg.buttons
frame $fr -bd 0
button $fr.findnext -text "Find" -command {FindText .finddialog.findwhat $textname $mode $version}
bind $dlg.findwhat {FindText $dlg.findwhat $textwidget $mode $version}
if {$version == "replace"} then {
button $fr.replace -text "Replace" -command {replace_text $newtext}
}
button $fr.cancel -text "Close" -command "destroy_findrep $version"
pack $fr.findnext -side top -fill x -pady 6
if {$version == "replace"} then {
pack $fr.replace -side top -fill x -pady 6
}
pack $fr.cancel -side top -fill x -pady 6
grid config $fr -column 2 -row 0 -rowspan 4 -padx 5 -pady 1
focus $dlg.findwhat
proc destroy_findrep {ver} {
if {$ver == "replace"} then {
.finddialog.replacewhat delete 0 end
}
destroy .finddialog
}
}
# Called by Find dialog to search textwidget.
# entrywidget has the text to search for.
proc FindText {entrywidget textwidget mode dlgmode} {
global find_case find_last_indx find_regexp textname filesel sstatus sfiles oldpattern find_stat replace_stat globmode no_prompt npstat indx indxbtn indxstat
if { $indxbtn == 1 && $indxstat == 1 } then {
set find_last_indx [$textname index insert]
set indxstat 0
}
if { $mode == 0 } then {
set globmode 0
} else {
set globmode 1
}
if { $no_prompt == 1 } then {
if {$npstat == 1} then {
replace_noprompt
return
}
}
if { $mode == 0 } then {
set sstatus 1
}
if { $sstatus == 0 } then {
$filesel invoke 1
}
# Get pattern to search for.
set pattern [$entrywidget get]
# Check if search pattern has changed
if { $pattern == $oldpattern } then {
# do nothing...
} else {
if { $oldpattern == "" } then {
set oldpattern $pattern
} else {
set sfiles 1
# Don't load the first file in the window menu if in single file mode.
if { $mode == 0 } then {
set sstatus 1
}
# But if we're in "all open files" mode go ahead...
if { $sstatus == 0 } then {
$filesel invoke 1
}
set find_last_indx 1.0
notice_box "Search pattern has changed. Beginning search from the start again."
set find_stat 0
set indxstat 1
set replace_stat 0
}
}
# Update oldpattern variable.
set oldpattern $pattern
# Get length of pattern.
set length [string length $pattern]
# Set various options.
set options "-forward"
if {$find_case == 0} then {
append options " -nocase"
}
if {$find_regexp == 1} then {
append options " -regexp"
}
# Search the text widget...
set indx [eval $textwidget search $options -- {$pattern} {$find_last_indx} end]
# Set status variable that is used below.
set status $mode
if {$indx == ""} then {
append status 1
}
# Move find index etc.
if {$indx != ""} then {
catch {
$textwidget tag remove sel sel.first sel.last
}
$textwidget tag add sel $indx "$indx + $length chars"
$textwidget mark set insert $indx
$textwidget see $indx
after idle run_tags
focus $textwidget
set find_last_indx "$indx + 1 char"
incr find_stat
}
# When using "all open files" this proc is used.
if {$status == "11"} then {
set nextfile [searchfiles]
if {$nextfile == ""} then {
set no_prompt 0
notice_box "[get_stats $dlgmode] Search completed!"
set sfiles 1
set find_stat 0
set replace_stat 0
set indxstat 1
set find_last_indx "1.0"
return
}
$filesel invoke $nextfile
set find_last_indx "1.0"
set sstatus 1
set status $mode
FindText .finddialog.findwhat $textname $mode $dlgmode
return
}
# When searching a single file, this proc gives a search report and resets variables.
if { $indx == "" } then {
set no_prompt 0
notice_box "[get_stats $dlgmode] Search completed!"
set sfiles 1
set find_stat 0
set replace_stat 0
set indxstat 1
set find_last_indx "1.0"
return
}
}
# When searching all open files this proc pulls up the next file to search in. \
Returns an empty string if there's no more files to search in.
proc searchfiles {} {
global files sfiles
if {$sfiles > $files} then {
return
}
set value $sfiles
incr sfiles
return "$value"
}
# Keeps track of the number of matches and replacements.
proc get_stats { mode } {
global find_stat replace_stat
if {$mode == "find"} then {
return "$find_stat matches found."
} else {
return "$find_stat matches found. [list $replace_stat] were replaced."
}
}
# Proc that takes care of replacing all matching text without prompting.
proc replace_noprompt {} {
global no_prompt globmode version newtext textname npstat
set npstat 0
while {$no_prompt == 1} {
FindText .finddialog.findwhat $textname "$globmode" $version
catch {
replace_text $newtext
}
}
}
# Proc for Find - Replace.
proc replace_text {replacetext} {
global textname find_last_indx replace_stat
catch {
$textname delete sel.first sel.last
$textname insert insert $replacetext
set find_last_indx [$textname index insert]
incr replace_stat
}
}
# Proc to enclose text with HTML tags.
proc formating {f1 f2} {
global textname
focus $textname
set format ""
catch {
set format [$textname get sel.first sel.last]
}
catch {
set bformat [format "$f1%s$f2" $format]
$textname delete sel.first sel.last
$textname insert insert $bformat
if {$f2 == "\">"} then {
set_cur "insert-4c"
}
}
if {$format == ""} then {
catch {
$textname insert insert "$f1$f2"
set curpos [string length $f2]
set c c
set_cur "insert-$curpos$c"
}
}
selection clear
after idle run_tags
update
}
# Proc for removing tags.
proc remove_tags {} {
global textname
if {[selection own] != ""} then {
set tags [selection get]
regsub -all {<[^>]*>} $tags "" notags
$textname delete sel.first sel.last
$textname insert insert $notags
selection clear
set selstat ""
} else {
set selstat [tk_messageBox -title "Remove tags" -message "No text is\
selected, remove all tags?" -type yesno]
}
if {$selstat == "yes"} then {
set tags [$textname get 1.0 end]
regsub -all {<[^>]*>} $tags "" notags
$textname delete 1.0 end
$textname insert 1.0 $notags
}
}
# Proc for removing tabs.
proc remove_tabs {keepformat} {
global textname
if {[selection own] != ""} then {
set tabs [selection get]
if {$keepformat == "yes"} then {
set notabs [untab $tabs]
} else {
regsub -all "\t" $tabs "" notabs
}
$textname delete sel.first sel.last
$textname insert insert $notabs
selection clear
set selstat ""
} else {
set selstat [tk_messageBox -title "Remove tabs" -message "No text is\
selected, remove all tabs?" -type yesno]
}
if {$selstat == "yes"} then {
set tabs [$textname get 1.0 end]
if {$keepformat == "yes"} then {
set notabs [untab $tabs]
} else {
regsub -all "\t" $tabs "" notabs
}
$textname delete 1.0 end
$textname insert 1.0 $notabs
}
}
# Remove tabs without changing format.
proc untab {str {tablen 8}} {
set a 0
set i [string first "\t" $str]
while {$i != -1} {
set m { }
set j $i
while {[incr j]%$tablen} { append m { } }
set str [string range $str $a [expr {$i-1}]]$m[string range $str [incr i] end]
set i [string first "\t" $str]
}
return $str
}
# Proc for changing case.
proc change_case {case} {
global textname
set astring [selection get]
if {$case != ""} then {
set anewstring [string $case $astring]
$textname delete sel.first sel.last
$textname insert insert $anewstring
}
}
# Proc for inserting blocks of code.
proc insert_code {c} {
global textname
$textname insert insert $c
update
run_tags
}
# Preview with Lynx.
proc prev_lynx { } {
global filename August
exec $August(lynxterm) -e lynx $filename &
}
# Preview with Opera
proc prev_opera {} {
# Opera experiment...
exec opera file://$filename &
}
# Preview with Konqueror (Alpha!)
# Doesn't work on my system...maybe if you have newer KDE;-)
proc prev_konqueror { } {
global konqwin filename fooid
if {$konqwin == "0"} then {
exec kfmclient openURL $filename &
set konqwin "1"
return
}
if {$konqwin == "1"} then {
set fooid [eval exec dcop konqueror qt find mainwindow | grep mainwindow | head -n1 ]
puts $fooid
exec dcop konqueror "$fooid" openURL $filename &
}
}
# Preview with Kdehelp.
proc prev_kdehelp { } {
global filename August
exec kdehelp $filename &
}
# Preview with Linux & Windows.
proc prev_multi {} {
global filename netwin August tcl_platform
if {$filename == "Untitled"} then {
notice_box "You have to save this file before you can preview it!"
return
}
# Windows NT
if {$tcl_platform(os) == "Windows NT"} then {
exec $env(COMSPEC) /c start $filename &
return
}
# Windows 95/98
if { $tcl_platform(os) == "Windows 95" || $tcl_platform(os) == "Windows 98" } then {
exec start iexplore $filename &
return
}
# Linux
if { $tcl_platform(platform) == "unix" && $netwin == "0"} then {
exec $August(netscapepath) $filename &
set netwin "1"
return
}
if { $tcl_platform(platform) == "unix" && $netwin == "1"} then {
exec $August(netscapepath) -remote openFile($filename) &
}
}
# Proc for inserting RGB color values.
proc color_code_insert {widget} {
global textname
set colorcode [tk_chooseColor -initialcolor white -title "Color"]
$widget insert insert $colorcode
}
# Switching on and off entry widget.
proc on_off {optvar optwidg} {
if {$optvar == 1} then {
$optwidg configure -state normal -background white
focus $optwidg
} else {
$optwidg delete 0 end
$optwidg configure -state disabled -background grey
}
}
# Positioning of toplevel windows.
proc dialog_position {dlg} {
set width [winfo screenwidth .ed]
set height [winfo screenheight .ed]
set x [expr ($width/2) -200]
set y [expr ($height/2) -200]
wm geometry $dlg +$x+$y
}
# Load buffered file, write content of current file to buffer, update variables.
proc load_buffer {file buffer id} {
global textname current filebuffer filelist filename temp actions
set filename [file join $filename]
set file [file join $file]
set id [file join $id]
set content [$textname get 1.0 {end -1c}]
set fid [open $temp/$filebuffer($current)[pid].bf "w+"]
puts -nonewline $fid $content
close $fid
set fileid [open $file "r+"]
set data [read $fileid]
close $fileid
set current $buffer
set filename $id
$textname delete 1.0 end
$textname insert {end -1c} $data
set actions [lreplace $actions 0 end]
wm title .ed "August ($filename)"
update
run_tags
}
# Proc for printing.
proc print_doc {} {
# Check if the dialog already exists, and if it does, raise it.
if { [winfo exists .prdlg] == 1 } then {
wm deiconify .prdlg
return
}
global textname August
toplevel .prdlg
dialog_position .prdlg
wm resizable .prdlg 0 0
tk_optionMenu .prdlg.prcomsel prcomm lpr lp
set prcomm "$August(prcomm)"
label .prdlg.prsellab -text "Printer:"
label .prdlg.prcoplab -text "Copies:"
entry .prdlg.prsel -textvariable prname -background white -width 15
entry .prdlg.prcop -textvariable copies -background white -width 5
grid configure .prdlg.prcomsel -column 1 -row 1 -pady 5 -padx 5
grid configure .prdlg.prsellab -column 1 -row 2 -pady 5 -padx 5
grid configure .prdlg.prcoplab -column 1 -row 3 -pady 5 -padx 5
grid configure .prdlg.prsel -column 2 -row 2 -pady 5 -padx 5 -sticky "w"
grid configure .prdlg.prcop -column 2 -row 3 -pady 5 -padx 5 -sticky "w"
button .prdlg.prok -text "OK" -command {pr}
button .prdlg.prcancel -text "Cancel" -command {destroy_pr}
grid configure .prdlg.prok -column 1 -row 4 -pady 5 -padx 5
grid configure .prdlg.prcancel -column 2 -row 4 -pady 5 -padx 5
.prdlg.prsel delete 0 end
.prdlg.prsel insert end $August(prname)
.prdlg.prcop delete 0 end
.prdlg.prcop insert end $August(copies)
proc pr {} {
global prcomm textname Augustdir prname copies
if {$prcomm == "lpr"} then {
set cpopt "-#"
set propt "-P"
} else {
set cpopt "-n"
set propt "-d"
}
if {$prname == ""} then {
set prn ""
} else {
set prn "$propt$prname"
}
if {$copies == ""} then {
set cps ""
} else {
set cps "$cpopt$copies"
}
set printer [open "| $prcomm $prn $cps" w]
puts $printer [$textname get 1.0 end]
close $printer
destroy_pr
update_printbox
}
proc destroy_pr {} {
destroy .prdlg
}
}
proc update_printbox {} {
global prcomm copies prname August Augustdir
set August(prcomm) $prcomm
set August(prname) $prname
set August(copies) $copies
set file [file join $Augustdir Augustoptions.tcl]
UserPrefSave $file August
}
# Save user preferences.
proc UserPrefSave {filename arrayname} {
upvar #0 $arrayname array_link
set fileid [open $filename "w"]
set names [array names array_link]
puts $fileid "# PROGRAM OPTIONS. DO NOT EDIT."
foreach name $names {
set var [format "set %s(%s)" $arrayname $name]
puts $fileid "$var \{$array_link($name)\}"
}
puts $fileid "global $arrayname"
close $fileid
}
# Loading user preferences.
proc UserPrefLoad {filename} {
catch {
source $filename
}
}
# Set program options.
proc set_options {} {
# Check if the dialog already exists, and if it does, raise it.
if { [winfo exists .options] == 1 } then {
wm deiconify .options
return
}
catch {
global August
# Keep track of old value for special characters.
set oldchars $August(specchars)
toplevel .options
dialog_position .options
wm title .options "August options"
wm protocol .options WM_DELETE_WINDOW {destroy_options}
wm resizable .options 0 0
label .options.lab1 -text "Document path:"
checkbutton .options.check1 -text "Open/Save to last directory visited" -variable opendirstatus\
-onvalue "yes" -offvalue "no"
checkbutton .options.check2 -text "Use STRONG for BOLD" -variable bold\
-onvalue "STRONG" -offvalue "B"
checkbutton .options.check3 -text "Use EMPHASIS for ITALICS"\
-variable ital -onvalue "EM" -offvalue "I"
checkbutton .options.check4 -text {Show template dialog when choosing "New file"} -variable tpldlg\
-onvalue "yes" -offvalue "no"
checkbutton .options.check5 -text {Syntax coloring} -variable syncolor\
-onvalue "yes" -offvalue "no"
label .options.lab2 -text "Netscape path:"
entry .options.ent1 -textvariable docpath -background white -width 30
entry .options.ent2 -textvariable August(netscapepath)\
-background white -width 30
label .options.lab3 -text "Lynx terminal:"
tk_optionMenu .options.lynxt August(lynxterm) rxvt xterm konsole gnome-terminal
label .options.lab4 -text "Special characters:"
tk_optionMenu .options.spech August(specchars) none swedish italian spanish
label .options.lab5 -text "Identify path:"
entry .options.ent3 -textvariable August(identifypath)\
-background white -width 30
label .options.lab6 -text "Editor font:"
tk_optionMenu .options.font August(font) times courier helvetica misc
label .options.lab7 -text "Editor font size:"
tk_optionMenu .options.fontsize August(fontsize) 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30
label .options.lab8 -text "Editor line wrap:"
tk_optionMenu .options.wrap August(wrap) none word char
global docpath bold italics
button .options.button1 -text "OK" -command "write_prefs $oldchars"
button .options.button2 -text "Cancel" -command {destroy_options}
grid configure .options.lab1 -column 0 -row 1 -padx 3 -pady 3
grid configure .options.lab2 -column 0 -row 8 -padx 3 -pady 3
grid configure .options.ent1 -column 1 -row 1 -padx 3 -pady 3
grid configure .options.ent2 -column 1 -row 8 -padx 3 -pady 3
grid configure .options.lab3 -column 0 -row 9 -padx 3 -pady 3
grid configure .options.lynxt -column 1 -row 9 -padx 3 -pady 3
grid configure .options.lab4 -column 0 -row 10 -padx 3 -pady 3
grid configure .options.spech -column 1 -row 10 -padx 3 -pady 3
grid configure .options.lab5 -column 0 -row 11 -padx 3 -pady 3
grid configure .options.ent3 -column 1 -row 11 -padx 3 -pady 3
grid configure .options.lab6 -column 0 -row 12 -padx 3 -pady 3
grid configure .options.font -column 1 -row 12 -padx 3 -pady 3
grid configure .options.lab7 -column 0 -row 13 -padx 3 -pady 3
grid configure .options.fontsize -column 1 -row 13 -padx 3 -pady 3
grid configure .options.lab8 -column 0 -row 14 -padx 3 -pady 3
grid configure .options.wrap -column 1 -row 14 -padx 3 -pady 3
grid configure .options.check1 -column 1 -row 3 -padx 3 -pady 3\
-sticky "w"
grid configure .options.check2 -column 1 -row 4 -padx 3 -pady 3\
-sticky "w"
grid configure .options.check3 -column 1 -row 5 -padx 3 -pady 3\
-sticky "w"
grid configure .options.check4 -column 1 -row 6 -padx 3 -pady 3\
-sticky "w"
grid configure .options.check5 -column 1 -row 7 -padx 3 -pady 3\
-sticky "w"
grid configure .options.button1 -column 0 -row 15
grid configure .options.button2 -column 1 -row 15
if {$August(openlastdir) == "no"} then {
.options.check1 deselect
} else {
.options.check1 select
}
if {$August(bold) == "B"} then {
.options.check2 deselect
} else {
.options.check2 select
}
if {$August(ital) == "I"} then {
.options.check3 deselect
} else {
.options.check3 select
}
if {$August(tpldialog) == "no"} then {
.options.check4 deselect
} else {
.options.check4 select
}
if {$August(syncolor) == "yes"} then {
.options.check5 select
} else {
.options.check5 deselect
}
if {$docpath == ""} then {
.options.ent1 insert end $August(docpath)
}
proc write_prefs { ochars } {
global Augustdir textname August docpath bold ital tpldlg\
opendirstatus syncolor
set docpath [file join $docpath]
set checkpath [file isdirectory $docpath]
if {$checkpath == 0} then {
notice_box "The choosen document path is not valid!"
.options.ent1 selection range 0 end
return
}
$textname configure -font "$August(font) $August(fontsize)"
$textname configure -wrap "$August(wrap)"
# Tell user to re-start August if special character settings have changed.
if {$August(specchars) != $ochars} then {
notice_box "Please re-start August to enable special character settings!"
}
if {$August(netscapepath) == "netscape"} then {
} else {
if {[file exists $August(netscapepath)] == "0"} then {
notice_box "Not the correct path...!"
.options.ent2 selection range 0 end
return
}
}
if {$August(identifypath) == "identify"} then {
} else {
if {[file exists $August(identifypath)] == "0"} then {
notice_box "Not the correct path...!"
.options.ent3 selection range 0 end
return
}
}
if {$syncolor == "no"} then {
.ed.te.edit1 tag remove alltags 1.0 end
.ed.te.edit1 tag remove conftags 1.0 end
.ed.te.edit1 tag remove imgtags 1.0 end
.ed.te.edit1 tag remove linktags 1.0 end
.ed.te.edit1 tag remove tabletags 1.0 end
} elseif {$syncolor == "yes"} then {
after idle run_tags
}
set August(docpath) $docpath
set August(openlastdir) $opendirstatus
set August(bold) $bold
set August(ital) $ital
set August(tpldialog) $tpldlg
set August(syncolor) $syncolor
set file [file join $Augustdir Augustoptions.tcl]
UserPrefSave $file August
destroy_options
}
proc destroy_options {} {
destroy .options
}
}
}
# Syntax highlighting
proc search_text {string tagname fstindex endindex} {
global textname
#_.ed.te.edit1_ tag remove search $fstindex $endindex
if {$string == ""} {
return
}
while 1 {
set fstindex [_.ed.te.edit1_ search -regexp -nocase -count length $string $fstindex $endindex]
if {$fstindex == ""} {
break
}
_.ed.te.edit1_ tag add $tagname $fstindex "$fstindex + $length char"
set fstindex [_.ed.te.edit1_ index "$fstindex + $length char"]
}
}
proc run_tags {} {
global August
if {$August(syncolor) == "no"} then {
return
}
global textname
set startindex [get_start]
set stopindex [get_end]
search_text {(<[^>]*>)} alltags $startindex $stopindex
update
search_text {(<[^>]*$)} alltags $startindex $stopindex
update
search_text {(^[^<]*>)} alltags $startindex $stopindex
update
search_text {("[^"]*")} conftags $startindex $stopindex
update
search_text " 0 } then {
set path [pwd]
set fnm [lindex $argv 0]
set filetypes [list .htm .html .css .php .php3 .txt]
if { $fnm == "-all" } then {
set dirfiles [glob -nocomplain *]
foreach dirfile $dirfiles {
set fileext [file extension $dirfile]
set filetypestatus [lsearch -exact $filetypes $fileext]
if { $filetypestatus != "-1" } then {
set filetypestatus 1
}
set fileopenstatus [file isdirectory $dirfile]
incr fileopenstatus $filetypestatus
if { $fileopenstatus == 1 } then {
file_open .ed $textname yes "[pwd]/$dirfile"
}
}
return
}
set filestatusa [file exists $fnm]
set filestatusb [file dirname $fnm]
if {$filestatusb == "."} then {
set filepath "$path/$fnm"
} else { set filepath "$fnm"
}
if { $filestatusa == "1" } then {
file_open .ed $textname yes $filepath
} else {
tkwait visibility $textname
file_new .ed $textname $filepath $August(tpldialog)
set fileid [open $filepath "w+"]
close $fileid
}
}
focus $textname
|