#!/usr/bin/env wish

# WISH Supernotepad 2009
# (the 12th version of WISH Supernotepad)
# by David McClamrock <mcclamrock@locl.net>
# based on Tk NotePad 0.5.0 by Joseph Acosta
# and "textedit.tcl" by Eric Foster-Johnson
# with help from Eric Foster-Johnson,
# Graphical Applications with Tcl & Tk (2nd edition)
# and Christopher Nelson, Tcl/Tk Programmer's Reference

# Copyright  2001-2008 David H. McClamrock
# Freely available under Maximum Use License for Everyone
# You should have received a copy of this license with this program.
# If you didn't, e-mail the author to get one.


##################################


### INITIALIZATION ###


# WISH applications require at least Tcl and Tk 8.5:

set tclo [package vcompare [package require Tcl] 8.5]
set tko [package vcompare [package require Tk] 8.5]
if {$tclo < 0 || $tko < 0} {
	tk_messageBox -message "This program requires Tcl and Tk 8.5\
		(or greater, when there is an even greater version)" -type ok
	exit
}
package require Ttk

# Default settings:

set topdir /usr/local
set docdir [file join $topdir doc wishes]
set libdir [file join $topdir lib wishes]
set helpfile [file join $docdir superhelp_link.txt] ; # User Help Guide
set licfile [file join $docdir mule_license.txt] ; # License
set version "2009"
set current_scheme AntiqueBisque

# Where program listings and configuration files go:

set wishdir [file join $env(HOME) .wishes]
set oldwishdir [file join $env(HOME) wishes]
if {[file exists $wishdir] == 0} {
	if {[file exists $oldwishdir] && [file type $oldwishdir] eq "directory"} {
		file rename $oldwishdir $wishdir
		file link $oldwishdir $wishdir
	} else {
		file mkdir $wishdir
	}
}
set colordir [file join $wishdir colorschemes]

# One or more features may work only on unix platforms (including Linux), 
# so identify the platform:
set platforms [split [array get tcl_platform]]
if {"unix" in $platforms} {
	set platform unix
}

# Get lists of recently opened or inserted files,
# and recently cut or copied blocks of text:

set rece [file join $wishdir superece.tcl]

proc getrecent {} {
	global wishdir rece recentlist
	if {[file readable $rece]} {
		source $rece
	} else {
		tk_messageBox -icon error -message "List of recently used files:\n$rece\n\
			not found or not readable" -type ok
		set recentlist [list]
		set reclim 1000
	}
}

getrecent

set superpaste [file join $wishdir superpaste.tcl]
if {[file readable $superpaste]} {
	source $superpaste
} else {
	set pastelist [list]
	set pastelim 1000
}	

# Set some defaults (may be changed by configuration file--see below):

set currentfile "" ; # No name for open file yet
set addfile "" ; # No name for file to add, either
set curprint "" ; # Nor a name for file to print
set backfile "" ; # And no name for backup file
set openins Open ; # By default, open rather than insert file
set openew 0 ; # At first, don't open file in new window
set reclim 1000 ; # Show names of up to 1000 recently used files
set converto 0 ; # Don't convert existing text to HTML unless told to do it
set tabno 0 ; # No tabs have yet been automatically inserted
set dumpfile "" ; # Don't trash old name of file that hasn't yet been renamed
set filetosave none ; # Don't save a file when you haven't done anything
set texwid 80 ; # Width of text widget
set formawid 80 ; # Width of text formatted with newlines
set texhi 32 ; # Height of text widget
set wordwrap word ; # Word wrap on by default
set fonto "courier" ; # Default font
set siz 14 ; # Default font size
set helpfont "helvetica" ; # User Help Guide font
set helpsiz 12 ; # User Help Guide font size
set fontaine [list $fonto $siz] ; # Default font with size
set helpall [list $helpfont $helpsiz] ; # User Help Guide font with size
set reunito 0 ; # Replace needless newlines (if desired) with spaces
set parsep 1 ; # Keep paragraphs separate when omitting needless newlines
set expert 0 ; # Don't do expert search with regular expressions
set headsize 1 ; # size of HTML heading
set html_fontsize 0 ; # Default regular HTML font size
set listtype 1 ; # Use 1-2-3 numbering in HTML list
set autotab 1 ; # Auto-tab to write Tcl code
set palmdir "" ; # Directory to search for Palm Doc files
set t .tx ; # Global variable for text widget
set linkup 0 ; # Don't display Link-Text unless told to
set linklist [list] ; # Nothing yet in list of Link-Text links
set coloron 0 ; # WISH Color Picker Plus not yet loaded
set helpon 0 ; # Nor WISH User Help
if {[info exists env(BROWSER)]} {
	set browser $env(BROWSER)
} else {
	set browser ""
}

# Read configuration file, if there is one:
set superfig [file join $wishdir superfig.tcl]
if {[file readable $superfig]} {
	source $superfig
}

# Procedure to save configuration:

proc savefig {} {
	set figlines "# WISH Supernotepad configuration file (superfig.tcl)\
	\n\nset openins $::openins\
	\nset openew $::openew\
	\nset texwid $::texwid\
	\nset formawid $::formawid\
	\nset texhi $::texhi\
	\nset wordwrap $::wordwrap\
	\nset fonto \"$::fonto\"\
	\nset siz $::siz\
	\nset fontaine \"$::fontaine\"\
	\nset printprog $::printprog\
	\nset reunito $::reunito\
	\nset parsep $::parsep\
	\nset expert $::expert\
	\nset headsize $::headsize\
	\nset html_fontsize $::html_fontsize\
	\nset listtype $::listtype\
	\nset autotab $::autotab\
	\nset browser $::browser\
	\nset current_scheme $::current_scheme"
	set filid [open $::superfig w]
	puts -nonewline $filid $figlines
	close $filid
}

# Initialize lists of widgets for color display:

set buttlist [list] ; # Buttons
set texlist [list] ; # Text widgets
set entlist [list] ; # Entry widgets
set spinlist [list] ; # Spinboxes
set lublist [list] ; # Listboxes
set headlist [list] ; # Emphasized labels
set lightlist [list] ; # Light labels
set checklist [list] ; # Checkbuttons and radiobuttons

# Procedure to find out whether executable program is in system's PATH or not:

proc inpath {prog} {
	global env
	set exok 0
	set envlist [split $env(PATH) :]
	foreach direc $envlist {
		if {[file executable [file join $direc $prog]]} {
			set exok 1
			break
		}
	}
	return $exok
}

# Which program to use for printing (Unix-type systems only):
if {[inpath xpp]} {		
	set printprog xpp	
} else {			
	set printprog lpr
}

# Integer range generator for "foreach"
# (to do a "for" loop without ugly, awkward "for" code):

