#!/usr/bin/env wish

# WISH Superscriptorium 2009
# (the second public release of WISH Superscriptorium)
# Computer-aided Latin-English translation program
# by David McClamrock <mcclamrock@locl.net>
# Based on "Glossator"
# Tcl/Tk 8.2 script written by Mike Polis and placed in the public domain
# Ad Majorem Dei Gloriam
# Based in turn on "Words" by William Whittaker

# Copyright  2008 David H. McClamrock
# (not including portions contributed by Mike Polis and William Whittaker)
# 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.


### FIXES NEEDED ###

# Tulit isn't there (fero ferre tuli latus)--I see no perfects for this!

# I don't think it picks up every variant of hic, haec, hoc, etc.


### 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" -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 scriphelp_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
# (Replace old "~/wishes," if any, with new "~/.wishes")

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]
if {[file exists $colordir] == 0} {
	set nocolors [catch {file copy [file join $libdir colorschemes] $wishdir} outage]
	if {$nocolors} {
		tk_messageBox -message $outage -type ok
	}
}

# 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
}

# Initial settings, some of which may be changed by configuration file:

set coloron 0 ; # WISH Color Picker Plus not yet loaded
set helpon 0 ; # WISH User Help not yet loaded either
set current_scheme AntiqueBisque ; # Default color scheme
set latinfile Input
set englishfile Untitled
set dumpfile "" ; # Don't trash old name of file that hasn't yet been renamed
set reclim 1000 ; # Show names of up to 1000 recently used files
set loading_words ""
set latinlist [list] ; # List of recently opened Latin files
set englist [list] ; # List of recently opened English files
set latinback "" ; # Latin backup file
set engback "" ; # English backup file
set tx .lat ; # Initial focus on text widget for Latin original

# Get configuration:
set scripfig [file join $wishdir scripfig.tcl]
if {[file readable $scripfig]} {
	source $scripfig
}

# Get lists of recently opened or inserted files:

set rece [file join $wishdir scriprece.tcl]
set gotrece 0

proc getrecent {} {
	global wishdir rece gotrece recentlist
	if {[file readable $rece]} {
		source $rece
		set gotrece 1
	} else {
		set recentlist [list]
		set reclim 1000
	}
}

if {$gotrece} {
	getrecent
}

# Procedure to save configuration:

proc savefig {} {
	set figlines "# WISH Superscriptorium configuration file (scripfig.tcl)\
	\n\nset current_scheme $::current_scheme"
	set filid [open $::scripfig w]
	puts -nonewline $filid $figlines
	close $filid
}

# Initialize lists of widgets for color display
# (not all may be used by all programs):

set buttlist [list] ; # Buttons
set texlist [list] ; # Text widgets
set entlist [list] ; # Entry widgets
set lublist [list] ; # Listboxes
set spinlist [list] ; # Spinboxes
set winlist [list] ; # Widgets to get window background color when disabled
set headlist [list] ; # Emphasized labels
set lightlist [list] ; # Light labels
set checklist [list] ; # Checkbuttons and radiobuttons

# 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 ###

# Initial splasher:

proc splashup {} {
	global libdir
	wm title . "WISH Superscriptorium"
	canvas .can -height 276 -width 126
	set wishimg [file join $libdir superscrip.gif]
	image create photo superscrip -file $wishimg
	.can create image 1 1 -anchor nw -image superscrip
	grid .can -row 0 -column 0 -sticky news
	grid [ttk::progressbar .progress -orient horizontal -length 100 \
		-mode determinate] -row 1 -column 0 -sticky news
	grid [label .loaded -text "Loading entries ..." -pady 6] \
		-row 2 -column 0 -sticky news
}
	
# Procedure to change display on title bar:

proc wmtitle {} {
	global latinfile englishfile
	if {[.eng edit modified]} {
		wm title . "WISH Superscriptorium (Save?) : [file tail $latinfile]\
		to [file tail $englishfile]"
	} else {
		wm title . "WISH Superscriptorium : [file tail $latinfile]\
		to [file tail $englishfile]"
	}
	bind .eng <Key> {after 10 saveup}
	bind .eng <Button-2> {after 10 saveup}
}

# Make top labels:
label .orig -text "ORIGINAL TEXT (click for translation options)" \
	-relief raised
label .optio -text "TRANSLATION OPTIONS" -relief raised
label .trans -text "TRANSLATION" -relief raised
lappend lightlist .orig .optio .trans

# Make mini-toolbar buttons:

frame .latifer
button .latope -text "Open" -command "openrece Latin"
button .latcut -text "Cut" -command {
	set tx .lat
	cut_text
}
button .latpaste -text "Paste" -command {
	set tx .lat
	paste_text
}
button .latundo -text "Undo" -command {
	set tx .lat
	catch {$tx edit undo}
}
button .latredo -text "Redo" -command {
	set tx .lat
	catch {$tx edit redo}
}
button .latsave -text "Save" -command "file_save Latin"
foreach butt [list .latope .latcut .latpaste .latundo .latredo .latsave] {
	$butt configure -pady 1
	pack $butt -in .latifer -side left -expand 1 -fill both
	lappend buttlist $butt
}

frame .optifer
button .optclear -text "Clear Options" -command {
	.glo configure -state normal
	.glo delete 1.0 end
	.glo configure -state disabled
}
button .optall -text "Clear All" -command file_new
button .optcop -text "Copy" -command copy_text
button .optquit -text "Quit" -activebackground red -command gitoot
foreach butt [list .optclear .optall .optcop .optquit] {
	$butt configure -pady 1
	pack $butt -in .optifer -side left -expand 1 -fill both
	lappend buttlist $butt
}

frame .engifer
button .engope -text "Open" -command "openrece English"
button .engcut -text "Cut" -command {
	set tx .eng
	cut_text
}
button .engpaste -text "Paste" -command {
	set tx .eng
	paste_text
}
button .engundo -text "Undo" -command {
	set tx .eng
	catch {$tx edit undo}
}
button .engredo -text "Redo" -command {
	set tx .eng
	catch {$tx edit redo}
}
button .engsave -text "Save" -command "file_save English"
foreach butt [list .engope .engcut .engpaste .engundo .engredo .engsave] {
	$butt configure -pady 1
	pack $butt -in .engifer -side left -expand 1 -fill both
	lappend buttlist $butt
}

# Make the text areas and scrollbars:

# Latin text area
text .lat -wrap word -setgrid 1 -undo 1 -font "helvetica 11" -width 38 -height 30
lappend texlist .lat
ttk::scrollbar .latbar -command {.lat yview}
.lat configure -yscrollcommand {.latbar set}
.lat tag configure term -background "#80FF80"
.lat tag configure buffo -background "#FFF080"
.lat tag configure afto -background "#FFF080"
.lat tag bind term <Button-1> latinget
bind .lat <Button-1> {
	set tx .lat
	.lat tag remove crit 1.0 end
}
bind .lat <Button-2> {set tx .lat}

# Procedure to get Latin words:

proc latinget {} {
	.glo configure -state normal
	set ranger [.lat tag ranges term]
	set wordstar [lindex $ranger 0]
	set wordendo [lindex $ranger 1]
	set word [.lat get $wordstar $wordendo]
	set wordpre [.lat search -backwards -regexp {[A-Za-z]} $wordstar "$wordstar linestart"]
	set wordpost [.lat search -forwards -regexp {[A-Za-z]} $wordendo "$wordendo lineend"]
	if {$wordpre ne ""} {
		set preword [.lat get "$wordpre wordstart" "$wordpre wordend"]
		.lat tag add buffo "$wordpre wordstart" "$wordpre wordend"
	} else {
		set preword ""
	}
	if {$wordpost ne ""} {
		set postword [.lat get "$wordpost wordstart" "$wordpost wordend"]
		.lat tag add afto "$wordpost wordstart" "$wordpost wordend"
	} else {
		set postword ""
	}
	eval [list findwords $word $preword $postword]
	.glo configure -state disabled
}

# Gloss text area
text .glo -wrap word -setgrid 1 -undo 1 -font "helvetica 11" -width 38 -height 30
lappend texlist .glo
.glo tag configure term -font "helvetica 12 bold" -background "#80FF80"
.glo tag configure termtype -font "helvetica 12 italic" -background "#80FF80"
.glo tag configure definition -background "#FFF080"
ttk::scrollbar .globar -command {.glo yview}
.glo configure -yscrollcommand {.globar set}

# English text area
text .eng -wrap word -setgrid 1 -undo 1	-font "helvetica 11" -width 38 -height 30
lappend texlist .eng
ttk::scrollbar .engbar -command {.eng yview}
.eng configure -yscrollcommand {.engbar set}
bind .eng <Button-1> {
	set tx .eng
	.eng tag remove crit 1.0 end
}
bind .eng <Button-2> {set tx .eng}

set text .lat
set dict .glo
set showmore 0
bind $text <Motion> {highlight $text $dict %x %y %s}
focus $tx

# Procedure for showing text areas after dictionary entries are loaded:

proc showtexts {} {
	destroy .can .progress .loaded
	wmtitle
	grid .latifer -row 0 -column 0 -columnspan 2 -sticky news
	grid .optifer -row 0 -column 2 -columnspan 2 -sticky news
	grid .engifer -row 0 -column 4 -columnspan 2 -sticky news
	grid .orig -row 1 -column 0 -columnspan 2 -sticky news
	grid .optio -row 1 -column 2 -columnspan 2 -sticky news
	grid .trans -row 1 -column 4 -columnspan 2 -sticky news	
	grid .lat -row 4 -column 0 -sticky news
	grid .latbar	-row 4 -column 1 -sticky news
	grid .glo -row 4 -column 2 -sticky news
	grid .globar -row 4 -column 3 -sticky news
	grid .eng -row 4 -column 4 -sticky news
	grid .engbar -row 4 -column 5 -sticky news
	. configure -menu .filemenu
}

# Procedure to highlight word for possible translation:

proc highlight {source dest x y state} {
	set word [$source get "@$x,$y wordstart" "@$x,$y wordend"]
    # low bit of $state is set if Shift is down
    # we also check to make sure we're over a word and not an empty string
    if {!($state&1) && [regexp {[A-Za-z]} $word]} {
		$source tag remove term 1.0 end
		$source tag remove buffo 1.0 end
		$source tag remove afto 1.0 end
		$source tag add term "@$x,$y wordstart" "@$x,$y wordend"
	}
}


### FILE MENU ###

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

# Procedures for getting files in and out:

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

proc readytogo {lang} {
	global latinfile englishfile tx
	set exitanswer ""
	if {$lang eq "Latin"} {
		set tx .lat
		set currentfile $latinfile
	} else {
		set tx .eng
		set currentfile $englishfile
	}
	if {[$tx edit modified]} {
		if {[regexp {Input|Untitled} $currentfile] == 0} {
			file_save $lang
		} else {
			set exitanswer [tk_messageBox -message "Save changes ($lang)?" \
				-title "Save changes ($lang)?" -type yesnocancel -icon question]
			if {$exitanswer eq "yes"} {
				file_saveas $lang
			}
		}
	}
	if {$exitanswer eq "cancel"} {
		return 0
	} else {
		return 1
	}
}

# Procedure to remove old contents from text area:

proc outwithold {lang} {
	global latinfile englishfile latinback engback tx
	if {$lang eq "Latin"} {
		set w .lat
		set latintitle Input
		set latinback ""
	} else {
		set w .eng
		set englishfile Untitled
		set engback ""
	}
	$w delete 1.0 end
	$w edit reset
	$w edit modified 0
}

# Procedure to get saved changes recognized at once:

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

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