proc range {start cutoff finish {step 1}} {
	
	# "Step" has to be an integer, and
	# no infinite loops that go nowhere are allowed:
	if {$step == 0 || [string is integer -strict $step] == 0} {
		error "range: Step must be an integer other than zero"
	}
	
	# Does the range include the last number?
	switch $cutoff {
		"to" {set inclu 1}
		"no" {set inclu 0}
		default {
			error "range: Use \"to\" for an inclusive range,\
			or \"no\" for a noninclusive range"
		}
	}
		
	# Is the range ascending or descending (or neither)?
	set ascendo [expr $finish - $start]
	if {$ascendo > -1} {
		set up 1
	} else {
		set up 0
	}
	
	# If range is descending and step is positive but doesn't have a "+" sign,
	# change step to negative:
	if {$up == 0 && $step > 0 && [string first "+" $start] != 0} {
		set step [expr $step * -1]
	}
	
	set ranger [list] ; # Initialize list variable for generated range
	switch "$up $inclu" {
		"1 1" {set op "<=" ; # Ascending, inclusive range}
		"1 0" {set op "<" ; # Ascending, noninclusive range}
		"0 1" {set op ">=" ; # Descending, inclusive range}
		"0 0" {set op ">" ; # Descending, noninclusive range}
	}
	
	# Generate a list containing the specified range of integers:
	for {set i $start} "\$i $op $finish" {incr i $step} {
		lappend ranger $i
	}
	return $ranger
}

### GUI SETUP ###

# Procedure to change display on title bar:

proc wmtitle {} {
	global currentfile
	if {$currentfile eq ""} {
		if {[.tx edit modified]} {
			wm title . "WISH Supernotepad (Save?)"
		} else {
			wm title . "WISH Supernotepad"
		}
	} else {
		if {[.tx edit modified]} {
			wm title . "WISH Supernotepad (Save?) : $currentfile"
		} else {
			wm title . "WISH Supernotepad : $currentfile"
		}
	}
	bind . <Key> {after 10 saveup}
	bind . <Button-2> {after 10 saveup}
}

# Make and arrange mini-toolbar buttons:

frame .froolbar
button .new -text "New" -command file_new
button .open -text "Open" -command {set openins Open ; openrece file}
button .ins -text "Insert" -command {matchinline file}
button .save -text "Save" -command file_save
button .backup -text "Backup" -command backup
button .print -text "Print?" -command printbox
button .cut -text "Cut" -command cut_text
button .copy -text "Copy" -command copy_text
button .paste -text "Paste" -command paste_text
button .undo -text "Undo" -command {catch {.tx edit undo}}
button .redo -text "Redo" -command {catch {.tx edit redo}}
button .special -text "Special" -command specialbox
button .findbutt -text "Find" -command findwhat
button .repbutt -text "Replace" -command search_replace
button .quit -text "Quit" -command gitoot

set miniline [list .new .open .ins .save .backup .print .cut .copy \
	.paste .undo .redo .special .findbutt .repbutt .quit]

foreach mini $miniline {
	$mini configure -pady 0 -padx 0 -bord 1
	lappend buttlist $mini
	pack $mini -in .froolbar -side left -expand 1 -fill both	
}
grid .froolbar -row 0 -column 0 -columnspan 2 -sticky news

# Make the text area and scrollbars:

grid [text .tx -width $texwid -height $texhi -wrap $wordwrap -setgrid 1 \
	-undo 1 -font "$fontaine" -tabs {36 72 108 144 180 216 252 288}] \
	-row 3 -column 0 -sticky news
lappend texlist .tx
grid [ttk::scrollbar .ybar -command ".tx yview"] \
	-row 3 -column 1 -sticky news
grid [ttk::scrollbar .xbar -command ".tx xview" \
	-orient horizontal] \
	-row 4 -column 0 -columnspan 2 -sticky news
.tx configure -xscrollcommand ".xbar set" \
	-yscrollcommand ".ybar set"
grid rowconfigure . 3 -weight 1
grid columnconfigure . 0 -weight 1
focus .tx
set foco .tx
bind .tx <FocusIn> {set foco .tx}
.tx edit separator
.tx edit modified 0
wmtitle

# Procedure to get ready to remove old contents from text area:

proc readytogo {} {
	set exitanswer ""
	if {[.tx edit modified]} {
		if {$::currentfile ne ""} {
			file_save
		} else {
			set exitanswer [tk_messageBox -message "Save changes?" \
				-title "Save changes?" -type yesnocancel -icon question]
			if {$exitanswer eq "yes"} {
				file_saveas
			}
		}
	}
	if {$exitanswer eq "cancel"} {
		return 0
	} else {
		return 1
	}
}

# Procedure to remove old contents from text area:

proc outwithold {} {
	set ::currentfile ""
	set ::backfile ""
	.tx delete 1.0 end
	.tx edit reset
	.tx edit modified 0
}

# Procedure to get saved changes recognized at once:

proc saveup {} {
	if {[.tx edit modified]} {
		bind .tx <Key> {}
		bind .tx <Button-2 {}
		wmtitle
	} else {
		after 100 saveup
	}
}

# Procedure to put contents of new file into text area:

proc inwithnew {} {
	global newfile currentfile platform
	if {$newfile eq "" || [file readable $newfile] == 0} {
		return
	}
	set star [open $newfile "r"]
	set filecont [read $star]
	set filecont [string trimright $filecont]
	.tx insert insert $filecont
	set currentfile $newfile
	.tx edit reset
	.tx edit modified 0
	wmtitle
	close $star
}

# Procedure to clear out irrelevancies so that special widgets
# (Find, Replace, various HTML ones, etc.) can do their work:

proc clearout {} {
	foreach w $::clearframes {
		catch {grid remove $w}
	}
}

# List of possible irrelevancies to be cleared out:

set clearframes [list .prin .need .findreg .replace .fin .fregexp \
	.linenum .head .font .anchor .html_list]

# Procedure to dethrone special widget:

proc clearin {w_out} {
	catch {grid remove $w_out}
	focus .tx
	set foco .tx	
}


### MAIN MENU ###

menu .filemenu -tearoff 0 -borderwidth 1


### FILE MENU ###

menu .filemenu.files -tearoff 0
.filemenu add cascade -label "File" -underline 0 -menu .filemenu.files

### File -- New Text

.filemenu.files add command -label "New Text" \
	-underline 0 -command file_new
	
proc file_new {} {
	set go [readytogo]
	if {$go == 0} {return}
	outwithold
	.tx edit separator
	.tx edit modified 0
	wmtitle
}

### File -- New HTML

.filemenu.files add command -label "New HTML" \
	-underline 4	-command new_html

proc new_html {} {
	global converto
	set go [readytogo]
	if {$go == 0} {return}
	outwithold
	.tx edit separator
	.tx insert 1.0 "<html>\n<head>\
		\n\t<meta name=\"generator\" content=\"WISH Supernotepad\" /> \
		\n\t<meta http-equiv=\"Content-Type\" content=\"text/html;\
		charset=ISO-8859-1\" /> \
		\n<!-- Document title (to be displayed on title bar\
		\n\tof browser) goes in	space below -->\
		\n\t<title>\n\n\
		\n\n</title>\n\t<style type=\"text/css\">\
		\n\t</style>\n</head>\n\n<body\
		text=\"#000000\" link=\"#0000FF\" vlink=\"#FF0000\" alink\
		=\"#FF0000\" bgcolor=\"#FFFFFF\">"
	if {$converto == 0} {
		.tx insert end "\n\
			\n<!-- Contents of document (to be displayed in main browser\
			window) go in space below -->\n\n\n\n</body>\n</html>"
	} else {
		.tx insert end "\n\n\n\n</body>\n</html>"
	}
	.tx mark set insert 9.0
	.tx edit reset
	.tx edit modified 0
	after 1000 wmtitle
}

### File -- New Window

.filemenu.files add command -label "New Window" -underline 4 \
	-accelerator Ctrl+n -command {eval exec supernotepad &}
	
bind . <Control-n> {eval exec supernotepad &}

.filemenu.files add separator

### File -- Open Any

.filemenu.files add command -label "Open Any" \
	-underline 0 -command {file_open any}

proc file_open {which} {
	global newfile currentfile filetosave openins openew
	set openins Open
	set go [readytogo]
	if {$go == 0} {return}
	if {$which eq "any"} {
		set newfile [tk_getOpenFile]
	}
	if {$newfile ne ""} {
		if {$openew} {
			eval exec supernotepad $newfile &
		} else {
			outwithold
			inwithnew
			.tx mark set insert 1.0
			after 100 saverece
		}
	}
	if {[winfo exists .rece]} {
		destroy .rece
	}
}

### File -- Open Recent

.filemenu.files add command -label "Open Recent" -underline 5 -command {
	set openins Open
	openrece file
} -accelerator "Ctrl+. (period)"
bind . <Control-period> {set openins Open ; openrece file}

# Procedure to make GUI box for selecting
# recently opened or inserted files
# (also used for selecting "Superpaste" items):

proc openrece {what} {
	global wishdir rece recentlist reclim newfile addfile mandatum \
		foco currentfile openins findum pastelist pastelim openew \
		buttlist lublist entlist checklist spinlist
	# Get list of recently opened or inserted files:
	getrecent
	set findum ""
	toplevel .rece
	grid [listbox .rece.list -width 72 -height 16 -bg $::textback -fg $::textfore \
		-selectmode extended] -row 0 -column 0 -sticky new
	if {".rece.list" ni $lublist} {
		lappend lublist .rece.list
	}
	grid [ttk::scrollbar .rece.rolly -command [list .rece.list yview]] \
		-row 0 -column 1 -sticky news
	grid [ttk::scrollbar .rece.rollx -orient horizontal \
		-command [list .rece.list xview]] \
		-row 1 -column 0 -columnspan 2 -sticky news
	.rece.list configure -xscrollcommand ".rece.rollx set" \
		-yscrollcommand ".rece.rolly set"
	frame .rece.fir
	checkbutton .rece.new -text "New window?" -variable openew \
		-selectcolor $::textback
	if {".rece.new" ni $checklist} {
		lappend checklist .rece.new
	}
	entry .rece.ent -bg $::textback -fg $::textfore -width 48 \
		-textvariable findum
	if {".rece.ent" ni $entlist} {
		lappend entlist .rece.ent
	}
	label .rece.found -text "0 found"
	pack .rece.new .rece.ent .rece.found -in .rece.fir \
		-side left -expand 1 -fill x
	grid .rece.fir -row 2 -column 0 -columnspan 2 -sticky news
	frame .rece.fr
	
	if {$openins ne "Open" || $what ne "file"} {
		.rece.new configure -state disabled
	}
	button .rece.find -text "Search" -default normal -pady 1 -border 1 \
		-bg $::buttback -fg $::buttfore -relief solid -command findrece
	if {".rece.find" ni $buttlist} {
		lappend buttlist .rece.find
	}
	button .rece.open -default normal
	# This button isn't for Superpaste:
	button .rece.all -text "$openins Any" -default normal -command {
		if {$openins == "Insert"} {
			file_insert any
		} else {
			file_open any
		}
	}
	button .rece.whole -text "See Whole" -default normal -command seewhole
	label .rece.show -text "Show"
	spinbox .rece.spin -width 4 -from 1 -to 9999 -bg $::textback \
		-fg $::textfore -buttonbackground $::buttback
	if {".rece.spin" ni $spinlist} {
		lappend spinlist .rece.spin
	}
	label .rece.fils
	button .rece.unlist -text "Unlist" -default normal -command "unlisto $what"
	button .rece.close -text "Close" -default normal -command {destroy .rece}
	foreach butt [list .rece.find .rece.open .rece.all .rece.unlist \
		.rece.whole .rece.close] {
		$butt configure -pady 1 -padx 0	-bg $::buttback -fg $::buttfore
		if {$butt ni $buttlist} {
			lappend buttlist $butt
		}
	}
	grid .rece.fr -row 3 -column 0 -columnspan 2 -sticky news
	.rece.list see end
	grid columnconfigure .rece 0 -weight 1
	grid rowconfigure .rece 0 -weight 1
	if {$what eq "paste"} {
		wm title .rece "Superpaste"
		.rece.list configure -listvariable pastelist
		bind .rece <Key-Return> {findrece paste}
		.rece.open configure -text "Superpaste" -command superpaste
		.rece.spin configure -textvariable pastelim
		.rece.fils configure -text "items"
		pack .rece.find .rece.open .rece.whole .rece.show .rece.spin \
			.rece.fils .rece.unlist .rece.close -in .rece.fr \
			-side left -expand 1 -fill x
		set mandatum superpaste
	} else {
		wm title .rece "$openins Recently Viewed File"
		.rece.list configure -listvariable recentlist
		bind .rece <Key-Return> {findrece rece}
		.rece.open configure -text $openins -command openorins
		.rece.spin configure -textvariable reclim
		.rece.fils configure -text "files"
		pack .rece.find .rece.open .rece.all .rece.show .rece.spin \
			.rece.fils .rece.unlist .rece.close -in .rece.fr \
			-side left -expand 1 -fill x
		set mandatum openorins
	}
	bind .rece.list <Double-Button-1> {eval $mandatum}
	bind .rece.list <Button-3> {
		selection clear
		set clixel %y
		set clickline [.rece.list nearest $clixel]
		.rece.list selection set $clickline $clickline
		eval $mandatum
	}
	focus .rece.ent
	.rece.list see end
}

# Procedure to paste item from "Superpaste" list:

proc superpaste {} {
	global pastelist foco
	set recenum [.rece.list curselection]
	if {[llength $recenum] != 1} {
		tk_messageBox -message "Please insert one selection\
			at a time" -type ok
	} else {
		$foco insert insert [.rece.list get $recenum]
	}
	selection clear
	.rece.found configure -text "0 found"
	.rece.ent delete 0 end
}

# Procedure to see whole item on "Superpaste" list:

proc seewhole {} {
	global foco texlist
	set seenum [.rece.list curselection]
	if {[llength $seenum] != 1} {
		tk_messageBox -message "Please select exactly one\
			text item to view" -type ok
		return
	}
	toplevel .see
	wm title .see "See Whole"
	grid [text .see.whole -bg $::textback -fg $::textfore] \
		-row 0 -column 0 -sticky news
	if {.see.whole ni $texlist} {
		lappend texlist .see.whole
	}
	grid [ttk::scrollbar .see.ybar -command ".see.whole yview"] \
		-row 0 -column 1 -sticky news
	grid [ttk::scrollbar .see.xbar -orient horizontal \
		-command "see.whole xview"] -row 1 -column 0 \
		-columnspan 2 -sticky news
	.see.whole configure -xscrollcommand ".see.xbar set" \
		-yscrollcommand ".see.ybar set"
	frame .see.fr
	button .see.ins -text "Insert" -command {
		superpaste
		destroy .see
	}
	button .see.close -text "Close" -command {destroy .see}
	foreach butt [list .see.ins .see.close] {
		$butt configure -bg $::buttback -fg $::buttfore
		if {$butt ni $buttlist} {
			lappend buttlist $butt
		}
	}
	
	pack .see.ins .see.close -in .see.fr -side left -expand 1 -fill x
	grid .see.fr -row 2 -column 0 -columnspan 2 -sticky news
	.see.whole insert insert [.rece.list get $seenum]
}

# Procedure to find name of recently viewed file
# or item in "Superpaste" list:

proc findrece {which} {
	global findum recentlist pastelist
	if {$which eq "paste"} {
		set listo $pastelist
	} else {
		set listo $recentlist
	}
	set whatitis [lsearch -all $listo *$findum*]
	set howmany [llength $whatitis]
	if {$howmany > 0} {
		.rece.found configure -text "$howmany found"
		foreach it $whatitis {
			.rece.list selection set $it
		}
		.rece.list see [lindex $whatitis 0]
	} else {
		set findum "NOT FOUND"
		.rece.ent selection range 0 end
		.rece.ent icursor end
	}
}

# Procedure to open or insert recently viewed file:

proc openorins {} {
	global addfile newfile openins openew
	set recenum [.rece.list curselection]
	if {[llength $recenum] != 1} {
		tk_messageBox -message "Please select exactly one file" -type ok
		selection clear
	} else {
		set receline [.rece.list get $recenum]
		if {[file readable $receline] == 0} {
			tk_messageBox -message "file $receline not found" -type ok
			return
		}
		if {$openins eq "Insert"} {
			set addfile $receline
			file_insert recent
		} else {
			if {$openew == 1} {
				eval exec supernotepad $receline &
			} else {
				set newfile $receline
				file_open recent
			}
		}
		if {[winfo exists .rece]} {
			destroy .rece
		}
	}
	savefig
}

# Procedure to delete listings of recently viewed files,
# or of "Superpaste" items:

proc unlisto {which} {
	set delrec [.rece.list curselection]
	set delleng [expr [llength $delrec] -1]
	foreach d [range $delleng to 0] {
		set delnum [lindex $delrec $d]
		.rece.list delete $delnum
	}
	if {$which eq "paste"} {
		savepaste 
	} else {
		after 100 saverece
	}
}

# Procedure to save list of recently opened or inserted files:

proc saverece {} {
	global rece recentlist wishdir newfile currentfile \
		reclim openins addfile dumpfile
	set recleng [expr {[llength $recentlist] -1}]
	foreach r [range $recleng to 0] {
		set rindex [lindex $recentlist $r]
		if {$openins eq "Insert" && $rindex eq $addfile} {
			set recentlist [lreplace $recentlist $r $r]
		} elseif {$rindex eq $currentfile || $rindex eq $dumpfile} {
			set recentlist [lreplace $recentlist $r $r]
		}
	}
	if {$recleng > $reclim} {
		set limless [expr {$recleng-$reclim-1}]
		set recentlist [lreplace $recentlist 0 $limless]
	}
	if {$openins eq "Insert"} {
		lappend recentlist $addfile
	} else {
		lappend recentlist $currentfile
	}
	set recfil [open $rece "w"]
	set recentex "set reclim $reclim\nset recentlist \[list $recentlist\]"
	puts -nonewline $recfil $recentex
	close $recfil
}

### File -- Open (New Window)

.filemenu.files add command -label "Open (New Window)" \
	-underline 13 -command openwin
	
# Procedure to open file in new window:

proc openwin {} {
	set newfie [tk_getOpenFile]
	if {$newfie ne ""} {
		if {$packtype eq "starkit"} {
			if {[inpath tclkit] && [inpath supernotepad.kit]} {
				eval exec tclkit supernotepad.kit $newfie &
			}
		} else {
			eval exec supernotepad $newfie &
		}
	}
}

.filemenu.files add separator

### File -- Save

.filemenu.files add command -label "Save" -underline 0 \
	-command "file_save" -accelerator Ctrl+s
	
bind . <Control-s> {file_save}

proc file_save {} {
	global currentfile filecont
	set filecont [.tx get 1.0 end]
	set texttosave [string trimright $filecont]
	if {$currentfile ne ""} {
		set fileid [open $currentfile "w"]
		puts $fileid $filecont
		close $fileid
		.tx edit reset
		.tx edit modified 0
		wm title . "WISH Supernotepad : Saved $currentfile"
		after 1500 wmtitle
	} else {file_saveas}
}	
	
### File -- Save As

.filemenu.files add command -label "Save As" -underline 5 \
	-command "file_saveas"

proc file_saveas {} {
	global currentfile newfile filecont filetosave
	if {[file writable $currentfile]} {
		file_save
	} else {
		set filecont [.tx get 1.0 end]
	}
	set texttosave [string trimright $filecont]
	if {$currentfile ne ""} {
		set initdir [file dirname $currentfile]
	} else {
		set initdir [pwd]
	}
	set filetosave [tk_getSaveFile -initialdir $initdir]
	if {$filetosave eq ""} {
		return
	}
	set fileid [open $filetosave "w"]
	puts $fileid $filecont
	close $fileid
	set currentfile $filetosave
	.tx edit reset
	.tx edit modified 0
	after 100 saverece
	wm title . "WISH Supernotepad : Saved $currentfile"
	after 1500 wmtitle
}

### File -- Backup

.filemenu.files add command -label "Backup" -command backup

proc backup {} {
	global currentfile backfile
	if {$currentfile ne ""} {
		if {[.tx edit modified]} {
			file_save
		}
	} else {
		tk_messageBox -message "Contents must be saved under one name\
			before they can be backed up under another name" -type ok
		return
	}
	if {[file writable $backfile]} {
		file copy -force $currentfile $backfile
		wm title . "WISH Supernotepad : File backed up as $backfile"
		after 1500 wmtitle
	} else {
		backup_as
	}
}

### File -- Backup As

.filemenu.files add command -label "Backup As" -underline 0 \
	-command "backup_as"
	
proc backup_as {} {
	global currentfile backfile
	if {$currentfile ne ""} {
		if {[.tx edit modified]} {
			file_save
		}
	} else {
		tk_messageBox -message "Contents must be saved under one name\
			before they can be backed up under another name" -type ok
		return
	}
	set initdir [file dirname $currentfile]
	set backfile [tk_getSaveFile -title "Backup As" -initialdir $initdir]
	if {$backfile ne ""} {
		file copy -force $currentfile $backfile
		wm title . "WISH Supernotepad : File backed up as $backfile"
		after 1500 wmtitle
	}
}

### File -- Move/Rename

.filemenu.files add command -label "Move/Rename" -underline 0 \
	-command "file_rename"

# Procedure to move or rename file:

proc file_rename {} {
	global currentfile dumpfile
	if {$currentfile ne ""} {
		set initdir [file dirname $currentfile]
	} else {
		set initdir [pwd]
	}
	set newname [tk_getSaveFile -title "Move/Rename File" -initialdir $initdir]
	if {$newname ne ""} {
		set dumpfile $currentfile
		file rename -force $currentfile $newname
		set currentfile $newname
		file_save
		after 100 saverece
	}
}

.filemenu.files add separator


### File -- Print

.filemenu.files add command -label "Print?" -underline 0 \
	-command printbox -accelerator Ctrl+q

bind . <Control-q> printbox

# Procedure to set up dialog bar for printing:

proc printbox {} {
	global texwid formawid fonto printprog platform spinlist buttlist
	if {$platform ne "unix"} {
		tk_messageBox -message "Sorry, only Unix-type systems can print\
			directly from WISH Supernotepad." -type ok
		return
	}
	clearout
	set formawid $texwid
	if {[winfo exists .prin]} {
		grid .prin
	} else {
		frame .prin
		label .prin.tex -text "Text width:"
		spinbox .prin.spin -width 3 -from 20 -to 200 -textvariable formawid
		lappend spinlist .prin.spin
		label .prin.lab -text "Set other options when X Printing\
			Panel (XPP) is running"
		button .prin.ok -takefocus 0 -default normal \
			-relief solid -border 1 -command {
			filetoprint
			clearin .prin
		}
		button .prin.close -text "Close" -default normal \
			-takefocus 0 -command {
			clearin .prin
		}
		lappend buttlist .prin.ok .prin.close
		pack .prin.tex .prin.spin .prin.lab .prin.ok .prin.close \
			-in .prin -side left -expand 1 -fill x
		grid .prin -row 1 -column 0 -columnspan 2 -sticky news
		focus .prin.spin
	}
	.prin.spin configure -bg $::textback -fg $::textfore \
		-buttonbackground $::buttback
	foreach butt [list .prin.ok .prin.close] {
		$butt configure -bg $::buttback -fg $::buttfore -pady 1
	}
	printswitch
	focus .prin.spin
}

# Procedure to use X Printing Panel (XPP) for printing 
# if available, otherwise lpr:

proc printswitch {} {
	global printprog
	if {$printprog eq "xpp"} {
		.prin.lab configure -state normal
		.prin.ok configure -text "Print with XPP"
	} else {
		.prin.lab configure -state disabled
		.prin.ok configure -text "Print with LPR"
	}
}

# Procedure to save file (if necessary) and format it for printing;

proc filetoprint {} {
	global platform currentfile fonto wishdir printprog \
		formawid texwid wordwrap
	set go [readytogo]
	if {$go == 0} {return}
	.tx configure -width $formawid -wrap word
	wm geometry . {}
	if {$currentfile ne ""} {
		set ::curprint [file rootname $currentfile]
	} else {
		set ::curprint [file join $wishdir printtemp]
	}
	append ::curprint ".fmt"
	after 1000 {
		set formex [formatit print]
		set fileid [open $::curprint "w"]
		puts -nonewline $fileid $formex
		close $fileid
		.tx configure -width $texwid -wrap $wordwrap
		wm geometry . {}
		eval exec $printprog $::curprint &
	}
}

.filemenu.files add separator

### File -- Exit

.filemenu.files add command -label "Exit" -underline 1 -command gitoot

# Procedure to shut down properly:

proc gitoot {} {
	global curprint
	if {[.tx edit modified]} {
		set seeya 1
	} else {
		set seeya 0
	}
	set go [readytogo]
	if {$go == 0} {return}
	savefig
	if {[file exists $curprint]} {
		file delete $curprint
	}
	if {$seeya == 0 || [regexp {Saved} [wm title .]] == 0} {
		exit
	} else {
		# Give the user less than a second to see that changes have been saved:
		after 800 exit
	}
}


### EDIT MENU ###

# using built-in procedures tk_textCut, tk_textCopy, tk_textPaste

menu .filemenu.edit -tearoff 0
.filemenu add cascade -label "Edit" -underline 0 -menu .filemenu.edit

### Edit -- Cut

.filemenu.edit add command -label "Cut" -underline 2 \
	-command cut_text -accelerator Ctrl+x
	
bind . <Control-x> {cut_text ; break}

proc cut_text {} {
	global foco
	if {[winfo class $foco] eq "Text"} {
		tk_textCut $foco
		$foco edit separator
		if {$foco eq ".tx"} {
			wmtitle
		}
	}
}

### Edit -- Copy

.filemenu.edit add command -label "Copy" -underline 0 \
	-command copy_text -accelerator Ctrl+c

bind . <Control-c> {copy_text ; break}

proc copy_text {} {
	global foco
	if {[winfo class $foco] eq "Text"} {
		tk_textCopy $foco
	}
}

### Edit -- Paste

.filemenu.edit add command -label "Paste" -underline 0 \
	-command paste_text -accelerator Ctrl+g

bind . <Control-g> paste_text
# <Control-v> didn't work quite right--I don't know why.

proc paste_text {} {
	global foco
	if {[winfo class $foco] eq "Text"} {
		tk_textPaste $foco
		$foco edit separator
		if {$foco eq ".tx"} {
			wmtitle
		}
	}
}

### Edit -- Delete

.filemenu.edit add command -label "Delete" -underline 0 \
	-command delete_text -accelerator Del

proc delete_text {} {
	.tx delete sel.first sel.last
	.tx edit separator
	wmtitle
}

.filemenu.edit add separator

### Edit -- Supercut

.filemenu.edit add command -label "Supercut" \
	-command supercut -accelerator Ctrl+X
bind . <Control-X> supercut
	
proc supercut {} {
	global foco pastelist
	if {[winfo class $foco] eq "Text"} {
		set anysel [catch {$foco get sel.first sel.last} pastee]
		if {$anysel == 0} {
			if {[lsearch $pastelist $pastee] == -1} {
				lappend pastelist $pastee
			}
			savepaste
		}
		tk_textCut $foco
		$foco edit separator
		if {$foco eq ".tx"} {
			wmtitle
		}
	}
}

### Edit -- Supercopy

.filemenu.edit add command -label "Supercopy" \
	-command supercopy -accelerator Ctrl+C
bind . <Control-C> supercopy

proc supercopy {} {
	global foco pastelist
	if {[winfo class $foco] eq "Text"} {
		set anysel [catch {$foco get sel.first sel.last} pastee]
		if {$anysel == 0} {
			if {[lsearch $pastelist $pastee] == -1} {
				lappend pastelist $pastee
			}
			savepaste
		}
		tk_textCopy $foco
	} else {
		if {[selection own] eq $foco} {
			lappend pastelist [selection get]
			savepaste
		}
	}
}

### Edit -- Superpaste

.filemenu.edit add command -label "Superpaste" -underline 3 \
	-command {matchinline paste} -accelerator F1
bind . <F1> {matchinline paste}

# Procedures to view, select, and paste text from "Superpaste" list
# are under the "File--Open" menu item above, because they use the
# same listbox with slightly different names for buttons and things

# Procedure to paste text from "Superpaste" list
# or to insert file from "Recent File" list, without
# opening the box, if possible; if not, then to open the box:

proc matchinline {whatfor} {
	global pastelist recentlist foco addfile openins
	set anysel [catch {$foco get sel.first sel.last} texas]
	if {$anysel == 0} {
		set firstum [$foco index sel.first]
		set lastum [$foco index sel.last]
	} else {
		set realine [realword]
		set texas [lindex $realine 0]
		set firstum [lindex $realine 1]
		set lastum [lindex $realine end]
	}
	set selgo [$foco index $firstum]
	$foco delete $firstum $lastum
	if {$whatfor eq "paste"} {
		set whatitis [lsearch -all $pastelist *$texas*]
	} else {
		set whatitis [lsearch -all $recentlist *$texas*]
	}
	set howmany [llength $whatitis]
	if {$howmany == 1} {
		set it [lindex $whatitis 0]
		if {$whatfor eq "paste"} {
			$foco insert $selgo [lindex $pastelist $it]
		} else {
			set addfile [lindex $recentlist $it]
			file_insert recent
		}
	} else {
		set openins Insert
		openrece $whatfor
	}
}

# Procedure to identify the real beginning of a real word
# in a text widget (unlike "string wordstart"):

proc realword {} {
	global foco
	set linum [line_number]
	set insum [$foco index insert]
	set linget [string trim [$foco get $linum.0 $insum]]
	set spa [string last " " $linget]
	set ta [string last "\t" $linget]
	if {$spa == -1 && $ta == -1} {
		set wordo $linget
		set wordleng [string length $wordo]
		set firsto [$foco index "$insum - $wordleng char"]
	} else {
		set spend [expr {$spa+1}]
		set tabend [expr {$ta+1}]
		if {$spend > $tabend} {
			set wordo [$foco get $linum.$spend $insum]
			set firsto $linum.$spend
		} else {
			set wordo [$foco get $linum.$tabend $insum]
			set firsto $linum.$tabend
		}
	}
	return [list $wordo $firsto $insum]
}

# Procedure to save "superpaste" list:

proc savepaste {} {
	global pastelist pastelim superpaste
	set pastleng [expr {[llength $pastelist] -1}]
	if {$pastleng > $pastelim} {
		set limless [expr {$pastleng-$pastelim-1}]
		set pastelist [lreplace $pastelist 0 $limless]
	}
	set pastfil [open $superpaste "w"]
	set pastex "set pastelim $pastelim\nset pastelist \[list $pastelist\]"
	puts -nonewline $pastfil $pastex
	close $pastfil
}

.filemenu.edit add separator

### Edit -- Undo

.filemenu.edit add command -label "Undo" -underline 0 -command {
	catch {.tx edit undo}
} -accelerator Ctrl+z
# Binding Ctrl+z is built in

### Edit -- Redo

.filemenu.edit add command -label "Redo" -underline 0 \
	-command {catch {.tx edit redo}} -accelerator Ctrl+r
bind . <Control-r> {catch {.tx edit redo}}
bind . <space> {.tx edit separator}
bind . <BackSpace> {.tx edit separator}

### Edit -- Undo All Since Last Save

.filemenu.edit add command -label "Undo All Since Last Save" \
	-underline 9 -command undolast

# Procedure to undo all changes since last save:

proc undolast {} {
	global currentfile newfile
	if {[.tx edit modified]} {
		.tx delete 1.0 end
		if {$currentfile ne ""} {
			set newfile $currentfile
			inwithnew
		} else {
			.tx edit reset
			.tx edit modified 0
			wmtitle
		}
	} else {
		tk_messageBox -message "No changes have been made since\
			the last save" -type ok
	}
}

.filemenu.edit add separator

### Edit -- Title

.filemenu.edit add command -label "Title" -command title

proc title {} {
	if {[.tx tag ranges sel] eq ""} {return}
	set input [.tx get sel.first sel.last]
	set output ""
	set nocaps [list a an and at but by for from in into of on or the to with]
	set count 0
    foreach word [split $input] {
		# Strip quotation marks:
		if {[string index $word 0] == "\""} {
			set quote 1
			set word [string trim $word \"]
		} else {
			set quote 0
		}
		# Always capitalize the first word; otherwise,
		# don't capitalize any words in the "nocaps" list:
		if {$count == 0 || [lsearch $nocaps $word] == -1} {
			set word [string totitle $word]
		}
		# Add word plus space, with or without quotation marks, to output:
		if {$quote} {
			append output "\"$word\" "
		} else {
			append output "$word "
		}
		# Capitalize any word after a colon:
		if {[string index $word end] == ":"} {
			set count 0
		} else {
			incr count
		}
	}
	set inhere [.tx index sel.first]
	.tx delete sel.first sel.last
	.tx insert $inhere [string trim $output]
}

.filemenu.edit add command -label "Untitle" -command untitle

### Edit -- Untitle

proc untitle {} {
	if {[.tx tag ranges sel] eq ""} {return}
	set input [.tx get sel.first sel.last]
	set inhere [.tx index sel.first]
	.tx delete sel.first sel.last
	.tx insert $inhere [string tolower $input]
}

.filemenu.edit add separator

### Edit -- Select All

.filemenu.edit add command -label "Select all" -underline 7 \
	-command ".tx tag add sel 1.0 end" -accelerator Ctrl+/
# binding <Control-/> is built-in


### INSERT MENU ###

menu .filemenu.insert -tearoff 0
.filemenu add cascade -label "Insert" -underline 0 -menu .filemenu.insert

### Insert -- File -- Any

.filemenu.insert add command -label "File--Any" -underline 0 \
	-command "file_insert any"

proc file_insert {which} {
	global addfile openins foco
	set openins Insert
	# Variable "addfile" may already have been set
	# by another procedure. If not, do this:
	if {$which eq "any"} {
		set addfile [tk_getOpenFile -title "Insert File"]
	}
	if {$addfile ne ""} {
		set star [open $addfile "r"]
		set filecont [read $star]
		close $star
		set filecont [string trimright $filecont]
		$foco insert insert $filecont
		$foco edit separator
		$foco see insert
		wmtitle
	} else {
		unset addfile
	}
	if {[winfo exists .rece]} {
		destroy .rece
	}
}

.filemenu.insert add command -label "File--Recent" -underline 6 \
	-command {matchinline file} -accelerator "Ctrl+, (comma)"
bind . <Control-comma> {matchinline file}

.filemenu.insert add separator

### Insert -- Special Characters

.filemenu.insert add command -label "Special Characters" \
	-underline 0 -command specialbox -accelerator F4
	
bind . <F4> specialbox
	
set charlist [list \
	"" "" "" "" "" \
	"" "" "" "" "" \
	"" "" "" "" "" \
	"" "" "" "" "" \
	"" "" "" "" "" \
	"" "" "" "" "" \
	"" "" "" "" "" \
	"" "" "" "" "" \
	"" "" "" "" "" \
	"" "" "" "" "" \
	"" "" "" "" "" \
	"" "" "" "" "" \
	"" "" "" "" "" \
	"" "" "" "" "" \
	"" "" "" "" "" \
	"" "" "" "" "" \
	"" "" "" "" "" \
	"" "" "" "" "" \
	"" "" "" ""]

# Procedure for finding correct text or entry widget
# and inserting special (or non-special) characters:

proc findwin {char} {
	global foco
	set winclass [winfo class $foco]
	$foco insert insert $char
	if {$winclass == "Text"} {
		$foco edit separator
		wmtitle
	}
	after 10 {focus $foco}
}

# Procedure for setting up special-character selection box:

set specialbutts [list]

proc specialbox {} {
	global charlist foco buttlist
	toplevel .spec
	wm title .spec "Special"
	set bigfons -adobe-helvetica-bold-r-normal--14-*-*-*-*-*-*
	set row 0
	set col 0
	foreach c [range 0 no [llength $charlist]] {
		set chartext [lindex $charlist $c]
		grid [button .spec.but($c) -text $chartext -font $bigfons \
			-pady 1 -padx 2 -borderwidth 1] \
			-row $row -column $col -sticky news
		.spec.but($c) configure -bg $::buttback -fg $::buttfore
		if {".spec.but($c)" ni $buttlist} {
			lappend buttlist .spec.but($c)
		}
		bind .spec.but($c) <Button-1> {
			set butt %W
			set charx [$butt cget -text]
			findwin $charx
		}
		incr col
		if {$col > 4} {
			set col 0
			incr row
		}
	}
		
	grid [button .spec.amp -text "&"] -row $row -column 4 -sticky news
	bind .spec.amp <Button-1> {findwin "&amp;"}
	
	set bigoe_data "
	#define bigoe_width 17
	#define bigoe_height 13
	static unsigned char bigoe_bits[] = {
		0xf8, 0xfe, 0x01, 0xfe, 0xff, 0x01, 0xcf, 0x07, \
		0x00, 0x87, 0x07, 0x00, 0x07, 0x07, 0x00, 0x07, \
		0x3f, 0x00, 0x07, 0x3f, 0x00, 0x07, 0x07, 0x00, \
		0x07, 0x07, 0x00, 0x07, 0x07, 0x00, 0x8e, 0x07, \
		0x00, 0xfc, 0xff, 0x01, 0xf8, 0xfe, 0x01 };"
	image create bitmap bigoe -data $bigoe_data
	grid [button .spec.oebig -image bigoe \
		-pady 1 -padx 2 -borderwidth 1] \
		-row [expr $row+1] -column 0 -sticky news
	bind .spec.oebig <Button-1> {findwin "&#140;"}
	
	set liloe_data "
	#define liloe_width 13
	#define liloe_height 9
	static unsigned char liloe_bits[] = {
		0xbc, 0x07, 0xfe, 0x0f, 0xc3, 0x18, 0xc3, 0x18, \
		0xc3, 0x1f, 0xc3, 0x00, 0xe7, 0x18, 0xfe, 0x0f, \
		0x3c, 0x07 };"
	image create bitmap liloe -data $liloe_data
	grid [button .spec.oelil -image liloe -pady 1 \
		-pady 1 -padx 2 -borderwidth 1] \
		-row [expr $row+1] -column 1 -sticky news
	bind .spec.oelil <Button-1> {findwin "&#156;"}
	
	grid [button .spec.lt -text "<"] \
		-row [expr $row+1] -column 2 -sticky news
	bind .spec.lt <Button-1> {findwin "&lt;"}
	grid [button .spec.gt -text ">"] \
		-row [expr $row+1] -column 3 -sticky news
	bind .spec.gt <Button-1> {findwin "&gt;"}
	grid [button .spec.quot -text "\""] \
		-row [expr $row+1] -column 4 -sticky news
	bind .spec.quot <Button-1> {findwin "&quot;"}
	grid [button .spec.nbsp -text " "] \
		-row [expr $row+2] -column 0 -columnspan 2 -sticky news
	bind .spec.nbsp <Button-1> {findwin "&nbsp;"}
	grid [button .spec.close -text "Close" \
		-command {destroy .spec}] -row [expr $row+2] \
		-column 2 -columnspan 3 -sticky news
	foreach butt [list .spec.oebig .spec.oelil .spec.nbsp .spec.amp \
		.spec.lt .spec.gt .spec.quot .spec.close] {
		$butt configure -pady 1 -padx 2 -borderwidth 1 \
			-bg $::buttback -fg $::buttfore -font $bigfons
		if {$butt ni $buttlist} {
			lappend buttlist $butt
		}
	}
}

.filemenu.insert add separator

### Insert -- Color Code

# Get WISH Color Picker to do this job:

source [file join $libdir wishcolor.tcl]

bind . <Control-F4> {
	wishcolor
	.col.color configure -command {
		$foco insert insert "\"$colo\""
	}
}

.filemenu.insert add command -label "Color Code" -underline 0 -command {
	wishcolor
	.col.color configure -command {
		$foco insert insert "\"$colo\""
	}
} -accelerator Ctrl+F4

.filemenu.insert add separator

### Insert -- Time/Date

.filemenu.insert add command -label "Time/Date" \
	-underline 0 -command printtime

proc printtime {} {
	set nowtime [clock seconds]
	set clocktime [clock format $nowtime -format "%R %p %D"]
	.tx insert insert $clocktime
	.tx edit separator
	wmtitle
}


### SEARCH MENU ###

menu .filemenu.search -tearoff 0
.filemenu add cascade -label "Search" -underline 0 -menu .filemenu.search

### Search -- Find

.filemenu.search add command -label "Find" -underline 0 \
	-command findwhat -accelerator F2
bind . <F2> findwhat 

# Is this a new search or a continuation of one?

proc findwhat {} {
	if {[catch {grid info .findreg} whatnot] == 0 && $whatnot != ""} {
		find_text find
	} else {
		search_find
	}
}

# Initialize some variables and a binding:

set casematch nocase
set searchway forward
set search_query ""
set search_for ""
set searchin sent ; # "AND" connector means terms must be in same sentence
set critters 0 ; # Assume no multiple search criteria connected by "AND"
bind .tx <Button-1> {
	.tx tag remove crit 1.0 end
}


# This shows up when search is done (see proc "find_text," below):

frame .fin
label .fin.is -font "helvetica 16 bold"
button .fin.clo -pady 2 -border 2 -default normal -text "Close" \
	-command whichnew
lappend buttlist .fin.clo
pack .fin.is .fin.clo -in .fin -side left -expand 1 -fill both

# Procedure to determine whether to start over in "Find" or "Replace":

proc whichnew {} {
	set gridslaves [grid slaves .]
	if {".findreg" in $gridslaves} {
		newfind find
	} elseif {".replace" in $gridslaves} {
		newfind replace
	}
	clearin .fin
}

# Procedure to set up "Find" dialog bar:

proc search_find {} {
	global search_query search_for casematch searchway searchin foco \
		anytries findex critters lightlist buttlist 
	set critters 0 ; # Presume no "AND" connector in search criteria
	set findex .findreg
	clearout
	if {[winfo exists .findreg]} {
		grid .findreg
	} else {
		frame .findreg
		set usetext "Substitute . for any one character, * for zero or more,\
			+ for one or more"
		label .finduse -text $usetext -pady 2
		lappend lightlist .finduse
		frame .find
		button .find.next -text "Find (F2)" -pady 1 -command {find_text find}
		entry .find.enter -width 64 -textvariable search_query
		lappend entlist .find.enter
		button .find.new -text "New Search" -pady 1 -command {newfind find}
		button .find.close -text "Close" -pady 1 -command {
			newfind find
			clearin .fin
			clearin .findreg
		}
		pack .find.next .find.enter .find.new .find.close \
			-in .find -side left -expand 1 -fill both
		frame .findex
		button .findex.or -text "OR (|)" -pady 1 -default normal \
			-command {
			.find.enter insert insert "|"
		}
		button .findex.and -text "AND ( & )" -pady 1 -default normal \
			-command {
			.find.enter insert insert " & "
		}
		lappend buttlist .find.next .find.new .find.close .findex.or .findex.and
		label .findex.search -text "Search: " -pady 1
		radiobutton .findex.sent -text "Same sentence" \
			-pady 1 -selectcolor $::textback -variable searchin -value sent
		radiobutton .findex.par -text "Same paragraph" \
			-pady 1 -selectcolor $::textback -variable searchin -value par
		radiobutton .findex.up -text "Up" -variable searchway \
			-value "backward" -selectcolor $::textback -pady 1 
		radiobutton .findex.down -text "Down" -variable searchway \
			-value "forward" -selectcolor $::textback -pady 1 
		checkbutton .findex.match -text "Match case" -selectcolor $::textback \
			-variable casematch -onvalue "exact" -offvalue "nocase" -pady 1
		checkbutton .findex.exp -text "Expert search" -selectcolor $::textback \
			-variable expert -pady 1
		lappend checklist .findex.sent .findex.par .findex.up .findex.down \
			.findex.match .findex.exp
		pack .findex.or .findex.and .findex.search .findex.sent .findex.par \
			.findex.up .findex.down .findex.match .findex.exp -in .findex \
			-side left -expand 1 -fill both
		bind .find <Button-1> {set foco .find.enter}
		bind .find <F2> {find_text find}
		bind .find <F3> {findwin {<br />}}
		foreach {key star fin} {
			<F6> <p> </p> \
			<F8> <i> </i> \
			<F9> <b> </b> \
			<Control-F6> <center> </center> } {
			bind .find.enter $key "dualcodes $star {} $fin"
		}
		pack .finduse .find .findex -in .findreg -side top -expand 1 -fill both  
		grid .findreg -row 1 -column 0 -columnspan 2 -sticky news
	}
	.finduse configure -bg $::lightback -fg $::lightfore
	.find.enter configure -bg $::textback -fg $::textfore
	foreach butt [list .find.next .find.new .find.close .findex.or .findex.and] {
		$butt configure -bg $::buttback -fg $::buttfore
	}
	foreach butt [list .findex.sent .findex.par .findex.up .findex.down \
		.findex.match .findex.exp] {
		$butt configure -selectcolor $::textback	
	}
	focus .find.enter
	set foco .find.enter
	if {$search_for ne ""} {
		set searchlength [string length $search_for]
		.find.enter selection range 0 $searchlength
	}
	set anytries 0
}

# Actually find some matching text:

proc find_text {whatfor} {
	global start herenow nextplace search_query search_for searchin searchway \
		anytries casematch critters countum replace_with repleng \
		critlist expert typetext
	
	# First try:
	if {$anytries == 0} {
		set start [.tx index insert]
		set herenow $start ; # Search starts from here
		set nextplace $herenow ; # Nothing found yet
		if {$whatfor eq "replace"} {
			if {[string first "&" $search_query] >= 0} {
				tk_messageBox -message "Sorry, the \"AND\" connector (&) cannot\
					be used in a \"Replace\" search. Use the \"OR\" connector\
					(|) to replace more than one expression" -type ok
				return
			}
			set repleng [string length $replace_with]
			.place.yesdo configure -text "Replace This" -command replace_one
			focus .with.leave
			bind .rep.enter <Key-Return> replace_one
			bind .with.leave <Key-Return> replace_one
			.place.nodont configure -state normal
			set bojo ".with.leave"
		} else {
			set bojo ".find.enter"
		}
		
		# Separate criteria connected by "AND" (&):
		set multicrits [split $search_query "&"]
		set critlist [list]
		if {[llength $multicrits] > 1} {
			set critters 1 ; # Criteria, plural
			foreach crit $multicrits {
				set crit [string trim $crit]
				if {$crit eq ""} {
					continue
				}
					
				# Turn wildcards into regular expressions; make sure
				# everything intended to be in the same word really is:
				if {$expert == 0} {
					set crit [string map "{.} {\[\[:graph:\]\]} \
						{+} {\[\[:graph:\]\]+?} {*} {\[\[:graph:\]\]*?}" $crit]
						
					# And find the last word whether it's followed by
					# whitespace or punctuation:
					set crit [regsub {[\s]$}	$crit {[\s[[:punct:]]}]
				}
				lappend critlist $crit
			}
		} else {
		
			# OR NOT AND (i.e., simpler search with only "OR" or no connectors):
			set critters 0
			if {$expert == 0} {
				
				# Here we go again:
				# Turn wildcards into regular expressions; make sure
				# everything intended to be in the same word really is:
				set search_for [string map "{.} {\[\[:graph:\]\]} \
					{+} {\[\[:graph:\]\]+?} {*} {\[\[:graph:\]\]*?}" $search_query]
					
				# And find the last word whether it's followed by
				# whitespace or punctuation:
				set search_for [regsub {[\s]$}	$search_for {[\s[[:punct:]]}]
					
			} else {
				# Only self-styled experts should try this with raw regular expressions:
				set search_for $search_query
			}
		}
			
		# Will paragraphs be designated as in HTML (<p>), or plain text (newlines)?
		set topline [.tx get 1.0 3.0]
		if {[regexp -nocase {<html>|<!DOCTYPE} $topline]} {
			set typetext html
		} else {
			set typetext plain
		}
		
		# Widgets won't work when they shouldn't:
		if {$whatfor eq "find"} {
			foreach w [list .find.enter .findex.or .findex.and .findex.search \
				.findex.sent .findex.par .findex.match .findex.exp] {
				$w configure -state disabled
			}
			.find.enter configure -disabledbackground $::textback \
				-disabledforeground $::textfore
		} else {
			foreach w [list .rep.enter .with.leave .place.exp .place.match] {
				$w configure -state disabled
			}
			foreach w [list .rep.enter .with.leave] {
				$w configure -disabledbackground $::textback \
					-disabledforeground $::textfore
			}
		}
		
		set anytries 1
	} else {
		# If not first try, remove previous tags:
		if {$searchway eq "forward"} {
			.tx tag remove crit 1.0 $herenow
		} else {
			.tx tag remove crit $herenow end
		}
	}
	
	# OK, now search:
	if {$critters == 0} {
		# No multiple criteria:
		switch "$searchway $casematch" {
			"forward nocase" {
				set nextplace [.tx search -nocase -regexp \
				-count countum $search_for $herenow end]
			}
			"forward exact" {
				set nextplace [.tx search -regexp \
				-count countum $search_for $herenow end]
			}
			"backward nocase" {
				set nextplace [.tx search -nocase -backward -regexp \
				-count countum $search_for $herenow 1.0]
			}
			"backward exact" {
				set nextplace [.tx search -backward -regexp \
				-count countum $search_for $herenow 1.0]
			}
		}
				
		# Is there anything to be found?
		if {$nextplace eq ""} {
			# Maybe there isn't:
			if {$herenow eq $start} {
				set endmess "No matching text found"
			} else {
				if {$searchway eq "forward"} {
					set finis "end"
				} else {
					set finis "beginning"
				}
				set endmess "Search completed from line\
					[expr int($start)] to $finis"
			}
			catch {selection clear}
			.fin.is configure -text $endmess
			grid .fin -row 2 -column 0 -columnspan 2 -sticky news
			return
			
		} else {
			# Or maybe there is:
			if {$searchway eq "forward"} {
				.tx mark set insert "$nextplace + $countum chars"
			} else {
				.tx mark set insert $nextplace
			}
			
			# If so, select and see what's been found:
			catch {.tx tag remove sel sel.first sel.last}
			catch {.tx tag remove crit 1.0 end}
			.tx tag add sel $nextplace "$nextplace + $countum chars"
			.tx see $nextplace
		}
	} else {
		# Multiple criteria:
		set thisplace $herenow
		foreach crit $critlist {
			switch "$searchway $casematch" {
				"forward nocase" {
					set critplace [.tx search -nocase -regexp $crit $herenow end]
				}
				"forward exact" {
					set critplace [.tx search -regexp $crit $herenow end]
				}
				"backward nocase" {
					set critplace [.tx search -nocase -regexp $crit $herenow 1.0]
				}
				"backward exact" {
					set critplace [.tx search -regexp $crit $herenow 1.0]
				}
			}
			if {$critplace eq ""} {
				# Nothing found:
				if {$herenow eq $start} {
					set endmess "No matching text found"
				} else {
					if {$searchway eq "forward"} {
						set finis "end"
					} else {
						set finis "beginning"
					}
					set endmess "Search completed from line\
						[expr int($start)] to $finis"
				}
				catch {selection clear}
				.fin.is configure -text $endmess
				grid .fin -row 2 -column 0 -columnspan 2 -sticky news
				return
			} else {
				# Skip as far ahead as possible while not missing
				# any location where all criteria might be found:
				if {[.tx compare $critplace > $thisplace]} {
					set thisplace $critplace
				}
			}	
		}
		
		# Identify sentence or paragraph in which to see if all are found:
		if {$searchin eq "par"} {
			if {$typetext eq "html"} {
				set star [.tx search -backward -regexp \
					-nocase {<p>|<h[1-6]>} $thisplace 1.0]
				set endo [.tx search -regexp \
					-nocase {<p>|</p>|<h[1-6]>} $thisplace end]
			} else {
				set star [.tx search -backward -regexp "\\n\\n|\\n\\t" $thisplace 1.0]
				set endo [.tx search -regexp "\\n\\n|\\n\\t" $thisplace end]
			}
		} else {
			if {$typetext eq "html"} {
				set star [.tx search -backward -regexp \
					-nocase {!|\.|\?|<p>|<h[1-6]>} $thisplace 1.0]
				set endo [.tx search -regexp \
					-nocase {!|\.|\?|<p>|</p>|<h[1-6]>} $thisplace end]
			} else {
				set star [.tx search -backward -regexp {\\n|!|\.|\?} $thisplace 1.0]
				set endo [.tx search -regexp {\\n|!|\.|\?} $thisplace end]
			}
		}
		if {$star eq ""} {
			set star 1.0
		}
		if {$endo eq ""} {
			set endo "end -1c"
		}
		set unitext [.tx get $star $endo]
				
		# If even one is missing, move on quick:
		set isthisit 1
		foreach crit $critlist {
			if {$casematch eq "nocase"} {
				if {[regexp -nocase $crit $unitext] == 0} {
					set isthisit 0
					break
				}
			} else {
				if {[regexp $crit $unitext] == 0} {
					set isthisit 0
					break
				}
			}
		}
		if {$searchway eq "forward"} {
			set herenow [.tx index "$endo +1 chars"]
		} else {
			set herenow [.tx index "$star -1 chars"]
		}
		if {$isthisit == 0} {
			catch {find_text $whatfor}
		} else {
			# If all are present, mark and (if possible) see them all:
			.tx see $herenow
			foreach crit $critlist {
				if {$casematch eq "nocase"} {
					set finds [.tx search -regexp -nocase -all \
					-count counties $crit $star $endo]
				} else {
					set finds [.tx search -regexp -all \
					-count counties $crit $star $endo]
				}
				foreach num [range 0 no [llength $finds]] {
					set findnum [lindex $finds $num]
					.tx tag add crit $findnum "$findnum + [lindex \
						$counties $num] chars"
				}
			}
		}
	}
	
	# Prepare for next search try:
	if {$critters == 0} {
		set herenow [.tx index insert]
	} else {
		.tx mark set insert $herenow
	}
	if {$whatfor eq "find"} {
		focus .tx
		set foco .tx
	}
}

# Procedure to start searching from scratch:

proc newfind {why} {
	global critters
	set ::search_query ""
	set ::search_for ""
	set ::anytries 0
	clearin .fin
	if {$why eq "find"} {
		foreach w [list .find.enter .findex.or .findex.and .findex.search \
			.findex.sent .findex.par .findex.match .findex.exp] {
			$w configure -state normal
		}
		focus .find.enter
	} else {
		clearin .fin
		set ::replace_with ""
		set ::repleng 0
		.place.yesdo configure -text "Find First" -command {find_text replace}
		.place.nodont configure -state disabled
		foreach w [list .rep.enter .with.leave .place.exp .place.match] {
			$w configure -state normal
		}
		set ::start [.tx index insert]
		bind .rep.enter <Key-Return> {find_text replace}
		bind .with.leave <Key-Return> {find_text replace}
		focus .rep.enter
	}
}

.filemenu.search add separator	

### Search -- Replace (Standard)

.filemenu.search add command -label "Replace (Standard)" -underline 0 \
	-command "search_replace"

# Procedures for replacing text

# Set up "Replace" dialog bar:

proc search_replace {} {
	global casematch searchway start foco anytries critters search_query \
		search_for replace_with findex autotab oldautotab expert
	if {$autotab == 1} {
		set oldautotab 1
		set autotab 0
		autotaborno
	} else {
		set oldautotab 0
	}
	set findex .replace
	set searchway forward
	set start [.tx index insert]
	clearout
	if {[winfo exists .replace]} {
		grid .replace
	} else {
		frame .replace
		set usetext "Substitute . for any one character, * for zero or more,\
			+ for one or more; | for \"OR\""
		label .repuse -text $usetext -pady 2
		lappend lightlist .repuse
		frame .rep
		label .rep.what -text "Replace:"
		entry .rep.enter -width 80 -textvariable search_query
		pack .rep.what .rep.enter -in .rep -side left -expand 1 -fill both
		frame .with
		label .with.what -text "With:     "
		entry .with.leave -width 80 -textvariable replace_with
		lappend entlist .rep.enter .with.leave
		pack .with.what .with.leave -in .with -side left -expand 1 -fill both
		frame .place
		button .place.yesdo -text "Find First" -default normal \
			-relief solid -border 1 -command {find_text replace}
		button .place.nodont -text "Skip" -command {find_text replace} \
			-default normal -state disabled
		button .place.all -text "Replace All" -default normal \
			-command replace_all
		checkbutton .place.exp -text "Expert search (with regular\
			expressions)" -variable expert
		checkbutton .place.match -text "Match case" -pady 1 \
			-variable casematch -onvalue "exact" -offvalue "nocase"
		button .place.new -text "New Search" -pady 1 -default normal \
			-command {newfind replace}
		button .place.close -text "Close" -pady 1 -default normal \
			-command repdoon
		lappend buttlist .place.yesdo .place.nodont .place.all \
			.place.new .place.close
		lappend checklist .place.exp .place.match
		pack .place.yesdo .place.nodont .place.all .place.exp .place.match \
			.place.new .place.close -in .place -side left -expand 1 -fill both
		pack .repuse .rep .with .place -in .replace -side top -expand 1 -fill both
		bind .rep.enter <Key-Return> {find_text replace}
		bind .with.leave <Key-Return> {find_text replace}
		bind .rep.enter <F3> {findwin {<br />}}
		bind .with.leave <F3> {findwin {<br />}}
		foreach {key star fin} {<F6> <p> </p> \
			<F8> <i> </i> \
			<F9> <b> </b> \
			<Control-F6> <center> </center>} {
			bind .rep.enter $key "dualcodes $star {} $fin"
			bind .with.leave $key "dualcodes $star {} $fin"
		}
		bind .rep.enter <Button-1> {set foco .rep.enter}
		bind .with.leave <Button-1> {set foco .with.leave}
		grid .replace -row 1 -column 0 -columnspan 2 -sticky news
	}
	.repuse configure -bg $::lightback -fg $::lightfore
	foreach ent [list .rep.enter .with.leave] {
		$ent configure -bg $::textback -fg $::textfore
	}
	foreach butt [list .place.yesdo .place.nodont .place.all \
		.place.new .place.close] {
		$butt configure -bg $::buttback -fg $::buttfore -pady 1
	}
	foreach butt [list .place.exp .place.match] {
		$butt configure -selectcolor $::textback
	}
	focus .rep.enter
	set foco .rep.enter
	set anytries 0
}

# Procedure to get done with replacing:

proc repdoon {} {
	global autotab oldautotab
	if {$oldautotab == 1} {
		set autotab 1
		autotaborno
	}
	newfind replace
	clearin .fin
	clearin .replace
}

# Replace one instance at a time, with confirmation or disconfirmation

proc replace_one {} {
	global nextplace findlength repleng countum \
		start herenow search_for replace_with currentfile
	catch {.tx tag remove sel sel.first sel.last}
	set subtext [.tx get $nextplace "$nextplace + $countum chars"]
	set subin [regsub -nocase $search_for $subtext $replace_with]
	.tx delete $nextplace "$nextplace + $countum chars"
	.tx insert $nextplace $subin
	.tx see $nextplace
	.tx edit separator
	wmtitle
	find_text replace
}

# Replace all instances, without confirmation

proc replace_all {} {
	global replace_with search_query search_for casematch expert herenow nextplace
	if {[string first "&" $search_for] >= 0} {
		tk_messageBox -message "Sorry, \"Replace All\" will not work with\
			expressions containing the \"AND\" connector (&). Use the \"OR\"\
			connector (|) to replace several expressions with the same one" -type ok
		return
	}
	set herenow 1.0
	selection clear
	if {$expert == 0} {
		# Turn wildcards into regular expressions; make sure
		# everything intended to be in the same word really is:
		set search_for [string map "{.} {\[\[:graph:\]\]} \
			{+} {\[\[:graph:\]\]+?} {*} {\[\[:graph:\]\]*?}" $search_query]
			
		# And find the last word whether it's followed by
		# whitespace or punctuation:
		set search_for [regsub {[\s]$}	$search_for {[\s[[:punct:]]}]
		set surf 1 ; # First search criterion identified
				
	} else {
		
		# Only self-styled experts should try this with raw regular expressions:
		set search_for $search_query
	}
	
	# Find all matches to be replaced:
	if {$casematch eq "nocase"} {
		set anysubs [.tx search -regexp -all -nocase -count amount \
			$search_for $herenow end]
		
	} else {
		set anysubs [.tx search -regexp -all -count amount \
			$search_for $herenow end]
	}
	set subleng [expr {[llength $anysubs] - 1}]
	
	# Replace them in reverse order, so any difference between length of 
	# matching expression and length of replacement won't cause disaster:
	foreach num [range $subleng to 0] {
		set beginsub [lindex $anysubs $num]
		set endsub "$beginsub + [lindex $amount $num] chars"
		set subtext [.tx get $beginsub $endsub]
		set subin [regsub -nocase $search_for $subtext $replace_with]
		.tx delete $beginsub $endsub
		.tx insert $beginsub $subin
	}
	if {$subleng >= 0} {
		set finis "All matching text replaced"
	} else {
		set finis "No matching text found"
	}
	.fin.is configure -text $finis
	grid .fin -row 2 -column 0 -columnspan 2 -sticky news
}

### Search -- Replace (Multiple)

.filemenu.search add command -label "Replace (Multiple)" -underline 9 -command multirep

# Procedure to set up GUI box for multiple replace:
	
proc multirep {} {
	global m n foco casematch entlist buttlist checklist
	set m 1
	toplevel .mult
	wm title .mult "Replace (Multiple)"
	set n [expr $m-1]
	grid [label .mult.place($n) -text "Replace: "] \
		-row $n -column 0 -sticky news
	grid [entry .mult.ent($n) -bg $::textback -fg $::textfore -width 50] \
		-row $n -column 1 -sticky news
	if {".mult.ent($n)" ni $entlist} {
		lappend entlist .mult.ent($n)
	}
	grid [label .mult.with($m) -text "with: "] \
		-row $m -column 0 -sticky news
	grid [entry .mult.wix($m) -bg $::textback -fg $::textfore -width 50] \
		-row $m -column 1 -sticky news
	if {".mult.wix($m)" ni $entlist} {
		lappend entlist .mult.wix($m)
	}
	frame .mult.fr
	button .mult.more -text "Show More Pairs" -default normal \
		-relief solid -border 1 -command morepairs
	checkbutton .mult.match -text "Match case" -selectcolor $::textback \
		-variable casematch -onvalue exact -offvalue nocase
	if {".mult.match" ni $checklist} {
		lappend checklist .mult.match
	}
	button .mult.replall -text "Replace All" -default normal -command replall
	button .mult.close -text "Close" -takefocus 0 -default normal -command {
		set m 1
		set n 0
		destroy .mult
		focus .tx
		set foco .tx
	}
	foreach butt [list .mult.more .mult.replall .mult.close] {
		$butt configure -takefocus 0 -bg $::buttback -fg $::buttfore
		if {$butt ni $buttlist} {
			lappend buttlist $butt
		}
	}
	pack .mult.more .mult.match .mult.replall \
		.mult.close -in .mult.fr -side left -expand 1 -fill both
	morepairs
	focus .mult.ent(0)
	set foco .mult.ent(0)
	bind .mult <Key-Return> morepairs
}

# Procedure to add more entry widgets for multiple replace:

proc morepairs {} {
	global m n foco entlist
	incr m 2
	set n [expr $m-1]
	grid forget .mult.fr
	grid [label .mult.place($n) -text "Replace: "] \
		-row $n -column 0 -sticky news
	grid [entry .mult.ent($n) -bg $::textback -fg $::textfore -width 50] \
		-row $n -column 1 -sticky news
	if {".mult.ent($n)" ni $entlist} {
		lappend entlist .mult.ent($n)
	}
	grid [label .mult.with($m) -text "with: "] \
		-row $m -column 0 -sticky news
	grid [entry .mult.wix($m) -bg $::textback -fg $::textfore -width 50] \
		-row $m -column 1 -sticky news
	if {".mult.wix($m)" ni $entlist} {
		lappend entlist .mult.wix($m)
	}
	grid .mult.fr -row [expr $m+1] -column 0 -columnspan 2 -sticky news
	if {$n > 2} {
		focus .mult.ent($n)
		set foco .mult.ent($n)
	}
	bind .mult <F3> {findwin {<br />}}
	foreach {key star fin} {
		<F6> <p> </p> \
		<F8> <i> </i> \
		<F9> <b> </b> \
		<Control-F6> <center> </center>
	} {bind .mult $key "dualcodes $star {} $fin"}
	foreach i [range 0 to $m] {
		if {[winfo exists .mult.ent($i)]} {
			bind .mult.ent($i) <Button-1> "set foco .mult.ent($i)"
		} elseif {[winfo exists .mult.wix($i)]} {
			bind .mult.wix($i) <Button-1> "set foco .mult.wix($i)"
		}
	}
}

# Procedure to perform multiple replace:

proc replall {} {
	global m n foco casematch
	set replist [list]
	set itall [.tx get 1.0 "end -1c"]
	foreach e [range 1 to $m 2] {
		set f [expr $e-1]
		set rep($f) [.mult.ent($f) get]
		set rep($e) [.mult.wix($e) get]
		if {$rep($f) ne ""} {
			lappend replist $rep($f) $rep($e)
		}
	}
	if {$casematch eq "exact"} {
		set newitall [string map "$replist" $itall]
	} else {
		set newitall [string map -nocase "$replist" $itall]
	}
	.tx delete 1.0 "end -1c"
	.tx insert 1.0 $newitall
	.tx edit separator
	wmtitle
	focus .tx
	set foco .tx
	destroy .mult
}

.filemenu.search add separator

# Search -- Line Number

.filemenu.search add command -label "Line Number/Word Count" -underline 0 \
	-command wordline -accelerator Ctrl+w

bind . <Control-w> wordline

# Procedure to find out what line number the cursor is on:

proc line_number {} {
	global foco
	set herenow [$foco index insert]
	set lineno [expr int($herenow)]
	return $lineno
}

# Procedure to count words:

proc wordcount {} {
	set wordsnow [.tx get 1.0 {end -1c}]
	set wordlist [split $wordsnow]
	set countnow 0
	foreach item $wordlist {
		if {$item ne ""} {
			incr countnow
		}
	}
	return $countnow
}

# Set up "Line Number/Word Count" dialog bar:

proc wordline {} {
	clearout
	if {[winfo exists .line]} {
		grid .line
	} else {
		frame .line
		label .line.goto -text "Go to line number: " -pady 2
		entry .line.number -width 6
		lappend entlist .line.number
		button .line.ok -text "GO" -default normal \
			-relief solid -border 1 -command gotoline
		label .line.word -text "Word count: " -pady 2
		label .line.count -relief sunken -width 12 -pady 2
		button .line.recount -border 1 -text "Recount" -default normal \
			-command recount
		button .line.close -border 1 -text "Close" -default normal -command {
			clearin .line
		}
		lappend buttlist .line.ok .line.recount .line.close
		bind .line.number <Key-Return> gotoline
		pack .line.goto .line.number .line.ok .line.word .line.count \
			.line.recount .line.close -in .line \
			-side left -expand 1 -fill x
		grid .line -row 1 -column 0 -columnspan 2 -sticky news
	}
	.line.number configure -bg $::textback -fg $::textfore
	foreach butt [list .line.ok .line.recount .line.close] {
		$butt configure -bg $::buttback -fg $::buttfore -pady 1
	}
	.line.count configure -bg $::lightback -fg $::lightfore
	recount
}

# Procedure to recount words and re-identify line number:

proc recount {} {
	set lineno [line_number]
	.line.number delete 0 end
	.line.number insert 0 $lineno
	set linedigits [string length $lineno]
	.line.number selection range 0 $linedigits
	focus .line.number
	.line.count configure -text [wordcount]
}

# Procedure to go to another line, identified by number:

proc gotoline {} {
	set newlineno [.line.number get]
	.tx mark set insert $newlineno.0
	.tx see insert
	focus .tx
	set foco .tx
}


### HTML MENU ###

menu .filemenu.html -tearoff 0
.filemenu add cascade -label "HTML" -underline 2 -menu .filemenu.html

# Procedure to insert starting and ending codes for HTML
# (or Tcl/Tk) code and to put cursor in the right place:

proc dualcodes {star cont fin} {
	global foco
	set winclass [winfo class $foco]
	set selon [catch {$foco index sel.first}]
	
	if {$selon == 1} {
		# No selected text:
		if {$cont == {}} {
			$foco insert insert "$star$fin"
			set goback [string length $fin]
			if {$winclass == "Text"} {
 				$foco mark set insert "[$foco index insert] \
					- $goback chars"
				$foco see insert
				$foco edit separator
				if {$foco == ".tx"} {
					wmtitle
				}
			} else {
				$foco icursor [expr [$foco index insert] - $goback]
			}
		} else {
			$foco insert insert "$star$cont$fin"
		}
	} else {
		# Text selected:
		$foco insert sel.first "$star"
		$foco insert sel.last "$fin"
		set goforth [expr {[string length $fin] +1}]
		if {$winclass == "Text"} {
			$foco mark set insert "sel.last + $goforth chars"
			$foco see insert
			$foco edit separator
			if {$foco eq ".tx"} {
				wmtitle
			}
		} else {
			$foco icursor [expr {[$foco index insert] + $goforth}]
		}
	}
	selection clear
	after 10 {focus $foco}
}

# HTML -- Plain Text to HTML

.filemenu.html add command -label "Plain Text to HTML" -underline 14 \
	-command {convert_to_html plain} -accelerator Ctrl+H
bind . <Control-H> {convert_to_html plain}

.filemenu.html add command -label "Link-Text to HTML" -underline 7 \
	-command {convert_to_html link}

proc convert_to_html {what} {
	global converto lincoln linkhead
	set converto 1
	if {$lincoln} {
		# Show codes, don't display Link-Text:
		set lincoln 0
		unlink .tx
	}
	if {$what eq "link"} {
		set linkhead [.tx search "<end linkhead>" 1.0 end]
		if {$linkhead eq ""} {
			set linkhead 1.0
		}
		
		# Find link beginnings and ends:
		set linkstars [.tx search -regexp -all \
			-count clink "<link .+?>" 1.0 end]
		set linkends [.tx search -all "</link>" 1.0 end]
			
		# Make list of links; then temporarily hide them
		# so they won't be mistaken for their targets:
		.tx tag configure hide -elide 1
		for {set i 0} {$i < [llength $linkstars]} {incr i} {
			set star [lindex $linkstars $i] ; # Begin link-start tag
			set starleng [lindex $clink $i] ; # Length of link-start tag
			set starsplit [split $star "."]
			set starline [lindex $starsplit 0] ; # Line number in text
			set starchar [lindex $starsplit end] ; # Position in line
			set starend $starline.[expr {$starchar + $starleng}]
			set linkstar [.tx get $star $starend]
			set linkname [string map "{link } {} {\"} {} {<} {} {>} {}" \
				$linkstar]
			lappend linklist [list $starend "$linkname"]
			set finis [lindex $linkends $i]
			.tx tag add hide $star "$finis +7c"
		}
		
		# Search for targets and make a non-duplicative list of them:
		set targlist [list]
		set loclist [list]
		foreach link $linklist {
			set targ [lindex $link end]
			if {[lsearch $targlist $targ] == -1} {
				set linkloc [lindex $link 0]
				if {[.tx compare $linkloc < $linkhead]} {
					set target [.tx search -count ct "$targ" $linkhead end]
				} else {
					set target [.tx search -count ct "$targ" $linkloc end]
					if {$target eq ""} {
						set target [.tx search -backwards -count ct "$targ" \
							$linkloc $linkhead]
					}
				}
				if {$target ne ""} {
					lappend targlist $targ
					lappend loclist [list $target $ct]
				}
			}
		}
		
		# Run backward through the list,
		# adding anchor codes all the way:
		set locleng [expr {[llength $loclist] -1}]
		foreach t [range $locleng to 0] {
			set targstar [lindex $loclist $t 0]
			set targleng [lindex $loclist $t end]
			set targname [lindex $targlist $t]
			set targend [.tx index "$targstar + $targleng chars"]
			.tx insert $targend "</a>"
			.tx insert $targstar "<a name=\"$targname\">"
		}
	}
	.tx tag delete hide
	set textutnunc [.tx get 1.0 {end -1c}]
	outwithold
	if {$what eq "link"} {
		set textutnunc [string map {
			"<link \"" "<a href=\"#"\
			"</link>" "</a>"\
			"<a name=\"" "<a name=\""
			"\">" "\">"
			"&" "&amp;"\
			"<" "&lt;"\
			">" "&gt;"\
			"\"" "&quot;"\
			"<end linkhead>" ""\
			"<c>" "<center>"\
			"</c>" "</center>"\
			"<bi>" "<b><i>"\
			"<ib>" "<i><b>"\
			"<bc>" "<b><center>"\
			"<cb>" "<center><b>"\
			"<ic>" "<i><center>"\
			"<ci>" "<center><i>"\
			"</bi>" "</b></i>"\
			"</ib>" "</i></b>"\
			"</bc>" "</b></center>"\
			"</cb>" "</center></b>"\
			"</ic>" "</i></center>"\
			"</ci>" "</center></i>"\
			"<bic>" "<b><i><center>"\
			"<bci>" "<b><center><i>"\
			"<icb>" "<i><center><b>"\
			"<ibc>" "<i><b><center>"\
			"<cib>" "<center><i><b>"\
			"<cbi>" "<center><b><i>"\
			"</bic>" "</b></i></center>"\
			"</bci>" "</b></center></i>"\
			"</icb>" "</i></center></b>"\
			"</ibc>" "</i></b></center>"\
			"</cib>" "</center></i></b>"\
			"</cbi>" "</center></b></i>"\
		} $textutnunc]
	} else {
		set textutnunc [string map {
			"&" "&amp;"\
			"<" "&lt;"\
			">" "&gt;"\
			"\"" "&quot;"
		} $textutnunc]
	}
	new_html
	.tx insert 18.0 $textutnunc\n
	set lastend [.tx index end]
	set lastnums [split $lastend .]
	set lastline [lindex $lastnums 0]
	set lastbutfour [expr $lastline - 4]
	.tx mark set insert 18.0
	.tx insert 18.0 "<p>"
	set lineno [line_number]
	while {$lineno < $lastbutfour} {
		set endoline [.tx index "$lineno.0 lineend"]
		set isthisblank [expr $endoline - $lineno.0]
		set nextline [expr $lineno + 1]
		set endonext [.tx index "$nextline.0 lineend"]
		set isnextblank [expr $endonext - $nextline.0]
		if {$isthisblank ne 0.0 && $isnextblank eq 0.0} {
			.tx insert $endoline "</p>"
		}
		if {$isthisblank ne 0.0 && $isnextblank ne 0.0} {
			.tx insert $nextline.0 "<br />"
		}
		if {$isthisblank eq 0.0 && $isnextblank ne 0.0} {
			.tx insert $nextline.0 "<p>"
		}
		incr lineno
	}
	.tx mark set insert 9.0
	.tx edit separator
	set converto 0
	after 1000 wmtitle
}

.filemenu.html add separator

# Procedure to tell whether to put HTML codes into
# main text widget or HTML Table Data Entry box:

# HTML -- Heading

.filemenu.html add command -label "Heading" -underline 0 \
	-command headingbox -accelerator Ctrl+F9
	
bind . <Control-F9> headingbox

set headsize 1

# Procedure to set up heading selection dialog bar:

proc headingbox {} {
	global headsize selon foco lastfoco autotab oldautotab \
		entlist spinlist buttlist
	set lastfoco $foco
	clearout
	if {$autotab == 1} {
		set oldautotab 1
		set autotab 0
		autotaborno
	} else {
		set oldautotab 0
	}
	if {[winfo exists .head]} {
		grid .head
	} else {
		frame .head
		label .head.text -text "Heading Text: "
		entry .head.enter -width 50
		lappend entlist .head.enter
		set selon [catch {.tx get sel.first sel.last}]
		if {$selon == 0} {
			.head.enter insert insert [.tx get sel.first sel.last]
		}
		label .head.size -text "Heading size:"
		spinbox .head.spin -width 1 -from 1 -to 6 -textvariable headsize
		lappend spinlist .head.spin
		button .head.insert -text "Insert" -default normal \
			-relief solid -border 1 -command headin
		button .head.close -text "Close" -default normal -command doonhead
		lappend buttlist .head.insert .head.close
		bind . <Key-Return> headin
		bind .head <F3> {findwin {<br />}}
		foreach {key star fin} {
			<F6> <p> </p> \
			<F8> <i> </i> \
			<F9> <b> </b> \
			<Control-F6> <center> </center>} {
			bind . $key "dualcodes $star {} $fin"
		}
		pack .head.text .head.enter .head.size .head.spin .head.insert \
			.head.close -in .head -side left -expand 1 -fill x
		grid .head -row 1 -column 0 -columnspan 2 -sticky news
	}
	.head.enter configure -bg $::textback -fg $::textfore
	.head.spin configure -bg $::textback -fg $::textfore \
		-buttonbackground $::buttback
	foreach butt [list .head.insert .head.close] {
		$butt configure -bg $::buttback -fg $::buttfore -pady 1
	}
	focus .head.enter
	set foco .head.enter
	bind .head <FocusIn> {set foco .head.enter}
}

# Procedure for inserting heading and codes:

proc headin {} {
	global headsize foco lastfoco
	set foco $lastfoco
	set cont [.head.enter get]
	dualcodes <h$headsize> "$cont" </h$headsize>
	.head.enter delete 0 end
	focus $foco
}

# Procedure to get done with headings:

proc doonhead {} {
	global autotab oldautotab
	if {$oldautotab == 1} {
		set autotab 1
	}
	autotaborno
	clearin .head
}

# HTML -- Font

.filemenu.html add command -label "Font" -underline 0 \
	-command fontbox -accelerator Ctrl+F8

bind . <Control-F8> fontbox

set html_fontsize 0
set html_fontcolor ""
set colorcall ""

# Procedure to stop displaying font widgets:

proc dumpboxes {} {
	global foco
	if {[winfo exists .colo]} {destroy .colo}
	clearin .font
	focus $foco
}

# Procedure to set up font selection dialog bar:

proc fontbox {} {
	global colo html_fontsize html_fontcolor colorcall \
		spinlist entlist buttlist
	clearout
	if {[winfo exists .font]} {
		grid .font
	} else {
		frame .font
		label .font.size -text "Font size:"
		spinbox .font.spin -bg white -width 1 -textvariable html_fontsize \
			 -from "-2" -to 4
		lappend spinlist .font.spin
		label .font.color -text "Font Color:"
		entry .font.colornum -width 10 -textvariable colo
		lappend entlist .font.colornum
		button .font.select -text "Select Color" -command {
			if {$colorcall ne ""} {set colorcall ""}
			wishcolor
		}
		button .font.insertcolor -text "Insert Color" \
			-command insert_fontcolor
		button .font.insertsize -text "Insert size" \
			-command insert_fontsize
		button .font.insertboth -text "Insert size + Color" \
			-command insert_sizencolor
		button .font.close -text "Close" -command dumpboxes
		foreach butt [list .font.select .font.insertcolor .font.insertsize \
			.font.insertboth .font.close] {
			$butt configure -padx 2 -borderwidth 1
			lappend buttlist $butt
		}
		pack .font.size .font.spin .font.color .font.colornum .font.select \
			.font.insertcolor .font.insertsize .font.insertboth .font.close \
			-in .font -side left -expand 1 -fill x
		grid .font -row 1 -column 0 -columnspan 2 -sticky news
	}
	.font.colornum configure -bg $::textback -fg $::textfore
	.font.spin configure -bg $::textback -fg $::textfore \
		-buttonbackground $::buttback
	foreach butt [list .font.select .font.insertcolor .font.insertsize \
		.font.insertboth .font.close] {
		$butt configure -bg $::buttback -fg $::buttfore -default normal -pady 1
	}
	focus .font.spin
}

# Procedure to insert font color in HTML code:

proc insert_fontcolor {} {
	global colo html_fontcolor foco
	set html_fontcolor $colo
	dualcodes "<font color=\"$html_fontcolor\">" {} </font>
}

# Procedure to insert font size in HTML code:

proc insert_fontsize {} {
	global html_fontsize foco
	if {$html_fontsize > 0} {
		set sizz "+$html_fontsize"
	} elseif {$html_fontsize < 0} {
		set sizz "-$html_fontsize"
	}
	dualcodes "<font size=\"$sizz\">" {} </font>
}

# Procedure to insert font size and color in HTML code:

proc insert_sizencolor {} {
	global colo html_fontsize html_fontcolor foco
	if {$html_fontsize > 0} {
		set sizz "+$html_fontsize"
	} elseif {$html_fontsize < 0} {
		set sizz "-$html_fontsize"
	}
	set html_fontcolor $colo
	dualcodes "<font size=\"$sizz\"\
		color=\"$html_fontcolor\">" {} </font>
}

.filemenu.html add separator

# HTML -- Anchor

.filemenu.html add command -label "Anchor" -underline 0 \
	-command "anchorbox" -accelerator Ctrl+F7
	
bind . <Control-F7> anchorbox

set lastanchor ""

# Procedure to set up anchor insertion dialog bar:

proc anchorbox {} {
	global lastanchor foco lastfoco autotab oldautotab
	if {$autotab == 1} {
		set oldautotab 1
		set autotab 0
		autotaborno
	} else {
		set oldautotab 0
	}
	set lastfoco $foco
	clearout
	if {[winfo exists .anchor]} {
		grid .anchor
	} else {
		frame .anchor
		label .anchor.name -text "Anchor name: "
		entry .anchor.enter -width 64 -textvariable lastanchor
		lappend entlist .anchor.enter
		if {[catch {.tx get sel.first sel.last}] == 0} {
			.anchor.enter insert insert [.tx get sel.first sel.last]
		}
		button .anchor.insert -text "Insert" -default normal \
			-relief solid -border 1 -command insert_anchor
		button .anchor.close -text "Close" -default normal \
			-command anchordoon
		lappend buttlist .anchor.insert .anchor.close
		pack .anchor.name .anchor.enter .anchor.insert .anchor.close \
			-in .anchor -side left -expand 1 -fill x
		bind .anchor <FocusIn> {set foco .anchor.enter}
		grid .anchor -row 1 -column 0 -columnspan 2 -sticky news
		bind . <Key-Return> insert_anchor
	}
	.anchor.enter configure -bg $::textback -fg $::textfore
	foreach butt [list .anchor.insert .anchor.close] {
		$butt configure -bg $::buttback -fg $::buttfore -pady 1
	}
	focus .anchor.enter
	set foco .anchor.enter
}

# Procedure to insert anchor:

proc insert_anchor {} {
	global lastanchor foco lastfoco
	set foco $lastfoco
	set cont [.anchor.enter get]
	dualcodes "<a name=\"$lastanchor\">" "$cont" </a>
}

# Procedure to get done with anchors:

proc anchordoon {} {
	global autotab oldautotab
	if {$oldautotab == 1} {
		set autotab 1
	}
	autotaborno
	clearin .anchor
}

# HTML -- Link

.filemenu.html add command -label "Link" -underline 3 \
	-command linkbox -accelerator F7
	
bind . <F7> linkbox

set linktype "http://www."
set textype html

# Procedure to set up link entry dialog bar:

proc linkbox {} {
	global linktype lastanchor foco lastfoco autotab oldautotab \
		entlist buttlist
	set lastfoco $foco
	if {$autotab == 1} {
		set oldautotab 1
		set autotab 0
		autotaborno
	} else {
		set oldautotab 0
	}
	if {[winfo exists .link]} {
		grid .link
		.url.linkent insert 0 $linktype
		bind . <Key-Return> insert_link
	} else {
		frame .link
		frame .url
		label .url.urlink -text "Link to what? "
		entry .url.linkent -width 90
		.url.linkent insert 0 $linktype
		pack .url.urlink .url.linkent -in .url \
			-side left -expand 1 -fill both
		frame .show
		label .show.display -text "Display name: "
		entry .show.name -width 90 -bg white
		lappend entlist .url.linkent .show.name
		pack .show.display .show.name -in .show \
			-side left -expand 1 -fill both
		frame .butt
		button .butt.www -text "WWW" -default normal -command {
			set textype html
			linkup "http://www."
		}
		button .butt.email -text "E-mail" -default normal -command {
			set textype html
			linkup "mailto:"
		}
		button .butt.ftp -text "FTP" -default normal -command {
			set textype html
			linkup "ftp://"
		}
		button .butt.anchor -text "Anchor" -default normal -command {
			set textype html
			linkup "#"
		}
		button .butt.linktext -text "Link-Text" -default normal -command {
			set textype link
			linkup ""
		}
		button .butt.other -text "Other" -default normal -command {
			set textype html
			linkup ""
		}
		button .butt.insert -text "Insert Link" -default normal \
			-relief solid -border 1 -command insert_link
		button .butt.close -text "Close" -default normal	-command linkdoon
		lappend buttlist .butt.www .butt.email .butt.ftp .butt.anchor \
			.butt.linktext .butt.other .butt.close
		foreach butt [list .butt.www .butt.email .butt.ftp .butt.anchor \
			.butt.linktext .butt.other .butt.insert .butt.close] {
			pack $butt -in .butt -side left -expand 1 -fill both
		}
		bind . <Key-Return> insert_link
		bind .show.name <F3> {findwin {<br />}}
		foreach {key star fin} {
			<F6> <p> </p> \
			<F8> <i> </i> \
			<F9> <b> </b> \
			<Control-F6> <center> </center>} {
			bind .show.name $key "dualcodes $star {} $fin"}
		bind .url.linkent <FocusIn> {set foco .url.linkent}
		bind .show.name <FocusIn> {set foco .show.name}
		pack .url .show .butt -in .link -side top -expand 1 -fill both
		grid .link -row 1 -column 0 -columnspan 2 -sticky news
	}
	foreach ent [list .url.linkent .show.name] {
		$ent configure -bg $::textback -fg $::textfore
	}
	foreach butt [list .butt.www .butt.email .butt.ftp .butt.anchor \
		.butt.linktext .butt.other .butt.insert .butt.close] {
		$butt configure -bg $::buttback -fg $::buttfore -pady 1
	}
	if {[catch {.tx get sel.first sel.last}] == 0} {
		.show.name insert insert [.tx get sel.first sel.last]
	}
	focus .url.linkent
	set foco .url.linkent
}

# Procedure to insert link prefix:

proc linkup {prefix} {
	global linktype textype
	if {$linktype ne $prefix} {
		set linktype $prefix
		.url.linkent delete 0 end
		.show.name delete 0 end
		.url.linkent insert 0 $linktype
		focus .url.linkent
	}
}

# Procedure to insert link:

proc insert_link {} {
	global linktype textype foco lastfoco
	set foco $lastfoco
	set link_id [.url.linkent get]
	if {[catch {.tx get sel.first sel.last}] == 0} {
		set link_name {}
	} else {
		set link_name [.show.name get]
	}
	if {$textype eq "html"} {
		dualcodes "<a href=\"$link_id\">" "$link_name" </a>
	} else {
		dualcodes "<link \"$link_id\">" "$link_name" </link>
	}
	.url.linkent delete 0 end
	.show.name delete 0 end
	linkdoon
}

# Procedure to get done with links:

proc linkdoon {} {
	global autotab oldautotab
	if {$oldautotab == 1} {
		set autotab 1
	}
	autotaborno
	clearin .link
}

.filemenu.html add separator

# HTML -- Image

.filemenu.html add command -label "Image" -underline 1 \
	-command imagebox -accelerator Ctrl+F11
	
bind . <Control-F11> imagebox

# Procedure for setting up image insertion box:

proc imagebox {} {
	global alignimage imagedir image_hspace image_vspace imageheight \
		imagewidth imagebordo imagepath imagedir dirurl foco lastfoco \
		entlist buttlist checklist spinlist lightlist
	if {[info exists imagepath] == 0} {
		set imagepath relative
	}
	if {[info exists alignimage] == 0} {
		set alignimage left
	}
	if {[info exists dirurl] == 0} {
		set dirurl ""
	}
	foreach var [list image_hspace image_vspace imageheight \
		imagewidth imagebordo] {set $var 0}
	set lastfoco $foco
	if {[winfo exists .image]} {destroy .image}
	toplevel .image
	wm title .image "Insert Image Source"
	
	grid [label .image.dest -text "Directory URL:" -pady 4] \
		-row 0 -column 0 -sticky news
	grid [entry .image.url -textvariable dirurl] \
		-row 0 -column 1 -columnspan 2 -sticky ew
	if {$imagepath eq "relative"} {
		foreach widget [list .image.dest .image.url] {
			$widget configure -state disabled
		}
	} else {
		foreach widget [list .image.dest .image.url] {
			$widget configure -state normal
		}
	}
	
	grid [label .image.filename -text "Image file name:" -pady 4] \
		-row 1 -column 0 -sticky news
	grid [entry .image.enter -width 56] \
		-row 1 -column 1 -columnspan 2 -sticky ew
	foreach ent [list .image.url .image.enter] {
		$ent configure -bg $::textback -fg $::textfore
		if {$ent ni $entlist} {
			lappend entlist $ent
		}
	}
		
	frame .image.fr2
	button .image.pick -text "Pick Image" -command pickimage \
		-bg $::buttback -fg $::buttfore -default normal
	if {".image.pick" ni $buttlist} {
		lappend buttlist .image.pick
	}
	
	label .image.path -text "Path to Image: "
	radiobutton .image.rel -text "Relative" -variable imagepath \
		-value "relative" -command {
		foreach widget [list .image.dest .image.url] {
			$widget configure -state disabled
		}
		focus .image.enter
	}
	radiobutton .image.abso -text "Absolute" -variable imagepath \
		-value "absolute" -command {
		foreach widget [list .image.dest .image.url] {
			$widget configure -state normal
		}
		focus .image.url
	}
	foreach radio [list .image.rel .image.abso] {
		$radio configure -selectcolor $::textback
		if {$radio ni $checklist} {
			lappend checklist $radio
		}
	}
	ttk::menubutton .image.lineup -text "Alignment" -menu .image.lineup.menu
	menu .image.lineup.menu -tearoff 0
	foreach way [list left right top middle bottom] {
		.image.lineup.menu add command -label $way -command "set alignimage $way"
	}
	pack .image.pick .image.path .image.rel .image.abso .image.lineup \
		-in .image.fr2 -side left -expand 1 -fill both
	grid .image.fr2 -row 2 -column 0 -columnspan 3 -sticky news
	grid [label .image.optinfo -bg $::lightback -fg $::lightfore \
		-text "O P T I O N A L   I N F O R M A T I O N :" -pady 6] \
		-row 3 -column 0 -columnspan 3 -sticky news
	if {".image.optinfo" ni $lightlist}	{
		lappend lightlist .image.optinfo
	}
	grid [label .image.alt -text "Image description:" -pady 4] \
		-row 4 -column 0 -sticky news
	grid [entry .image.altinhere -bg $::textback -fg $::textfore -width 56] \
		-row 4 -column 1 -columnspan 2 -sticky ew
	if {".image.altinhere" ni $entlist} {
		lappend entlist .image.altinhere
	}
	frame .image.fr5
	label .image.horspace -text "Spacing:  Horiz" -pady 4
	spinbox .image.horizhere -width 4 \
		-buttonbackground $::buttback \
		-textvariable image_hspace -from 0 -to 1000
	label .image.vertspace -text " Vert" -pady 4
	spinbox .image.vertinhere -width 4 -bg white \
		-buttonbackground $::buttback\
		-textvariable image_vspace -from 0 -to 1000
	label .image.height -text " Height" -pady 4
	spinbox .image.heightinhere -width 5 -bg white \
		-buttonbackground $::buttback\
		-textvariable imageheight -from 0 -to 10000
	label .image.width -text " Width" -pady 4
	spinbox .image.widthinhere -width 5 -bg white \
		 -buttonbackground $::buttback \
		-textvariable imagewidth -from 0 -to 10000
	label .image.bordo -text " Border" -pady 4
	spinbox .image.bordohere -width 3 -bg white \
		-buttonbackground $::buttback \
		-textvariable imagebordo -from 0 -to 100
	foreach spin [list .image.horizhere .image.vertinhere .image.heightinhere \
		.image.widthinhere .image.bordohere] {
		$spin configure -bg $::textback -fg $::textfore \
			-buttonbackground $::buttback
		if {$spin ni $spinlist}	 {
			lappend spinlist $spin
		}
	}
	pack .image.horspace .image.horizhere .image.vertspace .image.vertinhere \
		.image.height .image.heightinhere .image.width .image.widthinhere \
		.image.bordo .image.bordohere -in .image.fr5 \
		-side left -expand 1 -fill x
	grid .image.fr5 -row 5 -column 0 -columnspan 3 -sticky news
	
	frame .image.fr6	
	button .image.insert -text "Insert" -default normal \
		-relief solid -border 1 -command insert_image
	button .image.close -text "Close" -default normal -command {
		focus .tx
		set foco .tx
		destroy .image
	}
	foreach butt [list .image.insert .image.close] {
		$butt configure -bg $::buttback -fg $::buttfore
		if {$butt ni $buttlist} {
			lappend buttlist $butt
		}
	}
	pack .image.insert .image.close -in .image.fr6 \
		-side left -expand 1 -fill both
	grid .image.fr6 -row 6 -column 0 -columnspan 3 -sticky news
	
	bind .image <Key-Return> insert_image
	if {$imagepath eq "relative"} {
		focus .image.enter
		set foco .image.enter
	} else {
		focus .image.url
		set foco .image.url
	}
	foreach ent [list .image.url .image.enter .image.altinhere] {
		bind $ent <FocusIn> "set foco $ent"
	}
}

# Procedure to pick image file name:

proc pickimage {} {
	global imagepath foco currentfile
	if {$currentfile ne ""} {
		set imagedir [file dirname $currentfile]
	} else {
		set imagedir [pwd]
	}
	set imagefile [tk_getOpenFile -title "Pick Image File" \
		-initialdir $imagedir]
	set imagename [file tail $imagefile]
	.image.enter insert 0 $imagename
	focus .image.enter
	set foco .image.enter
}

# Procedure to insert image source into HTML code:

proc insert_image {} {
	global alignimage codestart codend image_hspace image_vspace \
		imageheight imagewidth imagebordo foco imagepath dirurl lastfoco
	set foco $lastfoco
	set img_src [.image.enter get]
	if {$imagepath eq "absolute" && [regexp "$dirurl" $img_src] == 0} {
		set dirurl [string trimright $dirurl "/"]
		set img_src $dirurl/$img_src
	}
	set alttext [.image.altinhere get]
	if {$alttext ne ""} {
		set alttext " alt=\"$alttext\""
	}
	if {$image_hspace > 0} {
		set imhup " hspace=\"$image_hspace\""
	} else {
		set imhup ""
	}
	if {$image_vspace > 0} {
		set imvup " vspace=\"$image_vspace\""
	} else {
		set imvup ""
	}
	if {$imageheight > 0} {
		set imhut " height=\"$imageheight\"" 
	} else {
		set imhut ""
	}
	if {$imagewidth > 0} {
		set imgwid " width=\"$imagewidth\""
	} else {
		set imgwid ""
	}
	if {$imagebordo > 0} {
		set imbord " border=\"$imagebordo\""
	} else {
		set imbord ""
	}
	$foco insert insert \
		"<img src=\"$img_src\"\
			align=\"$alignimage\"$alttext$imhup$imvup$imhut$imgwid$imbord>"
	$foco edit separator
	if {$foco eq ".tx"} {
		wmtitle
	}
	foreach var [list image_hspace image_vspace imageheight \
		imagewidth imagebordo] {set $var 0}
	destroy .image
}

.filemenu.html add separator

# HTML -- List

.filemenu.html add command -label "List" -underline 2 \
	-command html_list -accelerator F11
	
bind . <F11> html_list

set listtype 1
set liston 0
set ordo 1

# Procedure to set up dialog bar for list item entry:

proc html_list {} {
	global listtype liston foco lastfoco autotab oldautotab \
		entlist buttlist checklist
	if {$autotab == 1} {
		set oldautotab 1
		set autotab 0
		autotaborno
	} else {
		set oldautotab 0
	}
	if {[winfo class $foco] eq "Text"} {
		set lastfoco $foco
	} else {
		set lastfoco .tx
	}
	if {$liston == 1} {set liston 0}
	if {[winfo exists .html_list]} {
		grid .html_list
	} else {
		frame .html_list
		frame .html
		label .html.item -text "List item: "
		entry .html.itemhere -width 72
		lappend entlist .html.itemhere
		if {[catch {$foco get sel.first sel.last}] == 0} {
			.html.itemhere insert insert [$foco get sel.first sel.last]
		}
		button .html.insert -text "Insert" -default normal \
			-relief solid -border 1 -command insert_item
		button .html.done -text "Done" -default normal \
			-command finish_list
		lappend buttlist .html.insert .html.done
		pack .html.item .html.itemhere .html.insert .html.done \
			-in .html -side left -expand 1 -fill x
		frame .list
		label .list.style -text "Style: "
		radiobutton .list.123 -text "1-2-3" -variable listtype -value 1
		radiobutton .list.capa -text "A-B-C" -variable listtype -value A
		radiobutton .list.abc -text "a-b-c" -variable listtype -value a
		radiobutton .list.capi -text "I-II-III" -variable listtype -value I
		radiobutton .list.iii -text "i-ii-iii" -variable listtype -value i
		radiobutton .list.disc -text "Discs" -variable listtype -value disc
		radiobutton .list.circle -text "Circles" -variable listtype \
			-value circle
		radiobutton .list.square -text "Squares" -variable listtype \
			-value square
		lappend checklist .list.style .list.123 .list.capa .list.abc \
			.list.capi .list.iii .list.disc .list.circle .list.square
		pack .list.style .list.123 .list.capa .list.abc .list.capi .list.iii \
			.list.disc .list.circle .list.square -in .list \
			-side left -expand 1 -fill both
		pack .list .html -in .html_list -side top -expand 1 -fill both
		grid .html_list -row 1 -column 0 -columnspan 2 -sticky news
		bind .html_list <FocusIn> {set foco .html.itemhere}
		bind .html.itemhere <Key-Return> insert_item
		bind .html_list <F3> {findwin {<br />}}
		foreach {key star fin} {
			<F6> <p> </p> \
			<F8> <i> </i> \
			<F9> <b> </b> \
			<Control-F6> <center> </center>
		} {bind .html_list $key "dualcodes $star {} $fin"}
	}
	.html.itemhere configure -bg $::textback -fg $::textfore
	foreach butt [list .html.insert .html.done] {
		$butt configure -bg $::buttback -fg $::buttfore -pady 1
	}
	foreach radio [list .list.123 .list.capa .list.abc .list.capi \
		.list.iii .list.disc .list.circle .list.square] {
		$radio configure -selectcolor $::textback
	}
	focus .html.itemhere
	set foco .html.itemhere
}

# Procedure to create list and insert items:

proc insert_item {} {
	global listchoice listtype liston ordo foco lastfoco
	set list_item [.html.itemhere get]
	if {[catch {$lastfoco get sel.first sel.last}] == 0} {
		$lastfoco delete sel.first sel.last
	}
	if {$liston == 0} {
		switch $listtype {
			1 -
			A -
			a -
			I -
			i {
				set ordo 1
			}
			disc -
			circle -
			square {
				set ordo 0
			}
		}
		if { $ordo == 1 } {
			$lastfoco insert insert \
				"<ol type=$listtype>\n\t<li>$list_item</li>\n"
		} else {
			$lastfoco insert insert \
				"<ul type=$listtype>\n\t<li>$list_item</li>\n"
		}
		set liston 1
	} else {
		$lastfoco insert insert "\t<li>$list_item</li>\n"
	}
	.html.itemhere delete 0 end
	$lastfoco edit separator
	wmtitle
	focus .html.itemhere
	set foco .html.itemhere
}

# Procedure to finish off list:

proc finish_list {} {
	global ordo foco lastfoco autotab oldautotab
	if {$ordo == 1} {
		$lastfoco insert insert "</ol>\n\n"
	} else {
		$lastfoco insert insert "</ul>\n\n"
	}
	set liston 0
	set foco $lastfoco
	$foco edit separator
	if {$foco eq ".tx"} {
		wmtitle
	}
	clearin .html_list
	if {$oldautotab == 1} {
		set autotab 1
		autotaborno
	}
}

# HTML -- Table

.filemenu.html add command -label "Table: Create" -underline 0 \
	-command tablebox -accelerator F12
	
bind . <F12> tablebox

.filemenu.html add command -label "Table: Continue" -underline 8 -command {
	set rowon 0
	set celltype Data
	.tx insert insert "\n\t"
	databox
} -accelerator Ctrl+F12

bind . <Control-F12> {
	set rowon 0
	set celltype Data
	.tx insert insert "\n\t"
	databox
}
	
# Initialize variables for table attributes:

foreach var [list tableon tablesum table_hspace table_vspace tableheight \
	tablewidth tablebordo cellpad cellspace] {set $var 0}
set tablecolor ""

# Procedure to create Table Setup box:

proc tablebox {} {
	global color tablecolor blankrows blankcols tablesum table_hspace \
		table_vspace tableheight tablewidth tablebordo cellpad cellspace \
		tablecolor celltype foco buttlist entlist spinlist lightlist
	if { [winfo exists .table] } { destroy .table }
	toplevel .table
	wm title .table "HTML Table Setup"
	grid [button .table.withdata -text "M A K E   T A B L E" \
		-default normal -relief solid -border 1 -command {
			get_tablecodes
			make_table
			set celltype Header
			databox
			destroy .table
		}] -row 0 -column 0 -columnspan 7 -sticky news
	grid [button .table.close -text "Close" -default normal -command { 
		destroy .table
		focus .tx
		set foco .tx
		}] -row 0 -column 7 -columnspan 5 -sticky news
	grid [label .table.optinfo -bg $::lightback -fg $::lightfore \
		-text "O P T I O N A L   I N F O R M A T I O N :" -pady 6] \
		-row 1 -column 0 -columnspan 11 -sticky news
	if {".table.optinfo" ni $lightlist} {
		lappend lightlist .table.optinfo
	}
	grid [label .table.sum -text "Table summary:" -pady 6] \
		-row 2 -column 0 -columnspan 2 -sticky news
	grid [entry .table.suminhere -width 40] \
		-row 2 -column 2 -columnspan 9  -sticky ew
	grid [label .table.horspace -text "Spacing: Horiz" -pady 6] \
		-row 3 -column 0 -columnspan 2 -sticky news
	grid [spinbox .table.horizhere -width 4 \
		-textvariable table_hspace -from 0 -to 1000] \
		-row 3 -column 2 -sticky ew
	grid [label .table.vertspace -text "Vert" -pady 6] \
		-row 3 -column 3 -sticky news
	grid [spinbox .table.vertinhere -width 4 -bg white \
		-textvariable table_vspace -from 0 -to 1000] \
		-row 3 -column 4 -sticky ew
	grid [label .table.height -text "Height" -pady 6] \
		-row 3 -column 5 -sticky news
	grid [spinbox .table.heightinhere -width 5 -bg white \
		-textvariable tableheight -from 0 -to 10000] \
		-row 3 -column 6 -sticky ew
	grid [label .table.width -text "Width" -pady 6] \
		-row 3 -column 7 -sticky news
	grid [spinbox .table.widthinhere -width 5 -bg white \
		-textvariable tablewidth -from 0 -to 10000] \
		-row 3 -column 8 -sticky ew
	grid [label .table.bordo -text "Border" -pady 6] \
		-row 3 -column 9 -sticky news
	grid [spinbox .table.bordohere -width 3 -bg white \
		-textvariable tablebordo -from 0 -to 100] \
		-row 3 -column 10 -sticky ew
	grid [label .table.cellpad -text "Space inside cells" -pady 6] \
		-row 4 -column 0 -columnspan 2 -sticky news
	grid [spinbox .table.padhere -width 3 -bg white \
		-textvariable cellpad -from 0 -to 100] \
		-row 4 -column 2 -sticky ew
	grid [label .table.cellspace -text "Space between cells" -pady 6] \
		-row 4 -column 3 -columnspan 3 -sticky news
	grid [spinbox .table.spacehere -width 3 -bg white \
		-textvariable cellspace -from 0 -to 100] \
		-row 4 -column 6 -sticky ew
	grid [label .table.allinpixels -text "(all in pixels)"] \
		-row 4 -column 7 -columnspan 4 -sticky news
	grid [label .table.tablecolor -text "Background color:"] \
		-row 5 -column 0 -columnspan 2 -sticky news
	grid [label .table.colorcode -textvariable color] \
		-row 5 -column 2 -columnspan 2 -sticky news
	grid [button .table.colorsel -text "Select color" -default normal -command {
		if {$colorcall ne ""} {set colorcall ""}
		wishcolor
		}] -row 5 -column 4 -columnspan 3 -sticky news
	grid [button .table.colordesel -text "Deselect color" -default normal \
		-command { set color "" }] \
		-row 5 -column 7 -columnspan 4 -sticky news
	bind .table <Key-Return> {
		get_tablecodes ; make_table ; databox ; destroy .table
	}
	.table.suminhere configure -bg $::textback -fg $::textfore
	if {".table.suminhere" ni $entlist} {
		lappend entlist .table.suminhere
	}
	foreach spin [list .table.horizhere .table.vertinhere \
		.table.heightinhere .table.widthinhere .table.bordohere \
		.table.padhere .table.spacehere] {
		$spin configure -bg $::textback -fg $::textfore \
			-buttonbackground $::buttback
		if {$spin ni $spinlist} {
			lappend spinlist $spin
		}
	}
	foreach butt [list .table.withdata .table.close .table.colorsel \
		.table.colordesel] {
		$butt configure -bg $::buttback -fg $::buttfore
		if {$butt ni $buttlist} {
			lappend buttlist $butt
		}
	}
	focus .table.suminhere
	set foco .table.suminhere
	bind .table.suminhere <FocusIn> {set foco .table.suminhere}
}

# Procedure to get HTML codes for table attributes from user input:

proc get_tablecodes {} {
	global blankcols blankrows color tablecolor table_hspace table_vspace \
		tableheight tablewidth tablebordo cellpad cellspace tablesum \
		tabhup tabvup tabhut tabwid tabbord tabcol celpa celspa
	set tablesum [.table.suminhere get]
	if {$color ne ""} {
		set tablecolor $color
		set tabcol " bgcolor=\"$tablecolor\""
	} else {
		set tabcol ""
	}
	if {$tablesum ne ""} {
		set tablesum " summary=\"$tablesum\""
	}
	if {$table_hspace > 0} {
		set tabhup " hspace=\"$table_hspace\""
	} else {
		set tabhup ""
	}
	if {$table_vspace > 0} {
		set tabvup " vspace=\"$table_vspace\""
	} else {
		set tabvup ""
	}
	if {$tableheight > 0} {
		set tabhut " height=\"$tableheight\"" 
	} else {
		set tabhut ""
	}
	if {$tablewidth > 0} {
		set tabwid " width=\"$tablewidth\""
	} else {
		set tabwid ""
	}
	if {$tablebordo > 0} {
		set tabbord " border=\"$tablebordo\""
	} else {
		set tabbord ""
	}
	if {$cellpad > 0} {
		set celpa " cellpadding=\"$cellpad\""
	} else {
		set celpa ""
	}
	if {$cellspace > 0} {
		set celspa " cellspacing=\"$cellspace\""
	} else {
		set celspa ""
	}
}

# Procedure to insert HTML codes for beginning and end of table:

proc make_table {} {
	global tabcol table_hspace table_vspace horowin vertrowin rowcolor \
		tableheight tablewidth tablebordo cellpad cellspace tablesum \
		tabhup tabvup tabhut tabwid tabbord celpa celspa
	.tx insert insert \
		"<table$tablesum$tabcol$tabhup$tabvup\
			$tabhut$tabwid$tabbord$celpa$celspa>\n\n\n\n</table>"
	set lineno [expr int([.tx index insert])]
	.tx mark set insert [expr $lineno-2].0
	.tx insert insert "\t"
	.tx edit separator
	wmtitle
}

# Initialize variables for row attributes:

set horowalign left
set vertrowalign middle
set horowin ""
set vertrowin ""
set rowcolor ""
set rowon 0

# Initialize variables for cell attributes:

set horcellalign left
set vertcellalign middle
set horcellin ""
set vertcellin ""
set rowspannum 1
set colspannum 1
set rowcolor ""
set cellcolor ""

# Procedure to create HTML Table Data Entry box:
proc databox {} {
	global horowalign vertrowalign horcellalign \
		vertcellalign colspannum rowspannum textbox \
		color rowcolor cellcolor celltype colorcall fonto foco \
		lightlist buttlist spinlist texlist
	toplevel .data
	wm title .data "HTML Table Data Entry"
	
	grid [label .data.cellcont -text "C E L L   C O N T E N T S :" \
		-bg $::lightback -fg $::lightfore -pady 6] \
		-row 0 -column 0 -sticky news
	if {".data.cellcont" ni $lightlist} {
		
	}
	frame .data.but1
	button .data.line -text "New Line (F3)" -command {
		.data.cont insert insert "\n<br />"
		.data.cont edit separator
		.data.cont see insert
	}
	button .data.par -text "New Par (F6)"
	foreach {butt star fin} {<FocusIn> {\n<p>} {</p>}} {
		bind .data.par $butt "dualcodes $star {} $fin"
	}
	button .data.ital -text "Italic (F8)" -command {
		dualcodes <i> {} </i>
	}
	button .data.bold -text "Bold (F9)" -command {
		dualcodes <b> {} </b>
	}
	set insbutts [list .data.line .data.par .data.ital .data.bold]
	foreach butt $insbutts {
		$butt configure -pady 1 -padx 0 -borderwidth 1
		pack $butt -in .data.but1 -side left -expand 1 -fill both
		if {$butt ni $buttlist} {
			lappend buttlist $butt
		}
	}
	grid .data.but1 -row 1 -column 0 -sticky news
	
	frame .data.but2
	button .data.ins -text "Insert" -command {
		set openins Insert
		set foco .data.cont		
		openrece file
	}
	bind .data <Control-comma> {
		set openins Insert
		set foco .data.cont		
		openrece file
	}
	button .data.cut -text "Cut" -command {
		set foco .data.cont	
		cut_text
	}
	bind .data <Control-x> {
		set foco .data.cont	
		cut_text
	}
	button .data.copy -text "Copy" -command {
		set foco .data.cont	
		copy_text
	}
	bind .data <Control-c> {
		set foco .data.cont	
		copy_text
	}
	button .data.paste -text "Paste" -command {
		set foco .data.cont	
		paste_text
	}
	bind .data <Control-g> {
		set foco .data.cont	
		paste_text
	}
	bind .data <Control-X> {
		set foco .data.cont
		supercut
	}
	bind .data <Control-C> {
		set foco .data.cont
		supercopy
	}
	bind .data <F1> {openrece paste}
	button .data.undo -text "Undo" -command {
		catch {.data.cont edit undo}
	}
	button .data.redo -text "Redo" -command {
		catch {.data.cont edit redo}
	}
	button .data.special -text "Special" -command specialbox
	set databutts [list .data.ins .data.cut .data.copy .data.paste \
		.data.undo .data.redo .data.special]
	foreach butt $databutts {
		$butt configure -pady 1 -padx 0 -borderwidth 1 \
			-bg $::buttback -fg $::buttfore
		if {$butt ni $buttlist} {
			lappend buttlist $butt
		}
		pack $butt -in .data.but2 -side left -expand 1 -fill both	
	}
	grid .data.but2 -row 2 -column 0 -sticky news
	
	frame .data.tx
	text .data.cont	-bg $::textback -fg $::textfore -width 44 \
		-height 8 -font $fonto -wrap word -setgrid 1 -undo 1 \
		-inactiveselectbackground $::inacback
	if {".data.cont" ni $texlist} {
		lappend texlist .data.cont
	}
	ttk::scrollbar .data.roll -command ".data.cont	yview"
	.data.cont configure -yscrollcommand ".data.roll set"
	pack .data.cont	.data.roll -in .data.tx \
		-side left -expand 1 -fill both
	grid .data.tx -row 3 -column 0 -sticky news
	
	frame .data.frello
	ttk::menubutton .data.celltype -text "Cell type" -menu .data.celltype.menu
	menu .data.celltype.menu -tearoff 0
	foreach type [list Header Data] {
		.data.celltype.menu add command -label $type -command {
		set celltype $type
		}
	}	
	label .data.colspan -text "Column span:"
	spinbox .data.colspannum -width 3 -textvariable colspannum \
		-from 1 -to 100
	label .data.rowspan -text "Row span:"
	spinbox .data.rowspannum -width 3 -textvariable rowspannum \
		-from 1 -to 100
	foreach spin [list .data.colspannum .data.rowspannum] {
		$spin configure -bg $::textback -fg $::textfore \
		-buttonbackground $::buttback
	}
	pack .data.celltype .data.colspan .data.colspannum .data.rowspan \
		.data.rowspannum -in .data.frello -side left -expand 1 -fill x
	grid .data.frello -row 4 -column 0 -sticky news

	frame .data.fr1
	button .data.enter -text "Enter" -default normal \
		-relief solid -border 1 -command insert_cell
	button .data.newrow -text "Begin new row" -default normal \
		-command newrow
	button .data.done -text "Done" -default normal -command {
		if {$rowon == 1} {
			.tx insert insert "\t</tr>\n"
		}
		set rowon 0
		destroy .data
	}
	button .data.close -text "Close" -default normal -command {
		destroy .data
		focus .tx
		set foco .tx
	}
	foreach butt [list .data.enter .data.newrow .data.done .data.close] {
		$butt configure -bg $::buttback -fg $::buttfore
		if {$butt ni $buttlist} {
			lappend buttlist $butt
		}
		pack $butt -in .data.fr1 -side left -expand 1 -fill both
	}
	grid .data.fr1 -row 5 -column 0 -sticky news
	
	grid [label .data.optinfo -bg $::lightback -fg $::lightfore \
		-text "O P T I O N A L   I N F O R M A T I O N :" -pady 6] \
		-row 6 -column 0 -columnspan 6 -sticky news
	if {".data.optinfo" ni $lightlist} {
		lappend lightlist .data.optinfo
	}
	
	frame .data.frig
	frame .data.frign
	label .data.rowalign -text "Align in row:"
	label .data.cellalign -text "Align in cell:"
	pack .data.rowalign .data.cellalign -in .data.frign \
		-side top -expand 1 -fill both
	
	frame .data.friz
	ttk::menubutton .data.horow -text "Horizontal" -menu .data.horow.menu
	menu .data.horow.menu -tearoff 0
	foreach way [list left center right] {
		.data.horow.menu add command -label $way -command {
		set horowalign $way	
		}
	}
	ttk::menubutton .data.horcell -text "Horizontal" -menu .data.horcell.menu
	menu .data.horcell.menu -tearoff 0
	foreach way [list left center right] {
		.data.horcell.menu add command -label $way -command {
		set horcellalign $way	
		}
	}
	pack .data.horow .data.horcell -in .data.friz -side top -expand 1 -fill both
	
	frame .data.frert
	ttk::menubutton .data.vertrow -text "Vertical" -menu .data.vertrow.menu
	menu .data.vertrow.menu -tearoff 0
	foreach way [list top middle bottom baseline] {
		.data.vertrow.menu add command -label $way -command {
		set vertrowalign $way	
		}
	}
	ttk::menubutton .data.vertcell -text "Vertical" -menu .data.vertcell.menu
	menu .data.vertcell.menu -tearoff 0
	foreach way [list top middle bottom baseline] {
		.data.vertcell.menu add command -label $way -command {
		set vertcellalign $way	
		}
	}
	pack .data.vertrow .data.vertcell -in .data.frert \
		-side top -expand 1 -fill both
	pack .data.frign .data.friz .data.frert -in .data.frig \
		-side left -expand 1 -fill both
	grid .data.frig -row 7 -column 0 -sticky news
	
	frame .data.froth
	frame .data.frow
	button .data.rowcolorsel -text "Select row color" -command {
		set colorcall row
		wishcolor
	}
	button .data.rowcolordesel -text "Deselect row color" -command {
		set color ""
		set rowcolor ""
	}
	pack .data.rowcolorsel .data.rowcolordesel -in .data.frow \
		-side top -expand 1 -fill both
		
	frame .data.frell
	button .data.cellcolorsel -text "Select cell color" -command {
		set colorcall cell
		wishcolor
	}
	button .data.cellcolordesel -text "Deselect cell color" -command {
		set color ""
		set cellcolor ""
	}
	pack .data.cellcolorsel .data.cellcolordesel -in .data.frell \
		-side top -expand 1 -fill both
	pack .data.frow .data.frell -in .data.froth -side left -expand 1 -fill both
	grid .data.froth -row 8 -column 0 -sticky news
	foreach butt [list .data.rowcolorsel .data.rowcolordesel \
		.data.cellcolorsel .data.cellcolordesel] {
		$butt configure -bg $::buttback -fg $::buttfore -default normal
		if {$butt ni $buttlist} {
			lappend buttlist $butt
		}
	}
	
	bind .data <Key-Return> insert_cell
	bind .data <F3> {
		.data.cont insert insert "\n<br />"
		.data.cont edit separator
		.data.cont see insert
	}
	foreach {key star fin} {
		<F6> {\n<p>} {</p>} \
		<F8> <i> </i> \
		<F9> <b> </b> \
		<Control-F6> <center> </center>
	} {bind .data $key "dualcodes $star {} $fin"}
	bind .data <Control-r> { catch {.data.cont edit redo} }
	bind .data <space> {.data.cont edit separator}
	bind .data <BackSpace> {.data.cont edit separator}
	focus .data.cont	
	set foco .data.cont	
	bind .data <FocusIn> {set foco .data.cont}
}

# Procedure to get HTML codes for row attributes from user input
# ("left" and "middle" are defaults for
# horizontal and vertical alignment of contents):

proc get_rowcodes {} {
	global horowalign vertrowalign vertrowin horowin rowcolor
	if {$horowalign eq "left"} {
		set horowin ""
	} else {
		set horowin " align=\"$horowalign\""
	}
	if {$vertrowalign eq "middle"} {
		set vertowin ""
	} else {
		set vertrowin " valign=\"$vertrowalign\""
	}
	if {$rowcolor ne ""} {
		set rowcolor " bgcolor=\"$rowcolor\""
	}
}

# Procedure to get HTML codes for cell attributes from user input:

proc get_cellcodes {} {
	global colspannum rowspannum horcellalign vertcellalign \
		horcellin vertcellin cellcolor rowspa colspa
	if {$rowspannum > 1} {
		set rowspa " rowspan=\"$rowspannum\""
	} else {
		set rowspa ""
	}
	if {$colspannum > 1} {
		set colspa " colspan=\"$colspannum\""
	} else {
		set colspa ""
	}
	if {$horcellalign eq "left"} {
		set horcellin ""
	} else {
		set horcellin " align=\"$horcellalign\""
	}
	if {$vertcellalign == "middle"} {
		set vertcellin ""
	} else {
		set vertcellin " valign=\"$vertcellalign\""
	}
	if {$cellcolor ne ""} {
		set cellcolor " bgcolor=\"$cellcolor\""
	}
}

# Procedure to insert new data cell in existing row of HTML table:
proc insert_cell {} {
	global codestart codend colspannum rowspannum horowin vertrowin \
		horcellin vertcellin rowcolor cellcolor celltype rowon \
		colspa rowspa
	set cellcontents [string trimright [.data.cont get 1.0 end-1c]]
	if {$rowon == 0} {
		get_rowcodes
		get_cellcodes
		.tx insert insert "<tr$horowin$vertrowin$rowcolor>\n"
		set rowon 1
	} else {
		get_cellcodes
	}
	if {$celltype eq "Header"} {
		set star "\t\t<th$colspa$rowspa$horcellin$vertcellin$cellcolor>"
		set fin "</th>\n"
	} else {
		set star "\t\t<td$colspa$rowspa$horcellin$vertcellin$cellcolor>"
		set fin "</td>\n"
	}
	.tx insert insert $star$cellcontents$fin
	.tx edit modified
	wmtitle
	set lineno [line_number]
	set downfour [expr $lineno + 4]
	.tx see $downfour.0
	.data.cont delete 1.0 end
	focus .data.cont		
}

# Procedure to insert new row in HTML table with data contents:

proc newrow {} {
	global celltype horowin vertrowin rowcolor rowon
	if {$celltype eq "Header"} {set celltype Data}
	get_rowcodes
	if {$rowon == 1} {
		.tx insert insert \
			"\t</tr>\n\n\t<tr$horowin$vertrowin$rowcolor>\n"
	} else {
		.tx insert insert "\n\t<tr$horowin$vertrowin$rowcolor>\n"
	}
	if {$rowon == 0} {set rowon 1}
	set lineno [line_number]
	.tx see [expr $lineno+3].0
	.tx edit separator
	wmtitle
}

.filemenu.html add separator

# HTML -- Paragraph

.filemenu.html add command -label "Paragraph <p>" -underline 0 -command {
	dualcodes "<p>" {} </p>
	} -accelerator F6

bind . <F6> {dualcodes "<p>" {} "</p>"}

# HTML -- Line Break

.filemenu.html add command -label "Line Break <br>" -underline 0 -command {
	.tx insert insert "<br />"
	.tx edit separator
	.tx see insert
	wmtitle
	} -accelerator F3

bind . <F3> {
	.tx insert insert "<br />"
	.tx edit separator
	.tx see insert
	wmtitle
}

# HTML -- Emphasis

.filemenu.html add command -label "Italics <i>" -underline 0 -command {
	dualcodes <i> {} </i>
	} -accelerator F8

bind . <F8> {dualcodes <i> {} </i>}

# HTML -- Strong

.filemenu.html add command -label "Bold <b>" -underline 0 -command {
	dualcodes <b> {} </b>
	} -accelerator F9

bind . <F9> {dualcodes <b> {} </b>}

# HTML -- Center

.filemenu.html add command -label "Center <center>" -underline 5 -command {
	dualcodes <center> {} </center>
	} -accelerator Ctrl+F6

bind . <Control-F6> {dualcodes <center> {} </center>}


### TCL/TK MENU ###

menu .filemenu.tcl -tearoff 0
.filemenu add cascade -label "Tcl/Tk" -underline 0 -menu .filemenu.tcl

# Tcl/Tk -- New Script

.filemenu.tcl add command -label "New Script" -underline 0 \
	-command new_wish -accelerator Ctrl+F5
	
bind . <Control-F5> new_wish

proc new_wish {} {
	set go [readytogo]
	if {$go == 0} {return}
	outwithold
	.tx insert 1.0 "#!/usr/bin/env wish\n\n# "
	.tx edit separator
	wmtitle
}

# Tcl/Tk -- Run Selected Code

.filemenu.tcl add command -label "Run Selected Code" -underline 0 \
	-command runcode -accelerator F5

bind . <F5> runcode
	
proc runcode {} {
	if {[interp exists testrunner]} {interp delete testrunner}
	set anysel [catch {.tx get sel.first sel.last} codetorun]
	if {$anysel == 0} {
		interp create testrunner
		load {} Tk testrunner
		testrunner eval $codetorun
	} else {
		tk_messageBox -message "Please select some code to run" \
			-title "Select Code" -type ok
	}
}

.filemenu.tcl add separator

# Tcl/Tk -- Find Closing

.filemenu.tcl add command -label "Find Closing" -underline 0 \
	-command findclose -accelerator Ctrl+Alt+\[
	
bind . <Control-Alt-bracketleft> findclose
	
proc findclose {} {
	global lev ope clo whence whither here
	
	# Find what to search for and where to search from:
	if {[catch {set ope [.tx get sel.first sel.last]}]} {
		set ope ""
	}
	set whence [.tx index sel.last]
	set whither ""
	set lev 1 ; # Opening found, closing not yet found
	switch $ope {
		"\{" {
			set clo "\}"
		}
		"\[" {
			set clo "\]"
		}
		"\(" {
			set clo "\)"
		}
		"\"" {
			set clo $ope
		}
		default {
			tk_messageBox -message "Please select an opening\
				brace ( \{ ), bracket ( \[ ), parenthesis ( \( ),\
				or quote ( \" )" -type ok
			return
		}
	}
	set here $whence
	findmatch
	if {$lev == 0 && $whither ne ""} {
		.tx tag add sel $whence $whither
	} else {
		tk_messageBox -message "Closing not found" -type ok
	}
}

proc findmatch {} {
	global lev ope clo whence whither here
	if {$clo eq $ope} {
		set whereat [.tx search $clo $whence end]
	} else {
		set up [.tx search $ope $here end]
		set down [.tx search $clo $here end]
		if {$up eq ""} {
			set whichendup down
			set whereat $down
		}
		if {$down eq ""} {
			set whereat ""
		}
		if {$up ne "" && $down ne ""} {
			if {[.tx compare $up > $down]} {
				set whichendup down
				set whereat $down
			} else {
				set whichendup up
				set whereat $up
			}
		}
	}
	if {$whereat ne ""} {
		set whatbefore [.tx get "$whereat -1c"]
		if {$whatbefore eq "\\"} {
			set here [.tx index "$whereat +1c"]
			findmatch
		} else {
			if {$clo eq $ope} {
				set whither [.tx index "$whereat +1c"]
				set lev 0
				return
			} else {
				set here [.tx index "$whereat +1c"]
				if {$whichendup eq "up"} {
					incr lev
				} else {
					incr lev -1
				}
			}
		}
	}
	if {$lev == 0} {
		set whither $here
		return
	} elseif {$whereat ne ""} {
		findmatch
	}
}

### Tcl/Tk -- Auto-tab

.filemenu.tcl add checkbutton -variable autotab -label "Auto-tab"\
	-underline 5 -command autotaborno
	
proc autotaborno {} {
	global autotab
	if {$autotab == 1} {
		bind . <Key-Return> {autotab go ; .tx edit separator}
		bind . <Shift-Return> {autotab stop}
	} else {
		bind . <Key-Return> {.tx edit separator}
		bind . <Shift-Return> {}
	}
}

autotaborno
	
# Procedure to find out how many tabs at beginning of line:

proc tabgrab {} {
	global charno tabno bogno
	if {[.tx get $bogno.$charno] eq "\t"} {
		incr tabno
		incr charno
		tabgrab
	}
}
	
# Procedure to auto-tab:

proc autotab {stoporgo} {
	global tabno charno bogno
	set bogno [expr [line_number] -1]
	set charno 0
	set tabno 0
	tabgrab
	set herenow [.tx index insert]
	set gripchar [.tx get "$herenow -2c" $herenow]
	set gripchar [string trim $gripchar]
	if {$gripchar eq "\{"} {
		incr tabno
	}
	if {$stoporgo eq "stop"} {
		if {$tabno > 0} {
			incr tabno -1
		}
	}
	set tabstring [string repeat "\t" $tabno]
	.tx insert insert $tabstring
	.tx edit separator
	if {$stoporgo eq "stop"} {
		.tx mark set insert "insert +1c"
	}
}

### Tcl/Tk -- More/Fewer Tabs

.filemenu.tcl add command -label "More Tabs" -underline 0 \
	-command tabup -accelerator Ctrl+Shift++(plus)

proc tabup {} {
	set catchup [catch {set firstab [.tx index sel.first]} outage]
	if {$catchup} {
		tk_messageBox -message "$outage. Please select some Tcl/Tk code" -type ok
		return
	}
	set firstab [expr int([.tx index sel.first])]
	set lastab [expr int([.tx index sel.last])]
	foreach lin [range $firstab to $lastab] {
		.tx insert $lin.0 "\t"
	}
}

bind .tx <Control-Shift-plus> tabup

.filemenu.tcl add command -label "Fewer Tabs" -underline 1 \
	-command tabdown -accelerator Ctrl+-(minus)

proc tabdown {} {
	set catchup [catch {set firstab [.tx index sel.first]} outage]
	if {$catchup} {
		tk_messageBox -message "$outage. Please select some Tcl/Tk code" -type ok
		return
	}
	set firstab [expr int([.tx index sel.first])]
	set lastab [expr int([.tx index sel.last])]
	foreach lin [range $firstab to $lastab] {
		if {[.tx get $lin.0] eq "\t"} {
			.tx delete $lin.0
		} else {
			break
		}
	}
}

bind .tx <Control-minus> tabdown

.filemenu.tcl add separator

# Tcl/Tk -- Matching Braces { }

.filemenu.tcl add command -label "Curly Braces \{ \}" -underline 0 -command {
	dualcodes "{" {} "}"
} -accelerator Ctrl+\{

bind . <Control-braceleft> {dualcodes "{" {} "}"}

bind . <Shift-Home> {
	.tx mark set insert "[.tx index insert] lineend"
	.tx insert insert " "
	.tx insert insert "\{\}"
	.tx mark set insert "insert -1c"
	selection clear
}

.filemenu.tcl add command -label "Next Braces" -underline 2 -command {
	.tx mark set insert "[.tx index insert] lineend"
	.tx insert insert " "
	.tx insert insert "\{\}"
	.tx mark set insert "insert -1c"
	selection clear
} -accelerator Shift+Home

.filemenu.tcl add command -label "Leave Braces" -underline 0 -command {
	autotab stop
} -accelerator Shift+Enter

.filemenu.tcl add separator

# Tcl/Tk -- Matching Brackets [ ]

.filemenu.tcl add command -label "Square Brackets \[ \]" \
	-underline 0 -command {
		dualcodes {[} {} {]}
	} -accelerator Ctrl+\[

bind . <Control-bracketleft> {dualcodes {[} {} {]}}

# Tcl/Tk -- Matching Angle Brackets < >

.filemenu.tcl add command -label "Angle Brackets < >" \
	-underline 0 -command {
		dualcodes {<} {} {>}
	} -accelerator Ctrl+<

bind . <Control-less> {dualcodes {<} {} {>}}

# Tcl/Tk -- Matching Parentheses ( )

.filemenu.tcl add command -label "Parentheses ( )" \
	-underline 0 -command {
		dualcodes {(} {} {)}
	} -accelerator Ctrl+(

bind . <Control-parenleft> {dualcodes {(} {} {)}}

# Tcl/Tk -- Matching Quotes " "

.filemenu.tcl add command -label "Quotes \" \"" \
	-underline 0 -command {
		dualcodes {"} {} {"}
	} -accelerator Ctrl+\"

bind . <Control-quotedbl> {dualcodes {"} {} {"}}


### DISPLAY MENU ###

menu .filemenu.display -tearoff 0
.filemenu add cascade -label "Display" -underline 0 -menu .filemenu.display

### Display -- Format/Window size

.filemenu.display add command -label "Format/Window Size" -underline 1 \
	-command formato
	
# Procedures to format text with newlines:

proc formato {} {
	global texwid texhi oldwid oldhi formawid spinlist buttlist 
	set oldwid $texwid ; set oldhi $texhi
	clearout
	if {[winfo exists .forma]} {
		grid .forma
	} else {
		frame .forma
		label .forma.hi -text "Height: "
		spinbox .forma.disphi -from 1 -to 100 -textvariable texhi -width 3
		label .forma.wid -text "Window width: "
		spinbox .forma.dispwid -from 20 -to 200 -textvariable texwid \
			-buttonbackground $::buttback -width 3
		label .forma.form -text "Format to width: "
		spinbox .forma.formawid -from 20 -to 200 -textvariable formawid \
			-buttonbackground $::buttback -width 3
		lappend spinlist .forma.disphi .forma.dispwid .forma.formawid
		button .forma.chug -text "Resize window" -command {
			.tx configure -height $texhi -width $texwid
			wm geometry . {}
			savefig
		}
		button .forma.ok -text "Format" -command {formatit show}
		button .forma.close -text "Close" -command {clearin .forma}
		lappend buttlist .forma.chug .forma.ok .forma.close
		pack .forma.hi .forma.disphi .forma.wid .forma.dispwid \
			.forma.form .forma.formawid .forma.chug .forma.ok .forma.close \
			 -in .forma -side left -expand 1 -fill x
		grid .forma -row 1 -column 0 -columnspan 2 -sticky news
	}
	foreach spin [list .forma.disphi .forma.dispwid .forma.formawid] {
		$spin configure -bg $::textback -fg $::textfore \
			-buttonbackground $::buttback
	}
	foreach butt [list .forma.chug .forma.ok .forma.close] {
		$butt configure -bg $::buttback -fg $::buttfore \
			-pady 1 -default normal
	}
}

proc formatit {whattodo} {
	global formawid texwid wordwrap printorshow
	clearin .forma
	if {[winfo exists .tinga] == 0} {
		grid [label .tinga -text "Formatting ... may take a while for\
			long text .... Please wait"] \
			-row 1 -column 0 -columnspan 2 -sticky news
	}
	if {$whattodo eq "print"} {
		set printout [formanew print]
		destroy .tinga
		return $printout
	} else {
		.tx configure -width $formawid -wrap word
		wm geometry . {}
		after 100 {
			formanew show
			destroy .tinga
			.tx configure -width $texwid -wrap $wordwrap
			wm geometry . {}
		}
	}	
}

proc formanew {whattodo} {
	global formawid
	
	# Identify beginning and end of text to format, and
	# omit needless newlines:
	omitneedless plus
	if {[.tx tag ranges sel] eq ""} {
		set selon 1.0
		set seloff [.tx index end]
	} else {
		set selon [.tx index sel.first]
		set seloff [.tx index sel.last]
	}
	set texin [expr int($selon)]
	set texend [expr int($seloff)]
			
	# Initialize variable to hold output:
	set formatext ""
	
	# Dig in and format text:
	for {set i $texin} {$i <= $texend} {incr i} {
		# Get text to newline:
		set endolin [.tx index $i.end]
		set endochar [lindex [split $endolin "."] end]
		set whatline [.tx get $i.0 $endolin]
		# If line is blank, insert only newline into output:
		if {[string trim $whatline] eq ""} {
			append formatext "\n"
			continue
		}
		# If not, then find out where line is wrapped:
		for {set c 1} {$c <= $endochar} {incr c} {
			.tx see $i.$c
			set ceemin [expr {$c-1}]
			set boxie [.tx get $i.$ceemin]
			# Get y coordinates of bounding boxes for adjoining characters:
			set pixy [lindex [.tx bbox $i.$ceemin] 1]
			set nexy [lindex [.tx bbox $i.$c] 1]
			# If y coordinate of bounding box is greater than for
			# preceding character, line has been wrapped, so
			# insert preceding character plus newline into output:
			if {$nexy > $pixy} {
				append formatext $boxie\n
				.tx see $i.$c
			} else {
				# Otherwise, insert only the preceding character:
				append formatext $boxie
			}
		}
		# Replicate existing newline from text widget:
		if {$i < $texend} {
			append formatext "\n"
		}
	}
	if {$whattodo eq "print"} {
		return $formatext
	} else {
		.tx delete $selon $seloff
		.tx insert $selon $formatext
		.tx edit separator
		after 100 wmtitle
	}
}

.filemenu.display add command -label "Omit Needless Newlines" -underline 5 \
	-command newlino

### Procedures to omit needless newlines:

proc newlino {} {
	global reunito parsep checklist buttlist
	clearout
	if {[winfo exists .need]} {
		grid .need
	} else {
		frame .need
		radiobutton .need.unite -text "Reunite broken words" \
			-variable reunito -value 1
		radiobutton .need.replace -text "No broken words" \
			-variable reunito -value 0
		checkbutton .need.par -text "Keep paragraphs separate" \
			-variable parsep
		lappend checklist .need.unite .need.replace .need.par
		button .need.ok -text "Eject needless newlines" -command {
			omitneedless only
			clearin .need
		}
		button .need.close -text "Close" -pady 1 -border 1 \
			-command {
			clearin .need
		}
		lappend buttlist .need.ok .need.close
		pack .need.unite .need.replace .need.par .need.ok \
			.need.close -in .need -side left -expand 1 -fill both
		grid .need -row 1 -column 0 -columnspan 2 -sticky news
	}
	foreach check [list .need.unite .need.replace .need.par] {
		$check configure -selectcolor $::textback -takefocus 0
	}
	foreach butt [list .need.ok .need.close] {
		$butt configure -bg $::buttback -fg $::buttfore \
			-pady 1 -default normal
	}
	focus .need
}

proc omitneedless {andwhat} {
	global reunito parsep
	if {[.tx tag ranges sel] eq ""} {
		set selon 1.0
		set seloff [.tx index end]
		set selmore 0
	} else {
		set selon [.tx index sel.first]
		set seloff [.tx index sel.last]
		set selmore 1
	}
	set texin [expr int($selon)]
	set texend [expr int($seloff)]
	set texauld [.tx get $selon $seloff]
	switch "$reunito $parsep" {
		"1 1" {
			set texnoo [string map "{\n\n} {\n\n} {\n\t} {\n\t} {\n} {}"\
				$texauld]
		}
		"1 0" {
			set texnoo [string map "{\n} {}" $texauld]
		}
		"0 1" {
			set texnoo [string map "{\n\n} {\n\n} {\n\t} {\n\t}\
				{ \n} { } {\n} { }" $texauld]
		}
		"0 0" {
			set texnoo [string map "{ \n} { } {\n} { }" $texauld]
		}
	}
	.tx delete $selon $seloff
	.tx insert $selon $texnoo
	if {$selmore == 1 && $andwhat eq "plus"} {
		.tx tag add sel $selon [.tx index insert]
	}
	.tx edit separator
	after 100 wmtitle
}

.filemenu.display add separator

### Display -- HTML in Browser

.filemenu.display add command -label "HTML in Browser" -underline 0 \
	-command {browsier $currentfile}
	
proc browsier {fil} {
	global env currentfile browser
	if {$fil eq ""} {
		tk_messageBox -message "Please save HTML file before trying\
			to display it in a browser" -type ok
		return
	}
	if {$browser eq ""} {
		browbox
	} else {
		set badbrow [catch {eval exec $browser $currentfile &} outage]
		if {$badbrow} {
			tk_messageBox -message $outage -type ok
		}
	}
}

### Display -- Change Browser

.filemenu.display add command -label "Change Browser" -underline 7 \
	-command browbox

proc browbox {} {
	global browser
	clearout
	if {[winfo exists .brow]} {
		grid .brow
		.brow.ent delete 0 end
		if {[info exists browser]} {
			.brow.ent insert 0 $browser
			.brow.ent selection range 0 end
		}
		focus .brow.ent
	} else {
		frame .brow
		label .brow.blab -text "Please designate a browser: "
		lappend headlist .brow.blab
		entry .brow.ent -bg $::textback -fg $::textfore
		lappend entlist .brow.ent
		if {[info exists browser]} {
			.brow.ent insert 0 $browser
			.brow.ent selection range 0 end
		}
		bind .brow.ent <Key-Return> {
			set browget [.brow.ent get]
			if {$browget ne ""} {
				set browser $browget
			} else {
				tk_messageBox -message "Please designate a browser" -type ok
			}
			clearin .brow
		}
		button .brow.ok -text "OK" -relief solid -command {
			set browget [.brow.ent get]
			if {$browget ne ""} {
				set browser $browget
			} else {
				tk_messageBox -message "Please designate a browser" -type ok
			}
			clearin .brow
		}
		button .brow.close -text "Close" -command {clearin .brow}
		lappend buttlist .brow.ok .brow.close
		pack .brow.blab .brow.ent .brow.ok .brow.close -in .brow \
			-side left -expand 1 -fill x
		grid .brow -row 1 -column 0 -columnspan 2 -sticky news
		# bind .brow <Key-Return> 
		focus .brow.ent
	}
	.brow.ent configure -bg $::textback -fg $::textfore
	foreach butt [list .brow.ok .brow.close] {
		$butt configure -bg $::buttback -fg $::buttfore \
		-default normal -pady 1
	}
}

.filemenu.display add separator

### Display -- Colors

.filemenu.display add command -label "Colors" -underline 0 -command colodisp

# Procedure to set up GUI box for configuring color display:

proc colodisp {} {
	global env color red green blue whatfig whatbutt colorlist \
		winback winfore selback selfore buttback buttfore textback \
		textfore headback headfore lightback lightfore coloron wishdir libdir \
		current_scheme colordir bogomips
	if {$coloron == 0} {
		source [file join $libdir wishcolorplus.tcl]
		set coloron 1
	}
	wishcolorplus ; # This does all the work--from WISH Color Picker Plus
	wm title .colo "WISH Supernotepad : WISH Color Picker Plus"
}

### Display -- Font

.filemenu.display add command -label "Font" -underline 0 -command fontshow

# List available fonts:
set fontlist [lsort -dictionary [font families]]

# Procedure to make font selection box:

proc fontshow {} {
	global fontlist fontgrip fonto siz fontaine \
		lublist lightlist spinlist buttlist
	toplevel .fontshow
	wm title .fontshow "WISH Supernotepad: Choose Font"
	set fontgrip $fonto
	grid [listbox .fontshow.list -bg $::textback -fg $::textfore -height 12 \
		-width 52 -selectmode single -listvariable fontlist] \
		-row 0 -column 0 -sticky news
	if {".fontshow.list" ni $lublist} {
		lappend lublist .fontshow.list
	}
	grid [ttk::scrollbar .fontshow.roll -command ".fontshow.list yview"] \
		-row 0 -column 1 -rowspan 2 -sticky news
	.fontshow.list configure -yscrollcommand ".fontshow.roll set"
	bind .fontshow.list <Button-1> {
		after 10 {
			set fontgrip [.fontshow.list get [.fontshow.list curselection]]
			set fontaine [list $fontgrip $siz]
			.fontshow.lab configure -text "$fontgrip" -font "$fontaine"
		}
	}
	bind .fontshow.list <Double-Button-1> fontok
	bind .fontshow.list <Button-3> {
		set clixel %y
		set clickline [.fontshow.list nearest $clixel]
		.fontshow.list selection set $clickline
		set fontgrip [.fontshow.list get [.fontshow.list curselection]]
		set fontaine [list $fontgrip $siz]
		.fontshow.lab configure -text "$fontgrip" -font "$fontaine"
		fontok
	}
	frame .fontshow.butts
	label .fontshow.lab -text "$fonto" -font "$fontaine"
	if {".fontshow.lab" ni $lightlist} {
		lappend lightlist .fontshow.lab
	}
	spinbox .fontshow.spin -textvariable siz -width 2 -from 8 -to 48 \
		-buttonbackground $::buttback -bg $::textback -fg $::textfore -command {
		set fontaine [list $fontgrip $siz]
		.fontshow.lab configure -font "$fontaine"
	}
	if {".fontshow.spin" ni $spinlist} {
		lappend spinlist .fontshow.spin
	}
	button .fontshow.ok -text "OK" -default normal \
		-relief solid -border 1 -pady 1 -command fontok
	button .fontshow.close -text "Close" -default normal -pady 1 \
		-command {destroy .fontshow}
	foreach butt [list .fontshow.ok .fontshow.close] {
		$butt configure -bg $::buttback -fg $::buttfore
		if {$butt ni $buttlist} {
			lappend buttlist $butt
		}
	}
	pack .fontshow.lab .fontshow.spin .fontshow.ok .fontshow.close \
		-in .fontshow.butts -side left -expand 1 -fill x
	grid .fontshow.butts -row 1 -column 0 -sticky news
	bind .fontshow <Key-Return> fontok
	focus .fontshow.spin
}

# Procedure to apply and save new default font:

proc fontok {} {
	global t fontgrip fonto siz fontaine linkup
	set fonto $fontgrip
	set fontaine [list $fonto $siz]
	.tx configure -font "$fontaine"
	$t tag configure bold -font "[list $::fonto $::siz bold]"
	$t tag configure ital -font "[list $::fonto $::siz italic]"
	$t tag configure bi -font "[list $::fonto $::siz bold italic]"
	$t tag configure cent -justify center
	$t tag configure boldcent -font "[list $::fonto $::siz bold]" \
		-justify center
	$t tag configure italcent -font "[list $::fonto $::siz italic]" \
		-justify center
	$t tag configure bicent -font "[list $::fonto $::siz bold italic]" \
		-justify center
	savefig
	destroy .fontshow
}

.filemenu.display add separator

### Display -- Link-Text

.filemenu.display add checkbutton -label "Link-Text" -underline 0 \
	-variable lincoln -accelerator Ctrl+Alt+l -command linkuporno
	
bind .tx <Control-Alt-l> {
	if {$lincoln} {
		set lincoln 0
		unlink .tx
	} else {
		set lincoln 1
		linktext .tx
	}
}

# Procedure to put Link-Text tags in or take them out:

proc linkuporno {} {
	global lincoln
	if {$lincoln} {
		linktext .tx
	} else {
		unlink .tx
	}
}

# Procedure to make clickable links, hide markup tags,
# and show text as bold, italic, and/or centered:

proc linktext {t} {
	global linklist linkex linkhead
	
	# Configure tag to hide things:
	$t tag configure hide -elide 1
	
	# Find end of opening "link section" of file,
	# beginnings and ends of all links, and
	# beginnings of bold, italic, and/or center tags:
	set linkhead [$t search "<end linkhead>" 1.0 end]
	if {$linkhead ne ""} {
		$t tag add hide $linkhead "$linkhead +14c"
	}
	
	# First find angle quotes ( ) used to disguise angle brackets
	# that are *not* to be interpreted as designating tags,
	# and whip up a quick disguise:
	set angstars [$t search -all "<" 1.0 end]
	set angends [$t search -all ">" 1.0 end]
	$t tag configure ang -elide 1
	foreach star $angstars {
		$t tag add hide $star
		$t tag add ang "$star +1c"
	}
	foreach end $angends {
		$t tag add ang $end
		$t tag add hide "$end +1c"
	}
	
	# Find link beginnings and ends:
	set linkstars [$t search -regexp -all \
		-count clink "<link .+?>" 1.0 end]
	set linkends [$t search -all "</link>" 1.0 end]
	
	# Find tag beginnings and ends:
	set tagstars [$t search -regexp -all -count ctag {
		<bi?c?>|<bc?i?>|<ib?c?>|<ic?b?>|<cb?i?>|<ci?b?>|<center>
	} 1.0 end]
	
	# Now reveal the non-tag-designating angle brackets:
	$t tag configure ang -elide 0
	
	# Embolden, italicize, and/or center:
	$t tag configure bold -font "[list $::fonto $::siz bold]"
	$t tag configure ital -font "[list $::fonto $::siz italic]"
	$t tag configure bi -font "[list $::fonto $::siz bold italic]"
	$t tag configure cent -justify center
	$t tag configure boldcent -font "[list $::fonto $::siz bold]" \
		-justify center
	$t tag configure italcent -font "[list $::fonto $::siz italic]" \
		-justify center
	$t tag configure bicent -font "[list $::fonto $::siz bold italic]" \
		-justify center
	for {set b 0} {$b < [llength $tagstars]} {incr b} {
		set bar [lindex $tagstars $b] ; # Begin starting tag
		set barsplit [split $bar "."]
		set barline [lindex $barsplit 0] ; # Line number in text
		set barchar [lindex $barsplit end] ; # Position in line
		set tagoff [$t search ">" $bar end]
		$t tag add hide $bar "$tagoff +1c"
		set whattag [$t get "$bar +1c" $tagoff]
		switch $whattag {
			b {
				set tagend [$t search "</b>" $tagoff end]
				$t tag add hide $tagend "$tagend +4c"
				$t tag add bold $tagoff $tagend
			}
			i {
				set tagend [$t search "</i>" $tagoff end]
				$t tag add hide $tagend "$tagend +4c"
				$t tag add ital $tagoff $tagend
			}
			c {
				set tagend [$t search "</c>" $tagoff end]
				$t tag add hide $tagend "$tagend +4c"
				$t tag add cent $tagoff $tagend
			}
			center {
				set tagend [$t search "</center>" $tagoff end]
				$t tag add hide $tagend "$tagend +9c"
				$t tag add cent $tagoff $tagend
			}
			bi -
			ib {
				set tagend [$t search -regexp {</bi>|</ib>} $tagoff end]
				$t tag add hide $tagend "$tagend +5c"
				$t tag add bi $tagoff $tagend
			}
			bc -
			cb {
				set tagend [$t search -regexp {</bc>|</cb>} $tagoff end]
				$t tag add hide $tagend "$tagend +5c"
				$t tag add boldcent $tagoff $tagend
			}
			ic -
			ci {
				set tagend [$t search -regexp {</ic>|</ci>} $tagoff end]
				$t tag add hide $tagend "$tagend +5c"
				$t tag add italcent $tagoff $tagend
			}
			bic -
			ibc -
			bci -
			cbi -
			icb -
			cib {
				set tagend [$t search -regexp {
					</bic>|</ibc>|</bci>|</cbi>|</icb>|</cib>
				} $tagoff end]
				$t tag add hide $tagend "$tagend +6c"
				$t tag add bicent $tagoff $tagend
			}
		}
	}
	
	# Fix the links up to work:
	$t configure -cursor top_left_arrow
	for {set i 0} {$i < [llength $linkstars]} {incr i} {
		set star [lindex $linkstars $i] ; # Begin link-start tag
		set starleng [lindex $clink $i] ; # Length of link-start tag
		set starsplit [split $star "."]
		set starline [lindex $starsplit 0] ; # Line number in text
		set starchar [lindex $starsplit end] ; # Position in line
		
		# End of link-start tag:
		set starend $starline.[expr {$starchar + $starleng}]
		# Content of link-start tag:
		set linkstar [$t get $star $starend]
		set linkname [string trim $linkstar "<>"] ; # Link name
		
		$t tag add hide $star $starend
		
		# Add tag for clickable link between link-start and link-end tags:
		set finis [lindex $linkends $i]
		$t tag add $linkname $starend $finis
		lappend linklist "$linkname"
		# And one to hide the link-end tag:
		$t tag add hide $finis "$finis +7c"
		
		# Get clickable tag to look right and do things:
		$t tag configure $linkname -foreground blue -underline 1
		$t tag bind $linkname <ButtonRelease-1> "linkfind $t"
	}
}

# Procedure to search for link name in text:

proc linkfind {t} {
	global linkhead
	
	# See where clicked link is:
	set clickpos [$t index insert]
	
	# Verify that it's really a link:
	set tagnames [$t tag names $clickpos]
	set tagplace [lsearch $tagnames "link *"]
	
	if {$tagplace > -1} {
		# If so, strip off everything but its name:
		set tagname [lindex $tagnames $tagplace]
		set searchname [string map "{link } {} {\"} {}" $tagname]
		
		# And find where the name appears in the text:
		if {$linkhead ne ""} {
			set target [$t search "$searchname" $linkhead end]
		} else {
			set tagend [lindex [$t tag range "$tagname"] end]
			set target [$t search "$searchname" $tagend end]
			if {$target eq ""} {
				set target [$t search -backwards "$searchname" $tagend end]
			}
		}
		if {$target ne ""} {
			$t see $target
		} else {
			tk_messageBox -message "Link \"$searchname\" not found" -type ok
		}
	}
}

# Procedure to undo Link-Text display:

proc unlink {t} {
	global linklist
	$t tag delete bold ital bi cent boldcent italcent bicent hide ang
	foreach link $linklist {
		$t tag delete "$link"
	}
	$t configure -cursor xterm
}

.filemenu.display add separator

### Display -- Word Wrap

.filemenu.display add checkbutton -variable wordwrap -label "Word wrap" \
	-onvalue word -offvalue none -underline 0 -command wraponoroff

proc wraponoroff {} {
	global wordwrap
	if {$wordwrap eq "none"} {
		.tx configure -wrap none
	} else {
		.tx configure -wrap word
	}
}


### HELP MENU ###

menu .filemenu.help -tearoff 0
.filemenu add cascade -label "Help" -underline 0 -menu .filemenu.help

set helpfile [file join $docdir superhelp_link.txt] ; # User Help Guide
set licfile [file join $docdir mule_license.txt] ; # License

### Help -- About WISH Supernotepad

.filemenu.help add command -label "About WISH Supernotepad" \
	-underline 0 -command {
		tk_messageBox -message "WISH Supernotepad $version\n\
			by David McClamrock\n <mcclamrock@locl.net>\n\n\
			Based on Tk NotePad 0.5.0\n by Joseph Acosta\n\
			and \"textedit.tcl\"\n by Eric Foster-Johnson\n"\
			-title "About WISH Supernotepad" -type ok
	}

.filemenu.help add separator

### Help -- User Help

.filemenu.help add command -label "User Help" -underline 0 -command superhelp

### USER HELP ###

# Use WISH User Help for user help guide:

# Procedure for setting up user help display:

proc superhelp {} {
	global helpon helpfile libdir
	if {$helpon == 0} {
		source [file join $libdir wishuhelp.tcl]
		set helpon 1
	}
	uhelp ; # Set up user help window--from WISH User Help
	wm title .uhelp "WISH Supernotepad - User Help"
	set linkup [open $helpfile r]
	set helpcontents [read $linkup]
	close $linkup
	.uhelp.tx insert 1.0 $helpcontents
	helplink .uhelp.tx; # Show links in text--from WISH User Help
	.uhelp.tx mark set insert 1.0
	.uhelp.tx configure -state disabled
}


### GET GOING ###

# At last, make the menu visible:

. configure -menu .filemenu

# Load most recently used color scheme, if specified in configuration
# file; if not, load "AntiqueBisque" color scheme as default;
# if not that either, complain:

if {[info exists current_scheme]} {
	source [file join $colordir $current_scheme.tcl]
} elseif {[file readable [file join $colordir AntiqueBisque.tcl]]} {
	source [file join $colordir AntiqueBisque.tcl]
} else {
	tk_messageBox -message "Current color scheme file not found\
	in $colordir" -type ok
}

.tx tag configure crit -background $selback -foreground $selfore

# Open file from the command line, if you wish:

if {[info exists argv]} {
	if {[file readable [lindex $argv 0]]} {
		set newfile [lindex $argv 0]
		inwithnew
		.tx mark set insert 1.0
		set currentfile $newfile
		after 100 saverece
		.tx edit separator
		wmtitle
	}
}