proc inwithnew {lang} {
	global newfile latinfile englishfile latinlist englist tx
	if {$newfile eq "" || [file readable $newfile] == 0} {
		return
	}
	set star [open $newfile "r"]
	set filecont [read $star]
	close $star
	set filecont [string trimright $filecont]
	if {$lang eq "Latin"} {
		set tx .lat
		set latinfile $newfile
		if {$latinfile ni $latinlist} {
			lappend latinlist $latinfile
		}
	} else {
		set tx .eng
		set englishfile $newfile
		if {$englishfile ni $englist} {
			lappend englist $englishfile
		}
	}
	$tx insert insert $filecont
	$tx edit reset
	$tx edit modified 0
	focus $tx
	wmtitle
	
}

# Procedure to put translation option into text area:

proc dictAppend {text} {
    global dict
    $dict configure -state normal
    $dict insert end $text
    $dict configure -state disabled
}


### File -- New

.filemenu.files add command -label "New" \
	-underline 0 -command file_new
	
proc file_new {} {
	global latinfile englishfile
	foreach lang [list Latin English] {
		set go [readytogo $lang]
		if {$go == 0} {
			return
		}
	}
	.glo configure -state normal
	.glo delete 1.0 end
	.glo configure -state disabled
	outwithold Latin
	outwithold English
	foreach w [list .lat .glo .eng] {
		$w edit separator
		$w edit modified 0
	}
	set latinfile Input
	set englishfile Untitled
	wmtitle
}

.filemenu.files add separator

### File -- Open Any

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

proc file_open {lang whence} {
	global newfile latinfile englishfile latinlist englist filetosave tx
	if {$lang eq "Latin"} {
		set tx .lat
	} else {
		set tx .eng
	}
	set go [readytogo $lang]
	if {$go == 0} {return}
	if {$whence eq "any"} {
		set newfile [tk_getOpenFile]
	} else {
		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
			}
			set newfile $receline
		}
	}
	if {$newfile ne ""} {
		outwithold $lang
		inwithnew $lang
		$tx mark set insert 1.0
		after 100 "saverece $lang"
	}
	if {[winfo exists .rece]} {
	 	destroy .rece
	}
	savefig
}

### File -- Open Recent

.filemenu.files add command -label "Open Latin--Recent" -underline 6 \
	-command "openrece Latin"
.filemenu.files add command -label "Open English--Recent" -underline 7 \
	-command "openrece English"

# Procedure to make GUI box for selecting recently opened files:

proc openrece {lang} {
	global wishdir rece latinlist englist reclim newfile addfile \
		latinfile englishfile findum openew tx
		
	# Get list of recently opened or inserted files:
	getrecent
	set findum ""
	
	# Make GUI box:
	toplevel .rece
	grid [listbox .rece.list -width 72 -height 16 -bg $::textback -fg $::textfore \
		-selectmode extended] -row 0 -column 0 -sticky new
	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
	entry .rece.ent -bg $::textback -fg $::textfore -width 48 \
		-textvariable findum
	label .rece.found -text "0 found"
	pack .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
	button .rece.find -text "Search" -default normal -pady 1 -border 1 \
		-bg $::buttback -fg $::buttfore -relief solid -command findrece
	button .rece.open -default normal
	button .rece.all -text "Open Any ($lang)" -default normal \
		-command "file_open $lang any"
	label .rece.show -text "Show"
	spinbox .rece.spin -width 4 -from 1 -to 9999 -bg $::textback \
		-fg $::textfore -buttonbackground $::buttback
	label .rece.fils -text "Files"
	button .rece.unlist -text "Unlist" -default normal -command unlisto
	button .rece.close -text "Close" -default normal -command {destroy .rece}
	foreach butt [list .rece.find .rece.open .rece.all .rece.unlist .rece.close] {
		$butt configure -pady 1 -padx 0	-bg $::buttback -fg $::buttfore
	}
	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
	wm title .rece "Open Recently Viewed File ($lang)"
	if {$lang eq "Latin"} {
		.rece.list configure -listvariable latinlist
	} else {
		.rece.list configure -listvariable englist
	}
	bind .rece <Key-Return> "findrece $lang"
	.rece.open configure -text "Open" -command "file_open $lang recent"
	.rece.spin configure -textvariable reclim
	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
	bind .rece.list <Double-Button-1> "file_open $lang recent"
	bind .rece.list <Button-3> {
		selection clear
		set clixel %y
		set clickline [.rece.list nearest $clixel]
		.rece.list selection set $clickline $clickline
		if {[regexp "Latin" [wm title .rece]]} {
			file_open Latin recent
		} else {
			file_open English recent
		}
	}
	focus .rece.ent
	.rece.list see end
}

# Procedure to find name of recently viewed file:

proc findrece {lang} {
	global findum latinlist englist
	if {$lang eq "Latin"} {
		set listo $latinlist
	} else {
		set listo $englist
	}
	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 delete listings of recently opened files:

proc unlisto {} {
	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
	}
	after 100 saverece
}

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

proc saverece {lang} {
	global rece latinlist englist wishdir latinfile englishfile \
		reclim dumpfile
	if {$lang eq "Latin"} {
		set recentlist $latinlist
	} else {
		set recentlist $englist
	}
	set recleng [expr {[llength $recentlist] -1}]
	foreach r [range $recleng to 0] {
		set rindex [lindex $recentlist $r]
		if {$rindex eq $dumpfile} {
			set recentlist [lreplace $recentlist $r $r]
		}
		if {$rindex eq $latinfile && $lang eq "Latin"} {
			set recentlist [lreplace $recentlist $r $r]
		}
		if {$rindex eq $englishfile && $lang eq "English"} {
			set recentlist [lreplace $recentlist $r $r]
		}
	}
	if {$recleng > $reclim} {
		set limless [expr {$recleng-$reclim-1}]
		set recentlist [lreplace $recentlist 0 $limless]
	}
	if {$lang eq "Latin"} {
		set latinlist $recentlist
		lappend latinlist $latinfile
		set recfil [open $rece "w"]
	} else {
		set englist $recentlist
		lappend englist $englishfile
		set recfil [open $rece "w"]
	}
	set recentex "set reclim $reclim\
		\nset latinlist \[list $latinlist\]\
		\nset englist \[list $englist\]"
	puts -nonewline $recfil $recentex
	close $recfil
}

.filemenu.files add separator

### File -- Save

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

proc file_save {lang} {
	global latinfile englishfile filecont tx
	set filecont [$tx get 1.0 end]
	set texttosave [string trimright $filecont]
	if {$lang eq "Latin"} {
		set fileo $latinfile
	} else {
		set fileo $englishfile
	}
	if {$fileo ne "" && [regexp {Input|Untitled} $fileo] == 0} {
		set fileid [open $fileo "w"]
		puts $fileid $filecont
		close $fileid
		$tx edit reset
		$tx edit modified 0
		wm title . "WISH Superscriptorium : Saved $fileo"
		after 1500 wmtitle
	} else {file_saveas $lang}
}

### File -- Save As

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

proc file_saveas {lang} {
	global englishfile latinfile filecont filetosave tx
	if {$lang eq "Latin"} {
		set currentfile $latinfile
	} else {
		set currentfile $englishfile
	}
	if {[file writable $currentfile]} {
		file_save $lang
	} 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
	if {$lang eq "Latin"} {
		set latinfile $filetosave
	} else {
		set englishfile $filetosave
	}
	$tx edit reset
	$tx edit modified 0
	saverece $lang
	wm title . "WISH Superscriptorium : Saved $filetosave"
	after 1500 wmtitle
}

.filemenu.files add separator

### File -- Backup

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

proc backup {lang} {
	global englishfile latinfile engback latinback tx
	if {$lang eq "Latin"} {
		set currentfile $latinfile
		set backfile $latinback
	} else {
		set currentfile $englishfile
		set backfile $engback
	}
	if {$currentfile ne ""} {
		if {[$tx edit modified]} {
			file_save $lang
		}
	} 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 Superscriptorium : File backed up as $backfile"
		after 1500 wmtitle
	} else {
		backup_as $lang
	}
}

### File -- Backup As

.filemenu.files add command -label "Backup As--English" \
	-command "backup_as English"
.filemenu.files add command -label "Backup As--Latin" \
	-command "backup_as Latin"
	
proc backup_as {lang} {
	global englishfile latinfile engback latinback tx
	if {$lang eq "Latin"} {
		set currentfile $latinfile
		set backfile $latinback
	} else {
		set currentfile $englishfile
		set backfile $engback
	}
	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 . "Superscriptorium : File backed up as $backfile"
		after 1500 wmtitle
		if {$lang eq "Latin"} {
			set latinfile $filetosave
		} else {
			set englishfile $filetosave
		}
	}
}

.filemenu.files add separator

### File -- Move/Rename

.filemenu.files add command -label "Move/Rename English" \
	-command "file_rename English"
.filemenu.files add command -label "Move/Rename Latin" \
	-command "file_rename Latin"

# Procedure to move or rename file:

proc file_rename {lang} {
	global englishfile latinfile dumpfile
	if {$lang eq "Latin"} {
		set currentfile $latinfile
	} else {
		set currentfile $englishfile
	}
	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
		if {$lang eq "Latin"} {
			set latinfile $currentfile
		} else {
			set englishfile $currentfile
		}
		file_save $lang
		saverece $lang
	}
}

.filemenu.files add separator

### File -- Exit

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

# Procedure to shut down properly:

proc gitoot {} {
	if {[.eng edit modified] || [.lat edit modified]} {
		set seeya 1
	} else {
		set seeya 0
	}
	foreach lang [list Latin English] {
		set go [readytogo $lang]
		if {$go == 0} {
			return
		}
	}
	savefig
	if {$seeya == 0} {
		exit
	} else {
		# Give the user half a second to see that changes have been saved:
		after 500 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 tx
	tk_textCut $tx
	$tx edit separator
	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 tx
	tk_textCopy $tx
}

### 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 tx
	tk_textPaste $tx
	$tx edit separator
	wmtitle
}

### Edit -- Delete

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

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

.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}

.filemenu.edit add separator

### Edit -- Special Characters

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

# Procedure for setting up special-character selection box:

set specialbutts [list]

proc specialbox {} {
	global charlist foco buttlist tx
	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
		bind .spec.but($c) <Button-1> {
			set butt %W
			set charx [$butt cget -text]
			set tex [set tx]
			$tex insert insert $charx
		}
		incr col
		if {$col > 4} {
			set col 0
			incr row
		}
	}
}

### 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


### 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 .find} 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"

# 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 {".find" in $gridslaves} {
		newfind find
	} elseif {".replace" in $gridslaves} {
		newfind replace
	}
}

# Procedure to set up "Find" dialog bar:

proc search_find {} {
	global search_query search_for casematch searchway searchin tx \
		anytries findex critters
	set critters 0 ; # Presume no "AND" connector in search criteria
	set findex .find
	frame .find
	set usetext "Substitute . for any one character, * for zero or more,\
		+ for one or more"
	label .find.use -text $usetext -pady 2
	frame .find.fr
	button .find.next -text "Find (F2)" -pady 1 -command {find_text find}
	entry .find.enter -width 80 -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 {destroy .find}
	pack .find.next .find.enter .find.new .find.close \
		-in .find.fr -side left -expand 1 -fill both
	frame .find.ex
	button .find.or -text "OR (|)" -pady 1 -default normal \
		-command {
		.find.enter insert insert "|"
	}
	button .find.and -text "AND ( & )" -pady 1 -default normal \
		-command {
		.find.enter insert insert " & "
	}
	label .find.search -text "Search: " -pady 1
	radiobutton .find.sent -text "Same sentence" -variable searchin -value sent
	radiobutton .find.par -text "Same paragraph" -variable searchin -value par
	radiobutton .find.up -text "Up" -variable searchway -value "backward"
	radiobutton .find.down -text "Down" -variable searchway -value "forward"
	checkbutton .find.match -text "Match case" -variable casematch \
		-onvalue "exact" -offvalue "nocase"
	checkbutton .find.exp -text "Expert search" -variable expert
	pack .find.or .find.and .find.search .find.sent .find.par \
		.find.up .find.down .find.match .find.exp -in .find.ex \
		-side left -expand 1 -fill both
	bind .find <F2> {find_text find}
	pack .find.use .find.fr .find.ex -in .find -side top -expand 1 -fill both  
	.find.use configure -bg $::lightback -fg $::lightfore
	.find.enter configure -bg $::textback -fg $::textfore
	foreach butt [list .find.next .find.new .find.close .find.or .find.and] {
		$butt configure -bg $::buttback -fg $::buttfore
	}
	foreach butt [list .find.sent .find.par .find.up .find.down \
		.find.match .find.exp] {
		$butt configure -selectcolor $::textback	-pady 1
	}
	grid .find -row 2 -column 0 -columnspan 6 -sticky news
	focus .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 tx
	
	# 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
			}
		}
		
		# Widgets won't work when they shouldn't:
		if {$whatfor eq "find"} {
			foreach w [list .find.enter .find.or .find.and .find.search \
				.find.sent .find.par .find.match .find.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 3 -column 0 -columnspan 6 -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 3 -column 0 -columnspan 6 -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"} {
			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 {
			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
	}
}

# Procedure to start searching from scratch:

proc newfind {why} {
	global critters tx
	set ::search_query ""
	set ::search_for ""
	set ::anytries 0
	grid forget .fin
	if {$why eq "find"} {
		foreach w [list .find.enter .find.or .find.and .find.search \
			.find.sent .find.par .find.match .find.exp] {
			$w configure -state normal
		}
		focus .find.enter
	} else {
		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

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

# Procedures for replacing text

# Set up "Replace" dialog bar:

proc search_replace {} {
	global casematch searchway start tx anytries critters search_query \
		search_for replace_with findex expert
	set findex .rep
	set searchway forward
	set start [$tx index insert]
	frame .replace
	frame .rep
	set usetext "Substitute . for any one character, * for zero or more,\
		+ for one or more; | for \"OR\""
	label .repuse -text $usetext -pady 2
	label .rep.what -text "Replace:"
	entry .rep.enter -width 100 -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 100 -textvariable replace_with
	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 {destroy .replace .repuse .rep .with .place}
	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}
	grid .replace -row 2 -column 0 -columnspan 6 -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
}

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

proc replace_one {} {
	global nextplace findlength repleng countum tx \
		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 tx
	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
}


### DISPLAY MENU ###

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

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

proc colodisp {} {
	global color red green blue whatfig whatbutt colorlist colordir \
		winback winfore selback selfore buttback buttfore textback \
		textfore headback headfore lightback lightfore coloron wishdir \
		libdir current_scheme 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 Superscriptorium : WISH Color Picker Plus"
}


### HELP MENU ###

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


### USER HELP

.filemenu.help add command -label "User Help Guide" -underline 5 -command scriphelp
set helpfile [file join $docdir scriphelp_link.txt] ; # User Help Guide

proc scriphelp {} {
	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 Superscriptorium - User Help"
	set helplink [open $helpfile r]
	set helpcontents [read $helplink]
	close $helplink
	.uhelp.tx insert 1.0 $helpcontents
	linktext .uhelp.tx; # Show links in text--from WISH User Help
	.uhelp.tx mark set insert 1.0
	.uhelp.tx configure -state disabled
}


### LATIN ANALYSIS ###

# Code for working with the "Words" Latin lexicon and parser

# By David McClamrock
# Based on public-domain code by Mike Polis

# If this is set to a non-zero number, then a list of failed matches will be
# produced if a word is not found.
set options(show_misses) 0

# Variables and procedure for getting lines from DICTLINE.GEN:

proc grip_dictline {filename} {
	global stemline libdir
	if {[catch {set fileo [open $filename r]} result]} {
		tk_messageBox -icon error -type ok -title {Load Failed} -message \
		"Unable to open file $filename for Words lexicon: $result"
	}
	set openup [read $fileo]
	set openup [split $openup \n]
	set openleng [llength $openup]
	close $fileo
	.progress configure -maximum $openleng
	.progress start
	for {set n 0} {$n < $openleng} {incr n} {
		.progress step
		if {$n%100 == 0} {update}
		set line [lindex $openup $n]
		if {[string length $line] < 1 || [string first "#" \
			$line] == 0} {continue}
		set stem(1) [string trim [string range $line 0 18]]
		set stem(2) [string trim [string range $line 19 37]]
		set stem(3) [string trim [string range $line 38 56]]
		set stem(4) [string trim [string range $line 57 75]]
		set existems [list nada $stem(1) $stem(2) $stem(3) $stem(4)]
		set part [string trim [string range $line 76 82]]
		set breakdown [string trim [string range $line 83 99]]
		set extras [string trim [string range $line 100 109]]
		set def [string trim [string range $line 110 end]]
		set def [string trimright $def ";"]
		set freq [lindex $extras 3]
		set stems [list]
		foreach num [list 1 2 3 4] {
			set stemnow $stem($num)
			set stemleng [string length $stemnow]
			if {$stemleng < 1 || $stemnow eq "zzz"} {continue}
			# Special case for zero-length second stem of TO_BE,
			# represented by a dot in DICTLINE.GEN:
			if {$stemnow eq "."} {
				set stemnow ""
			}
			if {[lsearch $stems $num] < 0} {
				set stems [lsearch -all $existems $stemnow]
			} else {
				continue
			}
			switch $part {
				N {
					set declin [lindex $breakdown 0]
					set varian [lindex $breakdown 1]
					set gender [lindex $breakdown 2]
					set kind [lindex $breakdown 3]
					lappend stemline($stemnow) [list part $part declin $declin \
						varian $varian gender $gender kind $kind extras $extras \
						freq $freq stems $stems def $def]
				}
				V -
				ADJ -
				PRON -
				PACK {
					set declin [lindex $breakdown 0]
					set varian [lindex $breakdown 1]
					set kind [lindex $breakdown 2]
					lappend stemline($stemnow) [list part $part declin $declin \
						varian $varian kind $kind extras $extras \
						freq $freq stems $stems def $def]
				}
				NUM {
					set declin [lindex $breakdown 0]
					set varian [lindex $breakdown 1]
					set kind [lindex $breakdown 2]
					set numero [lindex $breakdown 3]
					lappend stemline($stemnow) [list part $part \
						declin $declin varian $varian numero $numero \
						extras $extras freq $freq stems $stems def $def]
				}	
				ADV {
					set kind [lindex $breakdown 0]
					lappend stemline($stemnow) [list part $part \
						declin {} varian {} kind $kind extras $extras \
						freq $freq stems $stems def $def]
				}
				PREP {
					set case [lindex $breakdown 0]
					lappend stemline($stemnow) [list part $part \
						declin {} varian {} case $case extras $extras \
						freq $freq stems $stems def $def]
				}
				default {
					lappend stemline($stemnow) [list part $part \
						declin {} varian {} extras $extras \
						freq $freq stems $stems def $def]
				}
			}
		}
	}
	grip_inflects [file join $libdir INFLECTS]
}

# Procedure for getting lines from INFLECTS:

proc grip_inflects {filename} {
	global endline maxend loading_words
	if {[catch {set fileo [open $filename r]} result]} {
		tk_messageBox -icon error -type ok -title {Load Failed} -message \
		"Unable to open file $filename for Words lexicon: $result"
	}
	set openup [read $fileo]
	set openup [split $openup \n]
	close $fileo
	# I think the longest endings are 7 characters, but we'll see:
	set maxend 7
	for {set n 0} {$n < [llength $openup]} {incr n} {
		set line [lindex $openup $n]
		# Remove comments (which start with "--")
		set i [string first "--" $line]
		if {$i >= 0} {
			set line [string replace $line $i end]
		}
		# Throw away empty lines
		if {$line eq ""} {continue}
		
		set part [lindex $line 0]
		switch $part {
			N -
			PRON {
				set ending [lindex $line 9]
				set whatstem [lindex $line 7]
				set declin [lindex $line 1]
				set varian [lindex $line 2]
				set case [lindex $line 3]
				set number [lindex $line 4]
				set gender [lindex $line 5]
				lappend endline($ending) [list part $part declin $declin varian $varian \
					case $case number $number gender $gender stem $whatstem]
			}
			ADJ {
				set ending [lindex $line 9]
				set whatstem [lindex $line 7]
				set declin [lindex $line 1]
				set varian [lindex $line 2]
				set case [lindex $line 3]
				set number [lindex $line 4]
				set gender [lindex $line 5]
				set degree [lindex $line 6]
				lappend endline($ending) [list part $part declin $declin varian $varian \
					case $case number $number gender $gender degree $degree stem $whatstem]
			}
			V {
				set ending [lindex $line 11]
				set whatstem [lindex $line 9]
				set declin [lindex $line 1]
				set varian [lindex $line 2]
				set tense [lindex $line 3]
				set voice [lindex $line 4]
				set mood [lindex $line 5]
				set person [lindex $line 6]
				set number [lindex $line 7]
				lappend endline($ending) [list part $part declin $declin varian $varian \
					tense $tense voice $voice mood $mood person $person number $number \
					stem $whatstem]
			}
			VPAR {
				set ending [lindex $line 12]
				set whatstem [lindex $line 10]
				set declin [lindex $line 1]
				set varian [lindex $line 2]
				set case [lindex $line 3]
				set number [lindex $line 4]
				set gender [lindex $line 5]
				set tense [lindex $line 6]
				set voice [lindex $line 7]
				lappend endline($ending) [list part $part declin $declin varian $varian \
					case $case number $number gender $gender tense $tense voice $voice \
					stem $whatstem]
			}
			SUPINE {
				set ending [lindex $line 9]
				set case [lindex $line 3]
				lappend endline($ending) [list part $part case $case stem 4]
			}
			NUM {
				set ending [lindex $line 10]
				set whatstem [lindex $line 8]
				set declin [lindex $line 1]
				set varian [lindex $line 2]
				set case [lindex $line 3]
				set number [lindex $line 4]
				set gender [lindex $line 5]
				set kind [lindex $line 6]
				lappend endline($ending) [list part $part declin $declin varian $varian \
					case $case number $number gender $gender kind $kind stem $whatstem]
			}
			ADV {
				set ending ""
				set whatstem [lindex $line 2]
				set degree [lindex $line 1]
				lappend endline($ending) [list part $part \
					declin {} varian {} degree $degree stem $whatstem]
			}
			PREP {
				set ending ""
				set case [lindex $line 1]
				lappend endline($ending) [list part $part \
					declin {} varian {} case $case stem 1]
			}
			default {
				set ending ""
				lappend endline($ending) [list part $part \
					declin {} varian {} stem 1]
			}
		}
		set endleng [string length $ending]
		if {$endleng > $maxend} {
			set maxend $endleng
		}
	}
	showtexts
}

# Procedure for finding enclitics:

set enclitics [list cumque cunque cum dam libet lubet nam ne piam quam que vis]

proc enclitic_bust {word} {
	global stemline enclitics
	set realword $word
	set enclitic ""
	if {[info exists stemline($word)] < 1} {
		foreach enclit $enclitics {
			if {[regexp -indices $enclit$ $word rang]} {
				set wordend [expr {[lindex $rang 0] -1}]
				set realword [string range $word 0 $wordend]
				set enclitic $enclit
				break
			}
		}
	}
	return [list $realword $enclitic]
}

# Procedure for getting translation options for words:

proc findwords {word preword postword} {
	global wordin
	# First see if whole word is found:
	lookup $word $preword $postword
	# Then hack off enclitics, if any, and see if whole word
	# may also amount to smaller word plus enclitic:
	set wordplus [enclitic_bust $word]
	set wordminus [lindex $wordplus 0]
	set enclitic [lindex $wordplus 1]
	if {$enclitic ne ""} {
		lookup $wordminus $preword $postword
		if {$wordin} {
			findout $enclitic
		}
	}
}

# Procedure for finding out what to do with enclitics:

proc findout {enclitic} {
	global enclitics
	set oldend [.glo index "end -1 c"]
	set hitter "$enclitic : enclitic\n"
	switch $enclitic {
		cumque -
		cunque -
		libet -
		lubet {
			append hitter "-ever; -soever; no matter ...\n"
		}
		cum {
			append hitter "with ...\n"
		}
		dam {
			append hitter "a certain ...; one ...;\n"
		}
		nam {
			append hitter "... then; ... in the world; ... I insist\n"
		}
		ne {
			append hitter "(signifies that answer to question is uncertain)\n"
		}
		piam -
		quam {
			append hitter "any ... ; some ...\n"
		}
		que {
			append hitter "and ...\n"
		}
		vis {
			append hitter "any ... whatever; ... you please"
		}
		default {
			# Do nothing with ghost enclitics from nowhere
		}
	}
	.glo insert "end -1 c" $hitter
	set colo [.glo search ":" $oldend "$oldend lineend"]
	.glo tag add term $oldend "$colo + 1 c"
	.glo tag add termtype term.last "$oldend lineend + 1 c"
	.glo tag add definition termtype.last "termtype.last lineend + 1 c"	
}
	
# Procedure for looking up words by stem and ending:

proc lookup {word preword postword} {
	global stemline endline maxend wordin
	
	# Check all possible combinations up to length of longest ending:
	set wordlen [string length $word]
	set hitlist [list]
	for {set endlen $maxend} {$endlen >= 0} {incr endlen -1} {
		
		# No fair to have an ending longer than the entire word:
		if {$endlen > $wordlen} {
			continue
		}
		# Maybe this is a stem; if not, move on:
		set mebstem [string range $word 0 "end-$endlen"]
		if {[info exists stemline($mebstem)]} {
			set stemleng [llength $stemline($mebstem)]
		} else {
			continue
		}
		# Maybe this is an ending:
		set mebend [string range $word [string length $mebstem] end]
		if {[info exists endline($mebend)]} {
			set endleng [llength $endline($mebend)]
			set hit ""
			for {set s 0} {$s < $stemleng} {incr s} {
				set hit "$mebstem.$mebend : "
				set realhit 0
				set stemmer [lindex $stemline($mebstem) $s]
				set stempart [lindex $stemmer 1]
				set stemmatch [lrange $stemmer 2 5]
				set stemnums [lindex $stemmer "end-2"]
				# Weed out unsuitable endings quick; list suitable ones:
				set enders [list]
				for {set e 0} {$e < $endleng} {incr e} {
					set ender [lindex $endline($mebend) $e]
					set endstem [lindex $ender end]
 					if {[lsearch $stemnums $endstem] < 0} {
						continue
					}
					set endpart [lindex $ender 1]
					set particip 0
					if {$endpart eq "VPAR"} { 
						if {$stempart eq "V"} {
							set particip 1
						} else {
							continue
						}
					} elseif {$stempart eq "PACK" && $endpart ne "PRON"} {
						continue
					} elseif {$stempart ne $endpart} {
						continue
					}
					set endmatch [lrange $ender 2 5]
					if {$stemmatch eq $endmatch || $particip == 1} {
						lappend enders $ender
						set realhit 1
					}
				}
				if {$realhit == 0} {
					continue
				}
				set freq [lindex $stemmer "end-4"]
				set defnum [lindex $stemmer end]
				switch $stempart {
					N {
						append hit "noun "
						set stem_gender [lindex $stemmer 7]
						if {[regexp {M|F|N} $stem_gender]} {
							append hit "($stem_gender) "
						}
						set declin [lindex $stemmer 3]
						if {0 < $declin < 6} {
							append hit "D$declin\n"
						}
					}
					PRON -
					PACK {
						
						## Check def for enclitics to match! ##
						append hit "pronoun "
						set kind [lindex $stemmer 7]
						switch $kind {
							ADJECT {append hit "(correl. adj.)\n"}
							DEMONS {append hit "(demonstrative)\n"}
							INDEF {append hit "(indefinite)\n"}
							INTERR {append hit "(interrogative)\n"}
							PERS {append hit "(personal)\n"}
							REL {append hit "(relative)\n"}
							REFLEX {append hit "(reflexive)\n"}
							default {
								# If you can't say anything correct
								# about pronouns, don't say anything!
							}
						}
					}
					ADJ {
						append hit "adjective "
						# Find out if adjective is comparative,
						# superlative, or neither:
						set kind [lindex $stemmer 7]
						switch $kind {
							COMP {append hit "(comparative, \"more\") "}
							SUPER {append hit "(superlative, \"most\") "}
							default {
								# No need to mention that adjective
								# isn't comparative or superlative
							}
						}
						set declin [lindex $stemmer 3]
						if {0 < $declin < 3} {
							append hit "D1-2\n"
						} elseif {$declin == 3} {
							append hit "D3\n"
						}
					}
					V {
						append hit "verb "
						# Find out kind of verb:
						set kind [lindex $stemmer 7]
						switch $kind {
							TO_BE -
							TO_BEING {append hit "(being) "}
							INTRANS {append hit "(intransitive) "}
							TRANS {append hit "(transitive) "}
							DEP {append hit "(deponent/passive form?) "}
							SEMIDEP {append hit "(semi-deponent/passive\
								form in perfect tenses) "}
							IMPERS {append hit "(impersonal) "}
							default {
								# Don't descend too far into the
								# dark, deep pit of obscure verb types
							}
						}
						set conjug [lindex $stemmer 3]
						if {$conjug == 1 || $conjug == 2} {
							append hit "C$conjug"
						}
						if {$conjug == 3} {
							set vario [lindex $stemmer 5]
							if {$vario == 4} {
								append hit "C$vario"
							} else {
								append hit "C$conjug"
							}
						}
						if {$particip == 1} {
							append hit " (participle?)"
						}
						append hit "\n"
					}
					NUM {
						append hit "numeral "
						set kind [lindex $stemmer 7]
						switch $kind {
							CARD {append hit "(cardinal)\n"}
							ORD {append hit "(ordinal)\n"}
							DIST {append hit "(distributive)\n"}
							ADVERB {append hit "(adverb)\n"}
							default {
								# Don't know what to do, better do nothing
							}
						}
					}
					ADV {
						append hit "adverb "
						set kind [lindex $stemmer 7]
						switch $kind {
							COMP {append hit "(comparative, \"more\")\n"}
							SUPER {append hit "(superlative, \"most\")\n"}
							default {
								# No need to mention that adjverb
								# isn't comparative or superlative
								append hit "\n"
							}
						}
					}
					PREP {
						append hit "preposition "
						set case [lindex $stemmer 7]
						switch $case {
							GEN {append hit "(w/Gen)\n"}
							ABL {append hit "(w/Abl)\n"}
							ACC {append hit "(w/Acc)\n"}
						}
					}
					CONJ {
						append hit "conjunction\n"
					}
					INTERJ {
						append hit "interjection\n"
					}
					default {
						# Do nothing with any unknown part of speech
					}
				}
				# Put in definition:
				append hit "[lindex $stemmer end]\n"
				# Make list that will be sorted to get cases or whatnot
				# to appear in the correct order:
				set littlebit [list]
				foreach ender $enders {
					set endpart [lindex $ender 1]
					switch $endpart {
						N {
							set end_gender [lindex $ender 11]
							switch $end_gender {
								M {
									if {[regexp {F|N} $stem_gender]} {
										set realhit 0
										continue
									}
								}
								F {
									if {[regexp {M|N} $stem_gender]} {
										set realhit 0
										continue
									}
								}
								N {
									if {[regexp {M|F} $stem_gender]} {
										set realhit 0
										continue
									}
								}
								default {
									# Tolerate non-contradictory
									# gender designations
								}
							}
							
							# Put in some grammatical stuff, like case:
							set case [lindex $ender 7]
							# And number (S or P):
							set number [lindex $ender 9]
							switch $case {
								NOM {
									if {$number eq "S"} {
									set number "sing"
										set whatitis ": \"a/the \[noun\]\""
									} else {
										set number "plur"
										set whatitis ": \"\[noun\]s\""
									}
									lappend littlebit [list 1 "Nom $number $whatitis\n"]
								}
								GEN {
									if {$number eq "S"} {
										set number "sing"
										set whatitis ": \"of \[noun\]\""
									} else {
										set number "plur"
										set whatitis ": \"of \[noun\]s\""
									}
									lappend littlebit [list 2 "Gen $number $whatitis\n"]
								}
								DAT {
									if {$number eq "S"} {
										set number "sing"
										set whatitis ": \"to/for \[noun\]\""
									} else {
										set number "plur"
										set whatitis ": \"to/for \[noun\]s\""
									}
									lappend littlebit [list 3 "Dat $number $whatitis\n"]
								}
								ACC {
									if {$number eq "S"} {
										set number "sing"
										set whatitis ": \"a/the \[noun\]\""
									} else {
										set number "plur"
										set whatitis ": \"\[noun\]s\""
									}
									lappend littlebit [list 4 "Acc $number $whatitis\n"]
								}
								ABL {
									if {$number eq "S"} {
										set number "sing"
										set whatitis ": \"from/with/by ... \[noun\]\""
									} else {
										set number "plur"
										set whatitis ": \"from/with/by ... \[noun\]s\""
									}
									lappend littlebit [list 5 "Abl $number $whatitis\n"]
								}
								VOC {
									if {$number eq "S"} {
										set number "sing"
										set whatitis ": \"O \[noun\]\""
									} else {
										set number "plur"
										set whatitis ": \"O \[noun\]s\""
									}
									lappend littlebit [list 6 "Voc $number $whatitis\n"]
								}
								LOC {
									if {$number eq "S"} {
										set number "sing"
										set whatitis ": \"at \[noun--place\]\""
									} else {
										set number "plur"
										set whatitis ": \"at \[noun--place\]s\""
									}
									lappend littlebit [list 7 "Loc $number $whatitis\n"]
								}
							}
						}
						PRON {	
							# Put in some grammatical stuff, like case:
							set case [lindex $ender 7]
							# And number (S or P):
							set number [lindex $ender 9]
							switch $case {
								NOM {
									if {$number eq "S"} {
									set number "sing"
										set whatitis ": \"I/you/he/she/it\""
									} else {
										set number "plur"
										set whatitis ": \"\we/you/they\""
									}
									lappend littlebit [list 1 "Nom $number $whatitis\n"]
								}
								GEN {
									if {$number eq "S"} {
										set number "sing"
										set whatitis ": \"my/your/his/her/its\""
									} else {
										set number "plur"
										set whatitis ": \"our/your/their\""
									}
									lappend littlebit [list 2 "Gen $number $whatitis\n"]
								}
								DAT {
									if {$number eq "S"} {
										set number "sing"
										set whatitis ": \"to/for me/you/him/her/it\""
									} else {
										set number "plur"
										set whatitis ": \"to/for us/you/them\""
									}
									lappend littlebit [list 3 "Dat $number $whatitis\n"]
								}
								ACC {
									if {$number eq "S"} {
										set number "sing"
										set whatitis ": \"me/you/him/her/it\""
									} else {
										set number "plur"
										set whatitis ": \"us/you/them\""
									}
									lappend littlebit [list 4 "Acc $number $whatitis\n"]
								}
								ABL {
									if {$number eq "S"} {
										set number "sing"
										set whatitis ": \"from/with/by ...\
											me/you/him/her/it\""
									} else {
										set number "plur"
										set whatitis ": \"from/with/by ... us/you/them\""
									}
									lappend littlebit [list 5 "Abl $number $whatitis\n"]
								}
							}
						}	
						ADJ {
							# Put in some grammatical stuff, like case:
							set case [lindex $ender 7]
							# And number (S or P):
							set number [lindex $ender 9]
							set gender [lindex $ender 11]
							if {$number eq "S"} {
								set number "sing"
							} else {
								set number "plur"
							}
							switch $case {
								NOM {lappend littlebit [list 1 "Nom $number $gender\n"]}
								GEN {lappend littlebit [list 2 "Gen $number $gender\n"]}
								DAT {lappend littlebit [list 3 "Dat $number $gender\n"]}
								ACC {lappend littlebit [list 4 "Acc $number $gender\n"]}
								ABL {lappend littlebit [list 5 "Abl $number $gender\n"]}
							}
						}
						V {
							# Verbs have more grammar than other words:
							# person, number, tense, mood, voice.
							# Separate procedure "verbform" is used
							# to extract and report all that.
							set person [lindex $ender 13]
							set number [lindex $ender 15]
							set tense [lindex $ender 7]
							if {[regexp "semi-deponent" $hit]} {
								if {$tense eq "PERF"} {
									set voice "ACTIVE"
								}
							} elseif {[regexp "deponent" $hit]} {
								set voice "ACTIVE"
							} else {
								set voice [lindex $ender 9]
							}
							set mood [lindex $ender 11]
							lappend littlebit [list 1 "[verbform $person $number \
								$voice $tense $mood]\n"]
						}
						VPAR {
							
							# Oops, participles have still more grammar:
							# verb grammar *plus* noun/adjective grammar!
							# They've got conjugation, variant, case,
							# number, gender, tense, voice, and verb type!
							# Of these, we still need to check case, number,
							# gender, tense, and voice. Separate procedure
							# "partiform" will do that.
							set case [lindex $ender 7]
							set number [lindex $ender 9]
							set gender [lindex $ender 11]
							set tense [lindex $ender 13]
							if {[regexp "semi-deponent" $hit]} {
								if {$tense eq "PERF"} {
									set voice "ACTIVE"
								}
							} elseif {[regexp "deponent" $hit]} {
								if {$tense ne "FUT"} {
									set voice "ACTIVE"
								}
							} else {
								set voice [lindex $ender 15]
							}
							lappend littlebit [list 1 "[partiform $case $number $gender \
								$tense $voice $mebstem$mebend $preword $postword]\n"]
						}
						NUM {
							# Numerals have case, number:
							set case [lindex $ender 7]
							set number [lindex $ender 9]
							if {$number eq "S"} {
								set number "sing"
							} else {
								set number "plur"
							}
							switch $case {
								NOM {lappend littlebit [list 1 "Nom $number\n"]}
								GEN {lappend littlebit [list 2 "Gen $number\n"]}
								DAT {lappend littlebit [list 3 "Dat $number\n"]}
								ACC {lappend littlebit [list 4 "Acc $number\n"]}
								ABL {lappend littlebit [list 5 "Abl $number\n"]}
							}
						}
						default {
							# Don't forget SUPINE!
						}
					}
				}
				
				if {[llength $littlebit] > 0} {
					set littlebit [lsort $littlebit]
					foreach bit $littlebit {
						append hit [lindex $bit end]
					}
				}
				lappend hitlist [list $freq $hit]
			}
		}
	}
	# Insert contents of sorted list of word/definition/part of speech combinations:
	set hitlist [lsort $hitlist]
	if {[llength $hitlist] < 1} {
		set wordin 0
	} else {
		set wordin 1
		foreach hit $hitlist {
			set oldend [.glo index "end -1 c"]
			# Hack out frequency codes, no longer needed;
			# Insert term, definition, options, colored tags:
			.glo insert "end - 1 c" [lindex $hit end]
			set colo [.glo search ":" $oldend "$oldend lineend"]
			.glo tag add term $oldend "$colo + 1 c"
			.glo tag add termtype term.last "$oldend lineend + 1 c"
			.glo tag add definition termtype.last "termtype.last lineend + 1 c"
		}
	}
	.glo see end
}

# Procedure to conquer complex grammar of verbs:

proc verbform {person number voice tense mood} {
	if {$voice eq "ACTIVE"} {
		switch "$tense $mood" {
			"PRES INF" {
				return "Active present infinitive\
				(\"to \[verb\]\")"
			}
			"PERF INF" {
				return "Active perfect infinitive\
				(\"to have \[verb\]ed\")"
			}
			"PRES IND" {
				set tensemood "present indicative"
				switch "$person $number" {
					"1 S" {
						return "1P sing active, $tensemood\
						(\"I \[verb\]\")"
					}
					"2 S" {
						return "2P sing active, $tensemood\
						(\"you \[verb\]\")"
					}
					"3 S" {
						return "3P sing active, $tensemood\
						(\"he/she/it \[verb\]s\")"
					}
					"1 P" {
						return "1P plur active, $tensemood\
						(\"we \[verb\]\")"
					}
					"2 P" {
						return "2P plur active, $tensemood\
						(\"you (pl.) \[verb\]\")"
					}
					"3 P" {
						return "3P plur active, $tensemood\
						(\"they \[verb\]\")"
					}
				}
			}
			"IMPF IND" {
				set tensemood "imperfect indicative"
				switch "$person $number" {
					"1 S" {
						return "1P sing active, $tensemood\
						(\"I was \[verb\]ing\")"
					}
					"2 S" {
						return "2P sing active, $tensemood\
						(\"you were \[verb\]ing\")"
					}
					"3 S" {
						return "3P sing active, $tensemood\
						(\"he/she/it was \[verb\]ing\")"
					}
					"1 P" {
						return "1P plur active, $tensemood\
						(\"we were \[verb\]ing\")"
					}
					"2 P" {
						return "2P plur active, $tensemood\
						(\"you (pl.) were \[verb\]ing\")"
					}
					"3 P" {
						return "3P plur active, $tensemood\
						(\"they were \[verb\]ing\")"
					}
				}
			}
			"FUT IND" {
				set tensemood "future indicative"
				switch "$person $number" {
					"1 S" {
						return "1P sing active, $tensemood\
						(\"I will \[verb\]\")"
					}
					"2 S" {
						return "2P sing active, $tensemood\
						(\"you will \[verb\]\")"
					}
					"3 S" {
						return "3P sing active, $tensemood\
						(\"he/she/it will \[verb\]\")"
					}
					"1 P" {
						return "1P plur active, $tensemood\
						(\"we will \[verb\]\")"
					}
					"2 P" {
						return "2P plur active, $tensemood\
						(\"you (pl.) will \[verb\]\")"
					}
					"3 P" {
						return "3P plur active, $tensemood\
						(\"they will \[verb\]\")"
					}
				}
			}
			"PERF IND" {
				set tensemood "perfect indicative"
				switch "$person $number" {
					"1 S" {
						return "1P sing active, $tensemood\
						(\"I have \[verb\]ed\")"
					}
					"2 S" {
						return "2P sing active, $tensemood\
						(\"you have \[verb\]ed\")"
					}
					"3 S" {
						return "3P sing active, $tensemood\
						(\"he/she/it has \[verb\]ed\")"
					}
					"1 P" {
						return "1P plur active, $tensemood\
						(\"we have \[verb\]ed\")"
					}
					"2 P" {
						return "2P plur active, $tensemood\
						(\"you (pl.) have \[verb\]ed\")"
					}
					"3 P" {
						return "3P plur active, $tensemood\
						(\"they have \[verb\]ed\")"
					}
				}
			}
			"PLUP IND" {
				set tensemood "pluperfect indicative"
				switch "$person $number" {
					"1 S" {
						return "1P sing active, $tensemood\
						(\"I had \[verb\]ed\")"
					}
					"2 S" {
						return "2P sing active, $tensemood\
						(\"you had \[verb\]ed\")"
					}
					"3 S" {
						return "3P sing active, $tensemood\
						(\"he/she/it had \[verb\]ed\")"
					}
					"1 P" {
						return "1P plur active, $tensemood\
						(\"we had \[verb\]ed\")"
					}
					"2 P" {
						return "2P plur active, $tensemood\
						(\"you (pl.) had \[verb\]ed\")"
					}
					"3 P" {
						return "3P plur active, $tensemood\
						(\"they had \[verb\]ed\")"
					}
				}
			}
			"FUTP IND" {
				set tensemood "future perfect indicative"
				switch "$person $number" {
					"1 S" {
						return "1P sing active, $tensemood\
						(\"I will have \[verb\]ed\")"
					}
					"2 S" {
						return "2P sing active, $tensemood\
						(\"you will have \[verb\]ed\")"
					}
					"3 S" {
						return "3P sing active, $tensemood\
						(\"he/she/it will have \[verb\]ed\")"
					}
					"1 P" {
						return "1P plur active, $tensemood\
						(\"we will have \[verb\]ed\")"
					}
					"2 P" {
						return "2P plur active, $tensemood\
						(\"you (pl.) will have \[verb\]ed\")"
					}
					"3 P" {
						return "3P plur active, $tensemood\
						(\"they will have \[verb\]ed\")"
					}
				}
			}
			"PRES SUB" {
				set tensemood "present subjunctive"
				switch "$person $number" {
					"1 S" {
						return "1P sing active, $tensemood\
						(\"I should/would/may/might \[verb\]\")"
					}
					"2 S" {
						return "2P sing active, $tensemood\
						(\"you should/would/may/might \[verb\]\")"
					}
					"3 S" {
						return "3P sing active, $tensemood\
						(\"he/she/it should/would/may/might \[verb\]\")"
					}
					"1 P" {
						return "1P plur active, $tensemood\
						(\"we should/would/may/might \[verb\]\")"
					}
					"2 P" {
						return "2P plur active, $tensemood\
						(\"you (pl.) should/would/may/might \[verb\]\")"
					}
					"3 P" {
						return "3P plur active, $tensemood\
						(\"they should/would/may/might \[verb\]\")"
					}
				}
			}
			"IMPF SUB" {
				set tensemood "imperfect subjunctive"
				switch "$person $number" {
					"1 S" {
						return "1P sing active, $tensemood\
						(\"I should/would/may/might have been \[verb\]ing\")"
					}
					"2 S" {
						return "2P sing active, $tensemood\
						(\"you should/would/may/might have been \[verb\]ing\")"
					}
					"3 S" {
						return "3P sing active, $tensemood\
						(\"he/she/it should/would/may/might have been \[verb\]ing\")"
					}
					"1 P" {
						return "1P plur active, $tensemood\
						(\"we should/would/may/might have been \[verb\]ing\")"
					}
					"2 P" {
						return "2P plur active, $tensemood\
						(\"you (pl.) should/would/may/might have been \[verb\]ing\")"
					}
					"3 P" {
						return "3P plur active, $tensemood\
						(\"they should/would/may/might have been \[verb\]ing\")"
					}
				}
			}
			"PERF SUB" {
				set tensemood "perfect subjunctive"
				switch "$person $number" {
					"1 S" {
						return "1P sing active, $tensemood\
						(\"I should/would/may/might have \[verb\]ed\")"
					}
					"2 S" {
						return "2P sing active, $tensemood\
						(\"you should/would/may/might have \[verb\]ed\")"
					}
					"3 S" {
						return "3P sing active, $tensemood\
						(\"he/she/it should/would/may/might have \[verb\]ed\")"
					}
					"1 P" {
						return "1P plur active, $tensemood\
						(\"we should/would/may/might have \[verb\]ed\")"
					}
					"2 P" {
						return "2P plur active, $tensemood\
						(\"you (pl.) should/would/may/might have \[verb\]ed\")"
					}
					"3 P" {
						return "3P plur active, $tensemood\
						(\"they should/would/may/might have \[verb\]ed\")"
					}
				}
			}
			"PLUP SUB" {
				set tensemood "pluperfect subjunctive"
				switch "$person $number" {
					"1 S" {
						return "1P sing active, $tensemood\
						(\"\[if\] I had \[verb\]ed\")"
					}
					"2 S" {
						return "2P sing active, $tensemood\
						(\"\[if\] you had \[verb\]ed\")"
					}
					"3 S" {
						return "3P sing active, $tensemood\
						(\"\[if\] he/she/it had \[verb\]ed\")"
					}
					"1 P" {
						return "1P plur active, $tensemood\
						(\"\[if\] we had \[verb\]ed\")"
					}
					"2 P" {
						return "2P plur active, $tensemood\
						(\"\[if\] you (pl.) had \[verb\]ed\")"
					}
					"3 P" {
						return "3P plur active, $tensemood\
						(\"\[if\] they had \[verb\]ed\")"
					}
				}
			}
			"PRES IMP" {
				set tensemood "present imperative"
				switch "$person $number" {
					"2 S" {
						return "2P sing active, $tensemood\
						(\"you must now \[verb\]\")"
					}
					"2 P" {
						return "2P plur active, $tensemood\
						(\"you (pl.) must now \[verb\]\")"
					}
				}
			}
			"FUT IMP" {
				set tensemood "future imperative"
				switch "$person $number" {
					"2 S" {
						return "2P sing active, $tensemood\
						(\"you must \[verb\] in future\")"
					}
					"2 P" {
						return "2P plur active, $tensemood\
						(\"you (pl.) must \[verb\] in future\")"
					}
					"3 S" {
						return "3P sing active, $tensemood\
						(\"he/she/it must \[verb\] in future\")"
					}
					"3 P" {
						return "3P plur active, $tensemood\
						(\"they must \[verb\] in future\")"
					}
				}
			}
			default {
				return "Grammar unknown--please report defect to software author"
			}
		}
	} else {
		switch "$tense $mood" {
			"PRES INF" {
				return "Passive present	infinitive\
				(\"to be \[verb\]ed\")"
			}
			"PERF INF" {
				return "Passive perfect infinitive\
				(\"to have been \[verb\]ed\")"
			}
			"PRES IND" {
				set tensemood "present indicative"
				switch "$person $number" {
					"1 S" {
						return "1P sing passive, $tensemood\
						(\"I am \[verb\]ed\")"
					}
					"2 S" {
						return "2P sing passive, $tensemood\
						(\"you are \[verb\]ed\")"
					}
					"3 S" {
						return "3P sing passive, $tensemood\
						(\"he/she/it is \[verb\]ed\")"
					}
					"1 P" {
						return "1P plur passive, $tensemood\
						(\"we are \[verb\]ed\")"
					}
					"2 P" {
						return "2P plur passive, $tensemood\
						(\"you (pl.) are \[verb\]ed\"")
					}
					"3 P" {
						return "3P plur passive, $tensemood\
						(\"they are \[verb\]ed\"")
					}
				}
			}
			"FUT IND" {
				set tensemood "future indicative"
				switch "$person $number" {
					"1 S" {
						return "1P sing passive, $tensemood\
						(\"I will be \[verb\]ed\")"
					}
					"2 S" {
						return "2P sing passive, $tensemood\
						(\"you will be \[verb\]ed\")"
					}
					"3 S" {
						return "3P sing passive, $tensemood\
						(\"he/she/it will be \[verb\]ed\")"
					}
					"1 P" {
						return "1P plur passive, $tensemood\
						(\"we will be \[verb\]ed\")"
					}
					"2 P" {
						return "2P plur passive, $tensemood\
						(\"you (pl.) will be \[verb\]ed\")"
					}
					"3 P" {
						return "3P plur passive, $tensemood\
						(\"they will be \[verb\]ed\")"
					}
				}
			}
			"IMPF IND" {
				set tensemood "imperfect indicative"
				switch "$person $number" {
					"1 S" {
						return "1P sing passive, $tensemood\
						(\"I was being \[verb\]ed\")"
					}
					"2 S" {
						return "2P sing passive, $tensemood\
						(\"you were being \[verb\]ed\")"
					}
					"3 S" {
						return "3P sing passive, $tensemood\
						(\"he/she/it was being \[verb\]ed\")"
					}
					"1 P" {
						return "1P plur passive, $tensemood\
						(\"we were being \[verb\]ed\")"
					}
					"2 P" {
						return "2P plur passive, $tensemood\
						(\"you (pl.) were being \[verb\]ed\")"
					}
					"3 P" {
						return "3P plur passive, $tensemood\
						(\"they were being \[verb\]ed\")"
					}
				}
			}
			"PERF IND" {
				set tensemood "perfect indicative"
				switch "$person $number" {
					"1 S" {
						return "1P sing passive, $tensemood\
						(\"I have been \[verb\]ed\")"
					}
					"2 S" {
						return "2P sing passive, $tensemood\
						(\"you have been \[verb\]ed\")"
					}
					"3 S" {
						return "3P sing passive, $tensemood\
						(\"he/she/it has been \[verb\]ed\")"
					}
					"1 P" {
						return "1P plur passive, $tensemood\
						(\"we have been \[verb\]ed\")"
					}
					"2 P" {
						return "2P plur passive, $tensemood\
						(\"you (pl.) have been \[verb\]ed\")"
					}
					"3 P" {
						return "3P plur passive, $tensemood\
						(\"they have been \[verb\]ed\")"
					}
				}
			}
			"FUTP IND" {
				set tensemood "future perfect"
				switch "$person $number" {
					"1 S" {
						return "1P sing passive, $tensemood\
						(\"I will have been \[verb\]ed\")"
					}
					"2 S" {
						return "2P sing passive, $tensemood\
						(\"you will have been \[verb\]ed\")"
					}
					"3 S" {
						return "3P sing passive, $tensemood\
						(\"he/she/it will have been \[verb\]ed\")"
					}
					"1 P" {
						return "1P plur passive, $tensemood\
						(\"we will have been \[verb\]ed\")"
					}
					"2 P" {
						return "2P plur passive, $tensemood\
						(\"you (pl.) will have been \[verb\]ed\")"
					}
					"3 P" {
						return "3P plur passive, $tensemood\
						(\"they will have been \[verb\]ed\")"
					}
				}
			}
			"PLUP IND" {
				set tensemood "pluperfect"
				switch "$person $number" {
					"1 S" {
						return "1P sing passive, $tensemood\
						(\"I had been \[verb\]ed\")"
					}
					"2 S" {
						return "2P sing passive, $tensemood\
						(\"you had been \[verb\]ed\")"
					}
					"3 S" {
						return "3P sing passive, $tensemood\
						(\"he/she/it had been \[verb\]ed\")"
					}
					"1 P" {
						return "1P plur passive, $tensemood\
						(\"we had been \[verb\]ed\")"
					}
					"2 P" {
						return "2P plur passive, $tensemood\
						(\"you (pl.) had been \[verb\]ed\")"
					}
					"3 P" {
						return "3P plur passive, $tensemood\
						(\"they had been \[verb\]ed\")"
					}
				}
			}
			"PRES SUB" {
				set tensemood "present subjunctive"
				switch "$person $number" {
					"1 S" {
						return "1P sing passive, $tensemood\
						(\"I should/would/may/might be \[verb\]ed\")"
					}
					"2 S" {
						return "2P sing passive, $tensemood\
						(\"you should/would/may/might be \[verb\]ed\")"
					}
					"3 S" {
						return "3P sing passive, $tensemood\
						(\"he/she/it should/would/may/might be\[verb\]ed\")"
					}
					"1 P" {
						return "1P plur passive, $tensemood\
						(\"we should/would/may/might be \[verb\]ed\")"
					}
					"2 P" {
						return "2P plur passive, $tensemood\
						(\"you (pl.) should/would/may/might be \[verb\]ed\")"
					}
					"3 P" {
						return "3P plur passive, $tensemood\
						(\"they should/would/may/might be \[verb\]ed\")"
					}
				}
			}
			"IMPF SUB" {
				set tensemood "imperfect subjunctive"
				switch "$person $number" {
					"1 S" {
						return "1P sing passive, $tensemood\
						(\"I should/would/may/might have been \[verb\]ed\")"
					}
					"2 S" {
						return "2P sing passive, $tensemood\
						(\"you should/would/may/might have been \[verb\]ed\")"
					}
					"3 S" {
						return "3P sing passive, $tensemood\
						(\"he/she/it should/would/may/might have been \[verb\]ed\")"
					}
					"1 P" {
						return "1P plur passive, $tensemood\
						(\"we should/would/may/might have been \[verb\]ing\")"
					}
					"2 P" {
						return "2P plur passive, $tensemood\
						(\"you (pl.) should/would/may/might have been \[verb\]ing\")"
					}
					"3 P" {
						return "3P plur passive, $tensemood\
						(\"they should/would/may/might have been \[verb\]ing\")"
					}
				}
			}
			"PRES IMP" {
				set tensemood "present imperative"
				switch "$person $number" {
					"2 S" {
						return "2P sing passive, $tensemood\
						(\"you must now be \[verb\]ed\")"
					}
					"2 P" {
						return "2P plur passive, $tensemood\
						(\"you (pl.) must now be \[verb\]ed\")"
					}
				}
			}
			"FUT IMP" {
				set tensemood "future imperative"
				switch "$person $number" {
					"2 S" {
						return "2P sing passive, $tensemood\
						(\"you must be \[verb\]ed in future\")"
					}
					"3 S" {
						return "3P sing passive, $tensemood\
						(\"he/she/it must be \[verb\]ed in future\")"
					}
					"3 P" {
						return "3P plur passive, $tensemood\
						(\"they must be \[verb\]ed in future\")"
					}
				}
			}
			default {
				tk_messageBox -message "Grammar unknown--please report defect\
					to software author" -type ok
			}
		}
	}
}

# Procedure to determine whether participle is
# preceded or followed by "sum" or some such verb:

proc sumo {word} {
	switch $word {
		sum -
		es -
		est -
		sumus -
		estis -
		sunt -
		eram -
		eras -
		erat -
		eramus -
		eratis -
		erant -
		ero - 
		eris -
		erit -
		erimus -
		eritis -
		erunt -
		fui -
		fuisti -
		fuit -
		fuimus -
		fuitis -
		fuerunt -
		fuere -
		fueram -
		fueras -
		fuerat -
		fueramus -
		fueratis -
		fuerant -
		sim -
		sis -
		sit -
		simus -
		sitis -
		sint -
		essem -
		esses -
		esset -
		essemus -
		essetis -
		essent -
		esse {
			return $word
		}
		default {
			return
		}
	}
}

# Procedure to conquer grammar of participles:

proc partiform {case number gender tense voice word preword postword} {
	if {$number eq "S"} {
		set number "sing"
	} else {
		set number "plur"
	}
	if {[regexp {M|F|N} $gender] < 1} {
		set gender ""
	}
	switch "$tense $voice" {
		"PRES ACTIVE" {
			switch $case {
				NOM {
					return "Nom $number $gender, present active: \"\[verb\]ing\""
				}
				GEN {
					return "Gen $number $gender, present active: \"\[verb\]ing\""
				}
				DAT {
					return "Dat $number $gender, present active: \"\[verb\]ing\""
				}
				ACC {
					return "Acc $number $gender, present active: \"\[verb\]ing\""
				}
				ABL {
					return "Abl $number $gender, present active: \"\[verb\]ing\""
				}
				default {
					return
				}
			}
		}
		"PERF PASSIVE" {
			switch $case {
				NOM {
					set wordplus [sumo $postword]
					if {$wordplus eq ""} {
						set wordplus [sumo $preword]
					}
					if {$wordplus eq ""} {
						return "Nom $number $gender, perfect passive"
					} else {
						switch $wordplus {
							sum {
								return "$word $wordplus: 1P sing $gender passive, perfect\
									indicative: \"I have been \[verb\]ed\"" 
							}
							es {
								return "$word $wordplus: 2P sing $gender passive, perfect\
									indicative: \"you have been \[verb\]ed\"" 
							}
							est {
								return "$word $wordplus: 3P sing $gender passive, perfect\
									indicative: \"he/she/it has been \[verb\]ed\"" 
							}
							sumus {
								return "$word $wordplus: 1P plur $gender passive, perfect\
									indicative: \"we have been \[verb\]ed\"" 
							}
							estis {
								return "$word $wordplus: 2P plur $gender passive, perfect\
									indicative: \"you have been \[verb\]ed\"" 
							}
							sunt {
								return "$word $wordplus: 3P plur $gender passive, perfect\
									indicative: \"they have been \[verb\]ed\""
							}
							eram {
								return "$word $wordplus: 1P sing $gender passive, pluperfect\
									indicative: \"I had been \[verb\]ed\"" 
							}
							eras {
								return "$word $wordplus: 2P sing $gender passive, pluperfect\
									indicative: \"you had been \[verb\]ed\"" 
							}
							erat {
								return "$word $wordplus: 3P sing $gender passive, pluperfect\
									indicative: \"he/she/it had been \[verb\]ed\"" 
							}
							eramus {
								return "$word $wordplus: 1P plur $gender passive, pluperfect\
									indicative: \"we had been \[verb\]ed\""
							}
							eratis {
								return "$word $wordplus: 2P plur $gender passive, pluperfect\
									indicative: \"you had been \[verb\]ed\"" 
							}
							erant {
								return "$word $wordplus: 3P plur $gender passive, pluperfect\
									indicative: \"they had been \[verb\]ed\""
							}
							ero {
								return "$word $wordplus: 1P sing $gender passive, future\
									perfect	indicative: \"I will have been \[verb\]ed\"" 
							}
							eris {
								return "$word $wordplus: 2P sing $gender passive, future\
									perfect	indicative: \"you will have been \[verb\]ed\"" 
							}
							erit {
								return "$word $wordplus: 3P sing $gender passive, future\
									perfect	indicative:\
									\"he/she/it will have been \[verb\]ed\"" 
							}
							erimus {
								return "$word $wordplus: 1P plur $gender passive, future\
									perfect	indicative: \"we will have been \[verb\]ed\""
							}
							eritis {
								return "$word $wordplus: 2P plur $gender passive, future\
									perfect	indicative: \"you will have been \[verb\]ed\"" 
							}
							erunt {
								return "$word $wordplus: 3P plur $gender passive, future\
									perfect	indicative: \"they will have been \[verb\]ed\""
							}
							sim {
								return "$word $wordplus: 1P sing $gender passive, perfect\
									subjunctive: \"I should/would/may/might (now)\
									have been \[verb\]ed\""
							}
							sis {
								return "$word $wordplus: 2P sing $gender passive, perfect\
									subjunctive: \"you should/would/may/might (now)\
									have been \[verb\]ed\""
							}
							sit {
								return "$word $wordplus: 3P sing $gender passive, perfect\
									subjunctive: \"he/she/it should/would/may/might (now)\
									have been \[verb\]ed\""
							}
							simus {
								return "$word $wordplus: 1P plur $gender passive, perfect\
									subjunctive: \"we should/would/may/might (now)\
									have been \[verb\]ed\""
							}
							sitis {
								return "$word $wordplus: 2P plur $gender passive, perfect\
									subjunctive: \"you should/would/may/might (now)\
									have been \[verb\]ed\""
							}
							sint {
								return "$word $wordplus: 3P plur $gender passive, perfect\
									subjunctive: \"he/she/it should/would/may/might (now)\
									have been \[verb\]ed\""
							}
							essem {
								return "$word $wordplus: 1P sing $gender passive, pluperfect\
									subjunctive: \"I should/would/may/might (then)\
									have been \[verb\]ed\""
							}
							esses {
								return "$word $wordplus: 2P sing $gender passive, pluperfect\
									subjunctive: \"you should/would/may/might (then)\
									have been \[verb\]ed\""
							}
							esset {
								return "$word $wordplus: 3P sing $gender passive, pluperfect\
									subjunctive: \"he/she/it should/would/may/might (then)\
									have been \[verb\]ed\""
							}
							essemus {
								return "$word $wordplus: 1P plur $gender passive, pluperfect\
									subjunctive: \"we should/would/may/might (then)\
									have been \[verb\]ed\""
							}
							essetis {
								return "$word $wordplus: 2P plur $gender passive, pluperfect\
									subjunctive: \"you should/would/may/might (then)\
									have been \[verb\]ed\""
							}
							essent {
								return "$word $wordplus: 3P plur $gender passive, pluperfect\
									subjunctive: \"they should/would/may/might (then)\
									have been \[verb\]ed\""
							}
							esse {
								return "$word $wordplus: $gender passive, perfect\
									infinitive" \"to have been \[verb\]ed\""
							}
							default {
								return
							}
						}
					}
				}
				GEN {
					return "Gen $number $gender, perfect passive: \"\[verb\]ed\""
				}
				DAT {
					return "Dat $number $gender, perfect passive: \"\[verb\]ed\""
				}
				ACC {
					return "Acc $number $gender, perfect passive: \"\[verb\]ed\""
				}
				ABL {
					return "Abl $number $gender, perfect passive: \"\[verb\]ed\""
				}
				default {
					return
				}
			}
		}
		"FUT ACTIVE" {
			switch $case {
				NOM {
					set wordplus [sumo $postword]
					if {$wordplus eq ""} {
						set wordplus [sumo $preword]
					}
					if {$wordplus eq ""} {
						return "Nom $number $gender, future active"
					} else {
						switch $wordplus {
							sum {
								return "$word $wordplus: 1P sing $gender active\
									periphrastic, present indicative:\
									\"I am going to \[verb\]\""
							}
							es {
								return "$word $wordplus: 2P sing $gender active\
									periphrastic, present indicative:\
									\"you are going to \[verb\]\""
							}
							est {
								return "$word $wordplus: 3P sing $gender active\
									periphrastic, present indicative:\
									\"he/she/it is going to \[verb\]\""
							}
							sumus {
								return "$word $wordplus: 1P plur $gender active\
									periphrastic, present indicative:\
									\"we are going to \[verb\]\""
							}
							estis {
								return "$word $wordplus: 2P plur $gender active\
									periphrastic, persent indicative:\
									\"you are going to \[verb\]\""
							}
							sunt {
								return "$word $wordplus: 3P plur $gender active\
									periphrastic, present indicative:\
									\"they are going to \[verb\]\""
							}
							eram {
								return "$word $wordplus: 1P sing $gender active\
									periphrastic, imperfect	indicative:\
									\"I was going to \[verb\]\""
							}
							eras {
								return "$word $wordplus: 2P sing $gender active\
									periphrastic, imperfect indicative:\
									\"you were going to \[verb\]\""
							}
							erat {
								return "$word $wordplus: 3P sing $gender active\
									periphrastic, imperfect	indicative:\
									\"he/she/it was going to \[verb\]\""
							}
							eramus {
								return "$word $wordplus: 1P plur $gender active\
									periphrastic, imperfect indicative:\
									\"we were going to \[verb\]\""
							}
							eratis {
								return "$word $wordplus: 2P plur $gender active\
									periphrastic, imperfect	indicative:\
									\"you were going to \[verb\]\""
							}
							erant {
								return "$word $wordplus: 3P plur $gender active\
									periphrastic, imperfect	indicative:\
									\"they were going to \[verb\]\""
							}
							fui {
								return "$word $wordplus: 1P sing $gender active\
									periphrastic, perfect	indicative:\
									\"I have been intending to \[verb\]\""
							}
							fuisti {
								return "$word $wordplus: 2P sing $gender active\
									periphrastic, perfect	indicative:\
									\"you have been intending to \[verb\]\""
							}
							fuit {
								return "$word $wordplus: 3P sing $gender active\
									periphrastic, perfect	indicative:\
									\"he/she/it has been intending to \[verb\]\""
							}
							fuimus {
								return "$word $wordplus: 1P plur $gender active\
									periphrastic, perfect	indicative:\
									\"we have been intending to \[verb\]\""
							}
							fuitis {
								return "$word $wordplus: 2P plur $gender active\
									periphrastic, perfect	indicative:\
									\"you have been intending to \[verb\]\""
							}
							fuerunt {
								return "$word $wordplus: 3P plur $gender active\
									periphrastic, perfect	indicative:\
									\"they have been intending to \[verb\]\""
							}
							fuere {
								return "$word $wordplus: 3P plur $gender active\
									periphrastic, perfect	indicative:\
									\"they have been intending to \[verb\]\""
							}
							fueram {
								return "$word $wordplus: 1P sing $gender active\
									periphrastic, pluperfect	indicative:\
									\"I had been intending to \[verb\]\""
							}
							fueras {
								return "$word $wordplus: 2P sing $gender active\
									periphrastic, perfect	indicative:\
									\"you had been intending to \[verb\]\""
							}
							fuerat {
								return "$word $wordplus: 3P sing $gender active\
									periphrastic, pluperfect	indicative:\
									\"he/she/it had been intending to \[verb\]\""
							}
							fueramus {
								return "$word $wordplus: 1P plur $gender active\
									periphrastic, pluperfect	indicative:\
									\"we had been intending to \[verb\]\""
							}
							fueratis {
								return "$word $wordplus: 2P plur $gender active\
									periphrastic, pluperfect	indicative:\
									\"you had been intending to \[verb\]\""
							}
							fuerant {
								return "$word $wordplus: 3P plur $gender active\
									periphrastic, pluperfect	indicative:\
									\"they had been intending to \[verb\]\""
							}
							sim {
								return "$word $wordplus: 1P sing $gender active\
									periphrastic, present subjunctive:\
									\"I should/would/may/might deserve/have\
									to be \[verb\]ed\""
							}
							sis {
								return "$word $wordplus: 2P sing $gender active\
									periphrastic, present subjunctive:\
									\"you should/would/may/might deserve/have\
									to be \[verb\]ed\""
							}
							sit {
								return "$word $wordplus: 3P sing $gender active\
									periphrastic, present subjunctive:\
									\"he/she/it should/would/may/might deserve/have\
									to be \[verb\]ed\""
							}
							simus {
								return "$word $wordplus: 1P plur $gender active\
									periphrastic, present subjunctive:\
									\"we should/would/may/might deserve/have\
									to be \[verb\]ed\""
							}
							sitis {
								return "$word $wordplus: 2P plur $gender active\
									periphrastic, present subjunctive:\
									\"you should/would/may/might deserve/have\
									to be \[verb\]ed\""
							}
							sint {
								return "$word $wordplus: 3P plur $gender active\
									periphrastic, present subjunctive:\
									\"they should/would/may/might deserve/have\
									to be \[verb\]ed\""
							}
							essem {
								return "$word $wordplus: 1P sing $gender active\
									periphrastic, perfect subjunctive:\
									\"I should/would/may/might have deserved/had\
									to be \[verb\]ed\""
							}
							esses {
								return "$word $wordplus: 2P sing $gender active\
									periphrastic, perfect subjunctive:\
									\"he/she/it should/would/may/might have deserved/had\
									to be \[verb\]ed\""
							}
							esset {
								return "$word $wordplus: 3P sing $gender active\
									periphrastic, perfect subjunctive:\
									\"he/she/it should/would/may/might have deserved/had\
									to be \[verb\]ed\""
							}
							essemus {
								return "$word $wordplus: 1P plur $gender active\
									periphrastic, perfect subjunctive:\
									\"we should/would/may/might have deserved/had\
									to be \[verb\]ed\""
							}
							essetis {
								return "$word $wordplus: 2P plur $gender active\
									periphrastic, perfect subjunctive:\
									\"you should/would/may/might have deserved/had\
									to be \[verb\]ed\""
							}
							essent {
								return "$word $wordplus: 3P plur $gender active\
									periphrastic, perfect subjunctive:\
									\"they should/would/may/might have deserved/had\
									to be \[verb\]ed\""
							}
							esse {
								return "$word $wordplus: $gender active infinitive:\
									\"to deserve/have to be \[verb\]ed\""
							}
							default {
								return
							}
						}
					}
				}
				GEN {
					return "Gen $number $gender, future active"
				}
				DAT {
					return "Dat $number $gender, future active"
				}
				ACC {
					return "Acc $number $gender, future active"
				}
				ABL {
					return "Abl $number $gender, future active"
				}
				default {
					return
				}
			}
		}
		"FUT PASSIVE" {
			switch $case {
				NOM {
					set wordplus [sumo $postword]
					if {$wordplus eq ""} {
						set wordplus [sumo $preword]
					}
					if {$wordplus eq ""} {
						return "Nom $number $gender, future passive"
					} else {
						switch $wordplus {
							sum {
								return "$word $wordplus: 1P sing $gender passive\
									periphrastic, present indicative:\
									\"I should/must be \[verb\]ed\"" 
							}
							es {
								return "$word $wordplus: 2P sing $gender passive\
									periphrastic, present indicative:\
									\"you should/must be \[verb\]ed\"" 
							}
							est {
								return "$word $wordplus: 3P sing $gender passive\
									periphrastic, present indicative:\
									\"he/she/it should/must be \[verb\]ed\"" 
							}
							sumus {
								return "$word $wordplus: 1P plur $gender passive\
									periphrastic, present indicative:\
									\"we should/must be \[verb\]ed\"" 
							}
							estis {
								return "$word $wordplus: 2P plur $gender passive\
									periphrastic, persent indicative:\
									\"you should/must be \[verb\]ed\"" 
							}
							sunt {
								return "$word $wordplus: 3P plur $gender passive\
									periphrastic, present indicative:\
									\"they should/must be \[verb\]ed\""
							}
							eram {
								return "$word $wordplus: 1P sing $gender passive\
									periphrastic, imperfect	indicative:\
									\"I should have been/had to be \[verb\]ed\"" 
							}
							eras {
								return "$word $wordplus: 2P sing $gender passive\
									periphrastic, imperfect indicative:\
									\"you should have been/had to be \[verb\]ed\"" 
							}
							erat {
								return "$word $wordplus: 3P sing $gender passive\
									periphrastic, imperfect	indicative:\
									\"he/she/it should have been/had to be \[verb\]ed\"" 
							}
							eramus {
								return "$word $wordplus: 1P plur $gender passive\
									periphrastic, imperfect indicative:\
									\"we should have been/had to be \[verb\]ed\""
							}
							eratis {
								return "$word $wordplus: 2P plur $gender passive\
									periphrastic, imperfect	indicative:\
									\"you should have been/had to be \[verb\]ed\"" 
							}
							erant {
								return "$word $wordplus: 3P plur $gender passive\
									periphrastic, imperfect	indicative:\
									\"they should have been/had to be \[verb\]ed\""
							}
							ero {
								return "$word $wordplus: 1P sing $gender passive\
									periphrastic, future	indicative:\
									\"I will deserve/have to be \[verb\]ed\"" 
							}
							eris {
								return "$word $wordplus: 2P sing $gender passive\
									periphrastic, future indicative:\
									\"you will deserve/have to be \[verb\]ed\"" 
							}
							erit {
								return "$word $wordplus: 3P sing $gender passive\
									periphrastic, future	indicative:\
									\"he/she/it will deserve/have to be \[verb\]ed\"" 
							}
							erimus {
								return "$word $wordplus: 1P plur $gender passive\
									periphrastic, future indicative:\
									\"we will deserve/have to be \[verb\]ed\""
							}
							eritis {
								return "$word $wordplus: 2P plur $gender passive\
									periphrastic, future	indicative:\
									\"you will deserve/have to be \[verb\]ed\"" 
							}
							erunt {
								return "$word $wordplus: 3P plur $gender passive\
									periphrastic, future	indicative:\
									\"they will deserve/have to be \[verb\]ed\""
							}
							sim {
								return "$word $wordplus: 1P sing $gender passive\
									periphrastic, present subjunctive:\
									\"I should/would/may/might deserve/have\
									to be \[verb\]ed\""
							}
							sis {
								return "$word $wordplus: 2P sing $gender passive\
									periphrastic, present subjunctive:\
									\"you should/would/may/might deserve/have\
									to be \[verb\]ed\""
							}
							sit {
								return "$word $wordplus: 3P sing $gender passive\
									periphrastic, present subjunctive:\
									\"he/she/it should/would/may/might deserve/have\
									to be \[verb\]ed\""
							}
							simus {
								return "$word $wordplus: 1P plur $gender passive\
									periphrastic, present subjunctive:\
									\"we should/would/may/might deserve/have\
									to be \[verb\]ed\""
							}
							sitis {
								return "$word $wordplus: 2P plur $gender passive\
									periphrastic, present subjunctive:\
									\"you should/would/may/might deserve/have\
									to be \[verb\]ed\""
							}
							sint {
								return "$word $wordplus: 3P plur $gender passive\
									periphrastic, present subjunctive:\
									\"they should/would/may/might deserve/have\
									to be \[verb\]ed\""
							}
							essem {
								return "$word $wordplus: 1P sing $gender passive\
									periphrastic, perfect subjunctive:\
									\"I should/would/may/might have deserved/had\
									to be \[verb\]ed\""
							}
							esses {
								return "$word $wordplus: 2P sing $gender passive\
									periphrastic, perfect subjunctive:\
									\"he/she/it should/would/may/might have deserved/had\
									to be \[verb\]ed\""
							}
							esset {
								return "$word $wordplus: 3P sing $gender passive\
									periphrastic, perfect subjunctive:\
									\"he/she/it should/would/may/might have deserved/had\
									to be \[verb\]ed\""
							}
							essemus {
								return "$word $wordplus: 1P plur $gender passive\
									periphrastic, perfect subjunctive:\
									\"we should/would/may/might have deserved/had\
									to be \[verb\]ed\""
							}
							essetis {
								return "$word $wordplus: 2P plur $gender passive\
									periphrastic, perfect subjunctive:\
									\"you should/would/may/might have deserved/had\
									to be \[verb\]ed\""
							}
							essent {
								return "$word $wordplus: 3P plur $gender passive\
									periphrastic, perfect subjunctive:\
									\"they should/would/may/might have deserved/had\
									to be \[verb\]ed\""
							}
							esse {
								return "$word $wordplus: $gender passive infinitive:\
									\"to deserve/have to be \[verb\]ed\""
							}
							default {
								return
							}
						}
					}
				}
				GEN {
					return "Gen $number $gender, future passive"
				}
				DAT {
					return "Dat $number $gender, future passive"
				}
				ACC {
					return "Acc $number $gender, future passive"
				}
				ABL {
					return "Abl $number $gender, future passive"
				}
				default {
					return
				}
			}
		}
		"PERF ACTIVE" {
			# Deponent and semi-deponent verbs only
			switch $case {
				NOM {
					set wordplus [sumo $postword]
					if {$wordplus eq ""} {
						set wordplus [sumo $preword]
					}
					if {$wordplus eq ""} {
						return "Nom $number $gender, perfect active"
					} else {
						switch $wordplus {
							sum {
								return "$word $wordplus: 1P sing $gender active, perfect\
									indicative: \"I have \[verb\]ed\"" 
							}
							es {
								return "$word $wordplus: 2P sing $gender active, perfect\
									indicative: \"you have \[verb\]ed\"" 
							}
							est {
								return "$word $wordplus: 3P sing $gender active, perfect\
									indicative: \"he/she/it has \[verb\]ed\"" 
							}
							sumus {
								return "$word $wordplus: 1P plur $gender active, perfect\
									indicative: \"we have \[verb\]ed\"" 
							}
							estis {
								return "$word $wordplus: 2P plur $gender active, perfect\
									indicative: \"you have \[verb\]ed\"" 
							}
							sunt {
								return "$word $wordplus: 3P plur $gender active, perfect\
									indicative: \"they have \[verb\]ed\""
							}
							eram {
								return "$word $wordplus: 1P sing $gender active, pluperfect\
									indicative: \"I had \[verb\]ed\"" 
							}
							eras {
								return "$word $wordplus: 2P sing $gender active, pluperfect\
									indicative: \"you had \[verb\]ed\"" 
							}
							erat {
								return "$word $wordplus: 3P sing $gender active, pluperfect\
									indicative: \"he/she/it had \[verb\]ed\"" 
							}
							eramus {
								return "$word $wordplus: 1P plur $gender active, pluperfect\
									indicative: \"we had \[verb\]ed\""
							}
							eratis {
								return "$word $wordplus: 2P plur $gender active, pluperfect\
									indicative: \"you had \[verb\]ed\"" 
							}
							erant {
								return "$word $wordplus: 3P plur $gender active, pluperfect\
									indicative: \"they had \[verb\]ed\""
							}
							ero {
								return "$word $wordplus: 1P sing $gender active, future\
									perfect	indicative: \"I will have \[verb\]ed\"" 
							}
							eris {
								return "$word $wordplus: 2P sing $gender active, future\
									perfect	indicative: \"you will have \[verb\]ed\"" 
							}
							erit {
								return "$word $wordplus: 3P sing $gender active, future\
									perfect	indicative:\
									\"he/she/it will have \[verb\]ed\"" 
							}
							erimus {
								return "$word $wordplus: 1P plur $gender active, future\
									perfect	indicative: \"we will have \[verb\]ed\""
							}
							eritis {
								return "$word $wordplus: 2P plur $gender active, future\
									perfect	indicative: \"you will have \[verb\]ed\"" 
							}
							erunt {
								return "$word $wordplus: 3P plur $gender active, future\
									perfect	indicative: \"they will have \[verb\]ed\""
							}
							sim {
								return "$word $wordplus: 1P sing $gender active, perfect\
									subjunctive: \"I should/would/may/might (now)\
									have \[verb\]ed\""
							}
							sis {
								return "$word $wordplus: 2P sing $gender active, perfect\
									subjunctive: \"you should/would/may/might (now)\
									have \[verb\]ed\""
							}
							sit {
								return "$word $wordplus: 3P sing $gender active, perfect\
									subjunctive: \"he/she/it should/would/may/might (now)\
									have \[verb\]ed\""
							}
							simus {
								return "$word $wordplus: 1P plur $gender active, perfect\
									subjunctive: \"we should/would/may/might (now)\
									have \[verb\]ed\""
							}
							sitis {
								return "$word $wordplus: 2P plur $gender active, perfect\
									subjunctive: \"you should/would/may/might (now)\
									have \[verb\]ed\""
							}
							sint {
								return "$word $wordplus: 3P plur $gender active, perfect\
									subjunctive: \"he/she/it should/would/may/might (now)\
									have \[verb\]ed\""
							}
							essem {
								return "$word $wordplus: 1P sing $gender active, pluperfect\
									subjunctive: \"I should/would/may/might (then)\
									have \[verb\]ed\""
							}
							esses {
								return "$word $wordplus: 2P sing $gender active, pluperfect\
									subjunctive: \"you should/would/may/might (then)\
									have \[verb\]ed\""
							}
							esset {
								return "$word $wordplus: 3P sing $gender active, pluperfect\
									subjunctive: \"he/she/it should/would/may/might (then)\
									have \[verb\]ed\""
							}
							essemus {
								return "$word $wordplus: 1P plur $gender active, pluperfect\
									subjunctive: \"we should/would/may/might (then)\
									have \[verb\]ed\""
							}
							essetis {
								return "$word $wordplus: 2P plur $gender active, pluperfect\
									subjunctive: \"you should/would/may/might (then)\
									have \[verb\]ed\""
							}
							essent {
								return "$word $wordplus: 3P plur $gender active, pluperfect\
									subjunctive: \"they should/would/may/might (then)\
									have \[verb\]ed\""
							}
							esse {
								return "$word $wordplus: $gender active, perfect\
									infinitive" \"to have \[verb\]ed\""
							}
							default {
								return
							}
						}
					}
				}
				GEN {
					return "Gen $number $gender, perfect active: \"\[verb\]ed\""
				}
				DAT {
					return "Dat $number $gender, perfect active: \"\[verb\]ed\""
				}
				ACC {
					return "Acc $number $gender, perfect active: \"\[verb\]ed\""
				}
				ABL {
					return "Abl $number $gender, perfect active: \"\[verb\]ed\""
				}
				default {
					return
				}
			}
		}
		default {
			tk_messageBox -message "Grammar unknown--please report defect\
				to software author" -type ok
		}
	}
}

# 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
}

### GET GOING ###

splashup
grip_dictline [file join $libdir DICTLINE.GEN]

