#!/bin/sh
#-*- mode: Tcl;time-stamp-start:"TimeStamp[ 	]+\\\\?[\"<]+";-*-
# the next line restarts using wish \
exec wish $0 -- $@
set TimeStamp "2006-01-15 14:48:31 poser"
#
# Copyright (C) 2003-2006 William J. Poser (billposer@alum.mit.edu)
# This program is free software; you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
# the Free Software Foundation; either version 2 of the License, or
# (at your option) any later version.
#
# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
# GNU General Public License for more details.
#
# A copy of the GNU General Public License is contained in the
# procedure "License" in this file.
# If it is not, write to the Free Software
# Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
# or go to the web page:  http://www.gnu.org/licenses/gpl.txt.

set Version "8.4";
encoding system utf-8
set DebugP 0;				# General debugging?
set FeatureTestDebugP 0;		# Debug program feature tests?
package require Iwidgets
package require msgcat
proc _ {s} {return [::msgcat::mc $s]};	# Define shorthand for gettext
proc ProgramTimeDateStamp {} {
    set sts [split $::TimeStamp]
    return "[lindex $sts 0] [lindex $sts 1]"
}


# Set UseDiffP to zero to prevent testing for the presence of diff.
# which on some systems causes problems. The only consequence
# will be the unavailability of the popup showing the differences between
# actual output and comparison data.
set UseDiffP 1;

#If you are running this under MS Windows without using cygwin and
#wish, the Tcl/Tk windowing shell, will not work properly, try using tclsh.exe
#as the Tcl interpreter and uncomment the following line to import Tk.
#package require Tk

#For debugging messages
proc dmsg {msg} {
    if {$::DebugP} {
	puts $msg;
	flush stdout;
    }
}

proc TraceGlobalArrayEntry {n m o} {
    set val [set ::${n}($m)]
    puts [format "%s(%s) <- %s" $n $m $val]
}
#trace add variable ColorSpecs(Messages,Background) write TraceGlobalArrayEntry

set InitFile     ".redetrc";
set HistoryFile  ".redethist";
set JournalFile  ".redetlog";
set ColorFile    ".redetcolors";
set NonBinPath [file join /usr share doc redet-doc];

#Portability
#Figure out what system we are running on
if {[string equal $tcl_platform(platform) windows]} {
    set System MSWindows;
    dmsg "Running under MS Windows";
} elseif {[string equal $tcl_platform(platform) unix]} {
    if {[string equal $tcl_platform(os) Darwin]} {
	set System MacOSX;
	dmsg "Running under Mac OS X";
    } else {
	set System Unix;
	dmsg "Running under Unix";
    }
}

#Find out what our base graphics system is
if {[string match X11*  [winfo server .]]} {
    set AquaP 0
    set WindowSystem X11
} else {
    if {[string match $System MSWindows]} {
	set AquaP 0;
	set WindowSystem MSWindows;
    }
    if {[string match $System MacOSX]} {
	set AquaP 1
	set WindowSystem Aqua
    }
}

switch $System {
    Unix {
	event add <<B3>> <ButtonPress-3>
	event add <<B3Release>> <ButtonRelease-3>
    }
    MacOSX {
	event add <<B3>> <Control-ButtonPress-1>
	event add <<B3Release>> <Control-ButtonRelease-1>
    }
    MSWindows {
	event add <<B3>> <ButtonPress-3>
	event add <<B3Release>> <ButtonRelease-3>
	set InitFile "RedetInit";
	set HistoryFile "RedetHistory";
	set JournalFile "RedetLog";
	set ColorFile "RedetColors";
	set NonBinPath [file dirname [info script]];
	set ::env(CYGWIN) "";
    }
}

#We need to use different menu entry numbers in Aqua
#because unlike the other Tk implementations, Aqua has no tearoffs.
#In non-Aqua Tk the tearoff counts as entry 0 when it is present.

proc mdo {elnum} {
    if {$::AquaP} {
	return [expr $elnum -1]
    } else {
	return $elnum
    }
}

if {[info exists ::env(TMP)]} {
    set TempDir $::env(TMP);
} elseif {[info exists ::env(TEMP)]} {
    set TempDir $::env(TEMP);
} else {
    if { $tcl_platform(platform) == "windows"} {
	set TempDir "C:\tmp";
    } else {
	set TempDir "/tmp";
    }
}

# Find out whether we have GNU diff
if {$UseDiffP} {
    set GNUDiffP 0;
    if { [string length [auto_execok diff]]  != 0 } {
	if {[regexp "GNU diffutils" [lindex [split [exec diff -v] '\n'] 0]]}  {
	    set GNUDiffP 1;
	}
    }
}


#These aliases for the various widgets facilitate making changes in the
#widget hierarchy.
set REG .rsf.re;
set SUB .rsf.sub;
set COM .dwf.comp;
set IND .dwf.in;
set OUT .dwf.out;
set INDSB .dwf.indsbar;
set OUTSB .dwf.outsbar;
set COMSB .dwf.comsbar;

#Limits
set ShellItemLimit 500
				
#Parameters
set MainWidth 65;
set MainHeight 10;
set PopupLines 15;
set LocaleListHeight 15;		# Number of lines to display.
set MaxPaletteHeight 15;		# Number of lines to display.
set HPWidth 60;				# Width of help popups.
set HPLines 10;				# Number of lines for help popups.

set DefaultBrowser dillo
#For this purpose dillo is in many respects arguably the best choice because
#it is very lightweight and starts up fast. However, it isn't as fully
#featured as the others, and in particular, doesn't handle the full range of
#Unicode characters.
#To select a different default browser - uncomment (delete the initial #-sign from) one of the
#following lines:
#set DefaultBrowser firefox
#set DefaultBrowser epiphany;
#set DefaultBrowser galeon;
#set DefaultBrowser konqueror;
#set DefaultBrowser mozilla;
#set DefaultBrowser netscape;
#set DefaultBrowser opera;
set BrowserList [list firefox mozilla epiphany galeon konqueror dillo netscape opera]
set BrowserPIDS [list];
#Defaults

set CommandLineProgram "";
set BeginInSubstitutionModeP 0;
set DefaultProgram "tcl";
#set DefaultProgram "egrep";
set Program ""; #Capitalized version.
set program $DefaultProgram; #Lower-case version. 
#This is just for documentation. We actually set this just after reading
#the init file. We need to record the initial program so that we have
#something to default to if the user aborts a feature test.
set InitialProgram $DefaultProgram;
set FirstTestP 1;

set ButtonName "";

set LeftImplicitStar  "*";
set RightImplicitStar "*";

set ColorSpecs(AlertDismiss,Background)	"\#2200FF";
set ColorSpecs(AlertDismiss,Foreground)	"\#FFCC00";
set ColorSpecs(Alert,Background)		"\#c36176";
set ColorSpecs(Alert,Foreground)		"\#FFFFFF";
set ColorSpecs(Default,Background) \#FFD8B1
set ColorSpecs(IPAEntry,Background)		"\#FFFFFF";
set ColorSpecs(IPAEntry,Foreground)		"\#000000";
set ColorSpecs(IPAHeadings,Background)		"\#09ffb2";
set ColorSpecs(Match,Background)		white
set ColorSpecs(Menu,ActiveBackground)	        NavajoWhite
set ColorSpecs(Menu,ActiveForeground)	        black
set ColorSpecs(Menu,Background)			"\#FFC192"
set ColorSpecs(Menu,Foreground)			black
set ColorSpecs(Menu,Select)			blue
set ColorSpecs(Menubar,Background)	 	"\#c36176";
set ColorSpecs(Menubar,Foreground)		"\#fee4a9";
set ColorSpecs(Menubar,ActiveBackground)	"\#fee4a9";
set ColorSpecs(Menubar,ActiveForeground)	"\#c36176";
set ColorSpecs(Messages,Background) 		"\#e9c4dc";
set ColorSpecs(Messages,Foreground) 		"\#000000";
set ColorSpecs(PopupWidgetDefault,Background)    "\#fee4a9";
set ColorSpecs(PopupWidgetDefault,Foreground)    black
set ColorSpecs(PopupWidgetButton,Background)    "\#FBAA9A"
set ColorSpecs(PopupWidgetButton,Foreground)    black
set ColorSpecs(PopupWidgetCheckbutton,Foreground)    black
set ColorSpecs(PopupWidgetEntry,Background)    "\#BBBBFF"
set ColorSpecs(PopupWidgetEntry,Foreground)    black
set ColorSpecs(PopupWidgetLabel,Background)    "\#FEE4A9";
set ColorSpecs(PopupWidgetLabel,Foreground)    black
set ColorSpecs(ProgramInfoPopup,Background)    "\#B5E1FF"
set ColorSpecs(ProgramInfoPopup,Foreground)    black;
#set ColorSpecs(ProgramSpecificControls,Background)	"\#FFBD9A"
set ColorSpecs(ProgramSpecificControls,Background)	grey
set ColorSpecs(ProgramSpecificControls,Foreground)	black;
set ColorSpecs(ProgramSpecificControls,ActiveBackground)	blue;
set ColorSpecs(ProgramSpecificControls,ActiveForeground)	yellow;
set ColorSpecs(ProgramSpecificControls,Select)	green;
set ColorSpecs(ProgramSpecificControls,EntryBackground)	white
set ColorSpecs(ProgramSpecificControls,EntryForeground)	black
set ColorSpecs(ProgramSpecificControls,DisabledEntryBackground)	coral;
set ColorSpecs(Regexp,Background)		"\#08ffb1";
set ColorSpecs(Regexp,Foreground)		"\#0c1816";
set ColorSpecs(Subexp,Background) 		"\#FFFFFF";
set ColorSpecs(Subexp,Foreground) 		"\#000000";
set ColorSpecs(TestData,Background) 		"\#e9c4dc";
set ColorSpecs(TestData,Foreground) 		"\#000000";
set ColorSpecs(Results,Background) 		"\#e6b483";
set ColorSpecs(Results,Foreground) 		"\#000000";
set ColorSpecs(ComparisonData,Background)		"\#a3d6a1";
set ColorSpecs(ComparisonData,Foreground)		"\#0c1816";
set ColorSpecs(PaletteGloss,Background)		"\#B5B5D9";
set ColorSpecs(PaletteGloss,Foreground)		"\#0c1816";
set ColorSpecs(PaletteNotation,Background)		"\#B5B5D9";
set ColorSpecs(PaletteNotation,Foreground)		"\#0c1816";
set ColorSpecs(PaletteScrollbarSlider,Highlight) salmon;
set ColorSpecs(PaletteSelectionGloss)     NavajoWhite
set ColorSpecs(PaletteSelectionRegexp)    NavajoWhite
set ColorSpecs(PaletteHighlight,Background)    	"\#E23A6C"
set ColorSpecs(PaletteHighlight,Foreground)    	yellow
set ColorSpecs(Palette,Variable) 	 "\#A4E9FF";
set ColorSpecs(Palette,Fixed)    	 wheat
set ColorSpecs(TextDisplay,Background) NavajoWhite
#set ColorSpecs(TextDisplay,Background) "\#E6EAF6"
set ColorSpecs(TextDisplay,Foreground) "\#000000"
set ColorSpecs(UserTextEntry,Background)	"\#FFFFFF";
set ColorSpecs(UserTextEntry,Foreground)	black
set ColorSpecs(ColorConfiguration,Background)	"\#B5B5D9";
set ColorSpecs(ColorConfiguration,Foreground)		"\#0c1816";
set ColorSpecs(HistoryList,Background)		"\#B5B5D9";
set ColorSpecs(HistoryList,Foreground)		"\#0c1816";
set ColorSpecs(Placard,Background)	"\#eeac99";
set ColorSpecs(Placard,Foreground)	"\#100e39";
set ColorSpecs(UserClassPalette,Background)	\#F5E8FF;
set ColorSpecs(UserClassPalette,Foreground)	black;
set ColorSpecs(UserPaletteEntry,Background)	"\#F88E1A"

#Initializations

set UseScrollbarsP 1;
set ExecutionFlag Normal;		# This is used to forestall actual execution
					# when saving the command line etc.
set UpdateJavaByteCodeP 1;
set AutoClearRegexpP 0;
set StandardConfigurationP 1;
set UserClassesEnabledP 1;
set DoSubstitutionsP 0;
set OutputOnlyChangedLinesP 1;
set SideBySideLayoutP 0;
set RegSubSideBySideP 0;
set FeatureTestP 1;
set ComparisonDataFromWindowP 0;
set ComparisonWindowDisplayedP 0;
set InputDataFromWindowP 0;
set OutputFromWindowP 0;
set IPAAIsDisplayedP 0;
set IPACIsDisplayedP 0;
set IPAVIsDisplayedP 0;
set IPADIsDisplayedP 0;
set CharEntryByCodeIsDisplayedP 0;
set PaletteIsDisplayedP 0;
set PaletteToBeDisplayedP 0;
set PaletteFeatures 0;
set PipeP 0;
set BalloonHelpP 1;
set ReadHistoryFileP 1;
set ReadInitFileP 1;
set FocusFollowsMouseP 0;
set InitialTestInputDataFile "";
set TestingFeaturesP 0;
set SortUnicodeRangesByCodepointP 0;
set ShowActualRegexpP 0;
set PreviousActualRegexp "";
set CharentryMenuItems 6;
set AbortFeatureTestP 0;
set WhichFontToSet MainFont
set CharacterEntryMenuItems 0;
set FeatureFileList [list];

array set Features {};		# Array indexed on feature, program, and locale.
				# Values are 1 if the program has that feature in that locale,
				# else 0, except for alttype, which is not boolean.
array set ProgramInfo {};	# This array is used to keep track of special features of
				# particular programs. It is indexed on program name
                                # and the various special features.
set ProgramInfo(agrep,BestResults) 0
set ProgramInfo(agrep,CaseInsensitiveP) 0
set ProgramInfo(agrep,TotalCost) 0
set ProgramInfo(agrep,DeletionCost) 0
set ProgramInfo(agrep,InsertionCost) 0
set ProgramInfo(agrep,SubstitutionCost) 0
set ProgramInfo(cgrep,CaseInsensitiveP) 0
set ProgramInfo(cgrep,Complement) 0
set ProgramInfo(egrep,CaseInsensitiveP) 0
set ProgramInfo(cgrep,TotalCost) 0
set ProgramInfo(cgrep,InsertionCost) 1
set ProgramInfo(cgrep,DeletionCost) 1
set ProgramInfo(cgrep,SubstitutionCost) 1
set ProgramInfo(egrep,EmitMatchOnly) 0;
set ProgramInfo(egrep,Complement) 0
set ProgramInfo(emacs,FoldCaseMatchP) 0
set ProgramInfo(emacs,FoldCaseReplaceP) 0
set ProgramInfo(fgrep,CaseInsensitiveP) 0
set ProgramInfo(fgrep,Complement) 0
set ProgramInfo(fgrep,EmitMatchOnly) 0
set ProgramInfo(gawk,CaseInsensitiveP) 0;
set ProgramInfo(gawk,IntervalExpressions) 1;
set ProgramInfo(gawk,Notation) GNU;
set ProgramInfo(glark,CaseInsensitiveP) 0;
set ProgramInfo(glark,EmitMatchOnly) 0;
set ProgramInfo(glark,Complement) 0;
set ProgramInfo(glark,MatchEntireLine) 0;
set ProgramInfo(grep,CaseInsensitiveP) 0
set ProgramInfo(grep,Notation) Basic;
set ProgramInfo(grep,EmitMatchOnly) 0;
set ProgramInfo(grep,Complement) 0
set ProgramInfo(java,CanonEQ) 1;
set ProgramInfo(java,CaseInsensitiveP) 0;
set ProgramInfo(java,UnicodeCase) 0;
set ProgramInfo(jgrep,CaseInsensitiveP) 0
set ProgramInfo(nrgrep,CaseInsensitiveP) 0
set ProgramInfo(nrgrep,ComplementP) 0
set ProgramInfo(nrgrep,TotalCost) 0
set ProgramInfo(nrgrep,InsertionsP) 1
set ProgramInfo(nrgrep,DeletionsP) 1
set ProgramInfo(nrgrep,SubstitutionsP) 1
set ProgramInfo(nrgrep,TranspositionsP) 1
set ProgramInfo(perl,UnicodeLocaleDependentP) 0;
set ProgramInfo(python,RawStringP) 1;
set ProgramInfo(sed,ExtendedRegexp) 0;
set ProgramInfo(tcl,CaseInsensitiveP) 0;
set ProgramInfo(tcl,ExpandedP) 0;
set ProgramInfo(tr,Complement) 0;
set ProgramInfo(tr,Squeeze) 0;
set ProgramInfo(tr,Truncate) 0;

set LeftRubyStringDelimiter ";";
set RightRubyStringDelimiter ";";
array set HelpPopups {};
array set OtherPopups {};
array set CommandGlosses {};
array set Wlist {}; #Maps color palette indices to internal names.
set PaletteIndex 0; #Used by color configuration system.
set UserClassPaletteIndex 0; #Used by color configuration system.

set PHPPCRE 0;				# Perl style regexps in PHP
set PHPMB 0;				# Multibyte extension for PHP regexps?

set InData "";
set ComparisonData ""; 
set RegexpResult "";
set DiffPopup "";

set Locale "";
set LocaleText "";
set ProposedLocale "";

set wret 0;

#File names
set ClassName [format "Redet_comm%d" [pid]];# Used for Java files.
set CommandFile [file join $TempDir $ClassName];
set JavaMatchClassName [format "%sMatch" $ClassName];
set JavaMatchClassFile [format "%sMatch.class" $CommandFile];
set JavaMatchFile [format "%sMatch.java" $CommandFile];
set JavaSubClassName [format "%sSub" $ClassName];
set JavaSubClassFile [format "%sSub.class" $CommandFile];
set JavaSubFile [format "%sSub.java" $CommandFile];
set TestFile [file join $TempDir  [format "Redet_data%d" [pid]]];
set TempCompFile [file join $TempDir  [format "Redet_comp%d" [pid]]];
set TempOutputFile [file join $TempDir  [format "Redet_out%d" [pid]]];
set TempSortFile [file join $TempDir  [format "Redet_sort%d" [pid]]];
set TempGlobDir [file join $TempDir  [format "Redet_dirr%d" [pid]]];
set DiffResultFile [file join $TempDir  [format "Redet_diff%d" [pid]]];
set EmacsOutputFile [file join $TempDir  [format "Redet_emacsout%d" [pid]]];
set EmacsWrapper [file join $TempDir  [format "Redet_emacswrapper%d" [pid]]];
set VersionFile [format "redet%dgetv.txt" [pid]];
set FeatureTestLogHandle "";

proc GetVersion {p} {
    set failmsg  [_ "version unknown"];
    switch -exact -- $p {
	agrep {
	    return [lindex [split [exec agrep --version] "\n"] 0]
	}
	awk {
	    return [lindex [split [exec awk --version] "\n"] 0]
	}
	bash {
	    return [lindex [split [exec bash --version] "\n"] 0]
	}
	cgrep {
	    catch {exec cgrep} vline;
	    return [lindex [split $vline] 4]
	}
	ed {
	    return [lindex [split [exec ed --version] "\n"] 0]
	}
	egrep {
	    return [lindex [split [exec egrep --version] "\n"] 0]
	}
	emacs {
	    return [lindex [split [exec emacs --version] "\n"] 0]
	}
	euphoria {
	    return [_ "Euphoria declines to reveal its age"]
	}
	fgrep {
	    return [lindex [split [exec fgrep --version] "\n"] 0]
	}
	fish {
	    catch {[exec fish -v 2> $::VersionFile]}
	    if {[catch {open $::VersionFile "r"} TmpHandle ] != 0} {
		ShowMessage [format [_ "Mysterious failure to open temporary file %s."] $::VersionFile];
		return $failmsg;
	    }
	    if {[gets $TmpHandle vline] < 1} {
		return $failmsg;
	    }
	    close $TmpHandle
	    #	    file delete -force $::VersionFile; #debug
	    return [string trim [lindex [split $vline ","] 1]]
	}
	frink {
	    return [exec java -cp frink.jar frink.parser.Frink --version];
	}
	gawk {
	    return [lindex [split [exec gawk --version] "\n"] 0]
	}
	glark {
	    return [lindex [split [exec glark -v] "\n"] 0]
	}
	grep {
	    return [lindex [split [exec grep --version] "\n"] 0]
	}
	guile {
	    return [lindex [split [exec guile -v] "\n"] 0]
	}
	icon {
	    catch {[exec icon -V 2> $::VersionFile]}
	    if {[catch {open $::VersionFile "r"} TmpHandle ] != 0} {
		ShowMessage [format [_ "Mysterious failure to open temporary file %s."] $::VersionFile];
		return $failmsg;
	    }
	    if {[gets $TmpHandle vline] < 1} {
		return $failmsg;
	    }
	    close $TmpHandle
	    file delete -force $::VersionFile
	    return [string range $vline 0 [expr [string first "," $vline] -1] ];
	}
	java {
	    catch {[exec java -version 2> $::VersionFile]}
	    if {[catch {open $::VersionFile "r"} TmpHandle ] != 0} {
		ShowMessage [format [_ "Mysterious failure to open temporary file %s."] $::VersionFile];
		return $failmsg;
	    }
	    if {[gets $TmpHandle vline] < 1} {
		return $failmsg;
	    }
	    close $TmpHandle
	    file delete -force $::VersionFile
	    return [string trim [lindex [split $vline] 2] {\"}];
	}
	javascript {
	    return [lindex [split [exec js --version] "\n"] 0]
	}
	jgrep {
	    return [_ "Jgrep declines to reveal its age"]
	}
	judoscript {
	    return [lindex [split [exec java -jar judo.jar] "\n"] 1]
	}
	ksh {
	    return [_ "Ksh declines to reveal its age"]
	}
	lua {
	    catch {[exec lua -v 2> $::VersionFile]}
	    if {[catch {open $::VersionFile "r"} TmpHandle ] != 0} {
		ShowMessage [format [_ "Mysterious failure to open temporary file %s."] $::VersionFile];
		return $failmsg;
	    }
	    if {[gets $TmpHandle vline] < 1} {
		return $failmsg;
	    }
	    close $TmpHandle
	    file delete -force $::VersionFile
	    return [string range $vline 0 [expr [string first "Copyright" $vline] -3]];
	}
	mawk {
	    set vinfo [lindex [split [exec mawk -W version 2> /dev/null] "\n"] 0];	
	    return [list [lindex $vinfo 0] [lindex $vinfo 1]];
	}
	nawk {
	    return [_ "Nawk declines to reveal its age"]
	}
	nrgrep {
	    set vinfo [lindex [split [exec nrgrep -H] "\n"] 2];
	    return [format "%s %s" [_ "version"] [string trimright [lindex $vinfo 2] ","]];
	}
	perl {
	    set vinfo [lindex [split [exec perl -v] "\n"] 1];
	    return [lindex [split $vinfo] 3];
	}
	pike {
	    catch {[exec pike -v 2> $::VersionFile]}
	    if {[catch {open $::VersionFile "r"} TmpHandle ] != 0} {
		ShowMessage [format [_ "Mysterious failure to open temporary file %s."] $::VersionFile];
		return $failmsg;
	    }
	    if {[gets $TmpHandle vline] < 1} {
		return $failmsg;
	    }
	    close $TmpHandle
	    file delete -force $::VersionFile
	    return [string range $vline 0 [string first "Copyright" $vline]];
	}
	python {
	    catch {[exec python -V 2> $::VersionFile]}
	    if {[catch {open $::VersionFile "r"} TmpHandle ] != 0} {
		ShowMessage [format [_ "Mysterious failure to open temporary file %s."] $::VersionFile];
		return $failmsg;
	    }
	    if {[gets $TmpHandle vline] < 1} {
		return $failmsg;
	    }
	    close $TmpHandle
	    file delete -force $::VersionFile
	    return $vline;
	}
	rc {
	    return [lindex [exec rc -c {echo $version}] 0]
	}
	rebol {
	    set vinfo [lindex [split [exec rebol --help --do q] "\n"] 1];    
	    return [string range $vinfo [string first REBOL $vinfo] end]
	}
	ruby {
	    set vinfo [lindex [split [exec ruby -v] "\n"] 0];  
	    return [string range $vinfo 0 [expr [string first \[ $vinfo] -2]];
	}
	sed {
	    return [lindex [split [exec sed --version] "\n"] 0]
	}
	tcl {
	    return [info patchlevel]
	}
	tclglob {
	    return [info patchlevel]
	}
	tcsh {
	    set vilist [split [lindex [split [exec tcsh --version] "\n"] 0]]
	    return [format "%s %s %s" [lindex $vilist 1] [lindex $vilist 2] [lindex $vilist 3]]
	}
	tr {
	    return [lindex [split [exec tr --version] "\n"] 0]
	}
	default {
	    return $failmsg;
	}
    }
}

#Return the full name of the currently selected daughter program
proc NameProgram {} {
    if {[string equal $::program agrep]} {
	if {$::ProgramInfo(agrep,TreAgrepP) == 1} {
	    return "TRE agrep";
	} else {
	    return "Wu-Manber agrep";
	}
    } else {
	return $::program;
    }
}

proc ScaleMoveBigIncrement {w k x y} {
    set part [$w identify $x $y]
    set inc 0;
    switch -exact -- $part {
	trough1 {
	    set dir -1;
	}
	trough2 {
	    set dir  1;
	}
	default {
	    return ;
	}
    }
    set Resolution [$w cget -resolution]
    set CurrentValue [$w get]
    set Delta [expr $dir * $k * $Resolution]
    $w set [expr $CurrentValue + $Delta]
}

# Given a number represented as a string, insert delimiters to break it up for
# readability. Normally, the delimiter will be a comma which will be inserted every
# three digits. However, the delimiter and groupsize are arguments, permitting use
# in other locales.
#
# The string is assumed to consist of digits, possibly preceded by spaces,
# and possibly containing a decimal point, i.e.: [:space:]*[:digit:]*\.[:digit:]*

proc DelimitNumber {number {delim ","} {GroupSize 3}} {
    # First, extract right hand part of number, up to and including decimal point
    set point [string last "." $number];
    if {$point >= 0} {
	set PostDecimal [string range $number [expr $point + 1] end];
	set PostDecimalP 1;
    } else {
	set point [expr [string length $number] + 1]
	set PostDecimal "";
	set PostDecimalP 0;
    }

    # Now extract any leading spaces.
    set ind 0;
    while {[string equal [string index $number $ind] \u0020]} {
	incr ind;
    }
    set FirstNonSpace $ind;
    set LastSpace [expr $FirstNonSpace - 1];
    set LeadingSpaces [string range $number 0 $LastSpace];

    # Now extract the non-fractional part of the number, omitting leading spaces.
    set MainNumber [string range $number $FirstNonSpace [expr $point - 1]];

    # Insert commas into the main number.
    set Length [string length $MainNumber];
    set Phase  [expr $Length % $GroupSize]
    set PhaseMinusOne  [expr $Phase -1];
    set DelimitedMain "";

    #First we deal with the extra stuff.
    if {$Phase > 0} {
	append DelimitedMain [string range $MainNumber 0 $PhaseMinusOne];
    }
    set FirstInGroup $Phase;
    set LastInGroup [expr $FirstInGroup + $GroupSize -1];
    while {$LastInGroup < $Length} {
	if {$FirstInGroup > 0} {
	    append DelimitedMain $delim;
	}
	set ToAppend [string range $MainNumber $FirstInGroup $LastInGroup];
	append DelimitedMain [string range $MainNumber $FirstInGroup $LastInGroup];
	incr FirstInGroup $GroupSize
	incr LastInGroup  $GroupSize
    }

    # Reassemble the number.
    if {$PostDecimalP} {
	return [format "%s%s.%s" $LeadingSpaces $DelimitedMain $PostDecimal];
    } else {
	return [format "%s%s" $LeadingSpaces $DelimitedMain];
    }
}

#Font system begins here

# We set these outside the namespace since FontInfo has to be global.
# Default defaults
set FontInfo(family) courier
set FontInfo(size) 12
set FontInfo(weight) normal
set FontInfo(slant) roman
set FontInfo(underline) 0
set FontInfo(overstrike) 0

namespace eval fontsel {
    variable FontPropertyList [list family size weight slant underline overstrike]
    variable FontPropertyClass
    variable FSCColors

    foreach p $FontPropertyList {
	set FontPropertyClass($p) generic;
    }
    set FontPropertyClass(underline) boolean
    set FontPropertyClass(overstrike) boolean

    #We check the existence of the variable so that this
    #can safely be called AFTER non-default values are set.
    proc SetFontInfoDefaults {} {
	global FontInfo;
	foreach ft $::FontList {
	    if {![info exist FontInfo($ft,family)]} {
		set FontInfo($ft,family)	$FontInfo(family)
	    }
	    if {![info exist FontInfo($ft,size)]} {
		set FontInfo($ft,size)	$FontInfo(size)
	    }
	    if {![info exist FontInfo($ft,weight)]} {
		set FontInfo($ft,weight)	$FontInfo(weight)
	    }
	    if {![info exist FontInfo($ft,slant)]} {
		set FontInfo($ft,slant)	$FontInfo(slant)
	    }
	    if {![info exist FontInfo($ft,underline)]} {
		set FontInfo($ft,underline)	$FontInfo(underline)
	    }
	    if {![info exist FontInfo($ft,overstrike)]} {
		set FontInfo($ft,overstrike)	$FontInfo(overstrike)
	    }
	    if {![info exist FontInfo($ft,gloss)]} {
		set FontInfo($ft,gloss)	$ft;
	    }
	    if {![info exist FontInfo($ft,help)]} {
		set FontInfo($ft,help)	"?"
	    }
	}
    }

    #For a given font assign font-specific properties from generics.
    proc FontSet {which} {
	global FontInfo
	variable FontPropertyList
	foreach prop $FontPropertyList {
	    set FontInfo($which,$prop) $FontInfo($prop);
	}
    }

    #Assign the proprety values of a specified font to the generics.
    proc InverseFontSet {which} {
	global FontInfo
	variable FontPropertyList
	foreach prop $FontPropertyList {
	    set FontInfo($prop) $FontInfo($which,$prop);
	}
    }

    #Configure a specified font according to the font-specific properties.
    proc ConfigureFont {which} {
	global FontInfo
	variable FontPropertyList
	foreach prop $FontPropertyList {
	    font configure $which -$prop $FontInfo($which,$prop)
	}
    }

    #Record as default values the font-specific values of properties at the
    #time of the call. The recorded values are intended for use by
    #ResetToDefaults 
    proc RecordDefaults {} {
	global FontInfo
	global FontList;
	variable FontPropertyList

	foreach f $FontList {
	    foreach p $FontPropertyList {
		set FontInfo($f,$p,Default) $FontInfo($f,$p);
	    }
	}
    }

    #Create all of the fonts on the font list and configure them
    #according to the generic values of the properties, which are
    #also assigned at this time to the font-specific variables.
    proc CreateFonts {} {
	global FontList;

	foreach ft $FontList {
	    font create $ft;
	    InverseFontSet $ft;
	    ConfigureFont $ft;
	}
    
    }

    #Get the values from the three scales, combine them into a hex RGB spec,
    #assign its value to FontExampleColor, and configure the two examples.
    proc UpdateFontExampleColor {x} {
	variable FSCColors
	global FontExampleColorConfigureWhich

	UpdateFontExampleColorHex;
	.selectFont.curcan.att.r1c1 configure \
	    -$::FontExampleColorConfigureWhich  \#$::FontExampleColor
	.selectFont.curcan.att.r2c1 configure \
	    -$::FontExampleColorConfigureWhich \#$::FontExampleColor
	set FSCColors(red,$FontExampleColorConfigureWhich)   $::FontRed;
	set FSCColors(green,$FontExampleColorConfigureWhich) $::FontGreen;
	set FSCColors(blue,$FontExampleColorConfigureWhich)  $::FontBlue;
    }

    proc UpdateFontExampleColorHex {} {
	set ::FontExampleColor [format "%02X%02X%02X" $::FontRed $::FontGreen $::FontBlue];
    }

    proc RestoreCSColors {} {
	variable FSCColors
	global FontExampleColorConfigureWhich
	set ::FontRed   $FSCColors(red,$FontExampleColorConfigureWhich)
	set ::FontGreen $FSCColors(green,$FontExampleColorConfigureWhich)
	set ::FontBlue  $FSCColors(blue,$FontExampleColorConfigureWhich)
	UpdateFontExampleColorHex;
    }

    proc CloneMainFontAsFontControlPanelFont {} {
	variable FontPropertyList
	global FontInfo

	foreach p $FontPropertyList {
	    font configure FontControlPanelFont -$p $FontInfo(MainFont,$p);
	}
    }
					

    #We create this separately because we don't want it on the FontList.
    font create FontControlPanelFont;

    #This is the main procedure of this package.
    #It creates the font control panel.
    proc CreateFontControlPanel {args} {
	global FontInfo;
	global WhichFontToSet
	global FontList;
	variable FontPropertyList
	variable FSCColors

	set General 1
	set exwid 10

	set w .selectFont
	if {[winfo exists $w]} {
	    wm deiconify $w;
	    raise $w;
	    return ;
	}
	toplevel $w
	wm title $w [_ "Font Selection"]
	BindKeys $w
	wm protocol $w WM_DELETE_WINDOW "wm withdraw $w"
	
	#The idea is that in general we want to use the main
	#font here, but we keep them separate so that we
	#can wait before switching the control panel to
	#the new main font configuration so that
	#the user isn't confronted with an unusable
	#control panel if he or she sets the mainfont to something
	#crazy.
	CloneMainFontAsFontControlPanelFont;

	if {[llength $args] > 0} {
	    set ::WhichFontToSet [lindex $args 0];
	    set General 0;
	} 
	set FontTypes [llength $FontList];
	if {$FontTypes == 1} {
	    set ::WhichFontToSet [lindex $FontList 0];
	    set General 0;
	}

	frame $w.which -relief ridge -border 3
	if {$General} {
	    set msg [_ "For what aspect of the program\ndo you wish to set the font?"]
	    balloonhelp_for $w.which $msg
	    label $w.which.title -text [_ "Use for which to set font"] \
		-anchor w -font FontControlPanelFont
	    frame $w.which.btns;
	    set k 0;
	    set PerRow 4;
	    set ypad 3
	    set xpad 10
	    foreach ft $FontList {
		set bn $w.which.btns.f$ft;
		radiobutton $bn -text [_ $FontInfo($ft,gloss)]  \
		    -variable WhichFontToSet -value $ft \
		    -command fontsel::SetFontSelectionDefaults \
		    -font FontControlPanelFont \
		    -indicatoron 0 -selectcolor $::ColorSpecs(Default,Background)
		balloonhelp_for $w.which.btns.f$ft $FontInfo($ft,help)
		set row [expr 1+ $k/$PerRow]
		set col [expr $k%$PerRow]
		if {$FontTypes >= $PerRow} {
		    grid $w.which.btns.f$ft -row $row -column $col \
			-sticky we -ipadx 3 -padx $xpad -pady $ypad
		}
		incr k
	    }
	    if {$FontTypes < $PerRow} {
		foreach ft $FontList {
		    pack $w.which.btns.f$ft -side left -expand 1 -fill x \
			-ipadx 5 -ipady 3 -padx 40 -pady 3
		}
	    }
	    frame $w.which.pad  -height 4
	    pack $w.which.title -side top -expand 1 -fill both -anchor w
	    pack $w.which.btns  -side top -expand 1 -fill both -anchor w
	    pack $w.which.pad   -side top -expand 0 -fill x    -anchor w

	}

	frame $w.mid 
	frame $w.mid.opts  -relief ridge -border 3
	frame $w.mid.families  -relief ridge -border 3
	label $w.mid.families.lab -text [_ "Family"] -relief ridge \
	    -justify center -font FontControlPanelFont
	listbox $w.mid.families.lb -height 1 -exportselection 0 \
	    -yscrollcommand "$w.mid.families.sbar set" -selectmode single \
	    -font FontControlPanelFont
	scrollbar $w.mid.families.sbar -orient vertical -command "$w.mid.families.lb yview"
	bind $w.mid.families.sbar <<B3>> \
	    "ScrollbarMoveBigIncrement $w.mid.families.sbar 0.20 %x %y"

	bind $w.mid.families.lb <<B3>> ProvideFontDescription

	pack $w.mid.families.lab  -side top -expand 0 -fill x
	pack $w.mid.families.lb   -side left -expand 1 -fill both
	pack $w.mid.families.sbar -side left -expand 1 -fill y

	label $w.mid.opts.lab -text [_ "Attributes"] -relief ridge \
	    -justify center -font FontControlPanelFont
	label $w.mid.opts.sizel -text [_ "Size:"]  -font FontControlPanelFont
	scale $w.mid.opts.size -orient h -digit 1 -from 5 -to 55 \
	    -variable FontInfo(size)  -tickinterval 0 -length 150 \
	    -font FontControlPanelFont
	bind $w.mid.opts.size <<B3>> "ScaleMoveBigIncrement $w.mid.opts.size 5 %x %y"

	label $w.mid.opts.weightl -text [_ "Bold:"] \
	    -font FontControlPanelFont	    
	checkbutton $w.mid.opts.weight -variable FontInfo(weight) \
	    -onvalue bold -offvalue normal  -font FontControlPanelFont

	label $w.mid.opts.slantl -text [_ "Italic:"] \
	    -font FontControlPanelFont
	checkbutton $w.mid.opts.slant -variable FontInfo(slant) \
	    -onvalue italic -offvalue roman -font FontControlPanelFont

	label $w.mid.opts.ulinel -text [_ "Underline:"] \
	    -font FontControlPanelFont
	checkbutton $w.mid.opts.uline -variable FontInfo(underline) \
	    -onvalue 1 -offvalue 0  -font FontControlPanelFont

	label $w.mid.opts.strkovl -text [_ "Overstrike:"] \
	    -font FontControlPanelFont
	checkbutton $w.mid.opts.strkov -variable FontInfo(overstrike) \
	    -onvalue 1 -offvalue 0  -font FontControlPanelFont

	grid $w.mid.opts.lab   -row 0 -column 0 -columnspan 2 -sticky ew
	grid $w.mid.opts.sizel -row 1 -column 0 -sticky w
	grid $w.mid.opts.size -row 1 -column 1 -sticky w
	grid $w.mid.opts.weightl -row 2 -column 0 -sticky w
	grid $w.mid.opts.weight -row 2 -column 1 -sticky w
	grid $w.mid.opts.slantl -row 3 -column 0 -sticky w
	grid $w.mid.opts.slant -row 3 -column 1 -sticky w
	grid $w.mid.opts.ulinel -row 4 -column 0 -sticky w
	grid $w.mid.opts.uline -row 4 -column 1 -sticky w
	grid $w.mid.opts.strkovl -row 5 -column 0 -sticky w
	grid $w.mid.opts.strkov -row 5 -column 1 -sticky w

	pack $w.mid.families -side left -expand 1 -fill both -padx 5 -pady 2
	pack $w.mid.opts     -side left -expand 1 -fill both -padx 5 -pady 2

	eval $w.mid.families.lb insert 0 [lsort [font families]]

	bind $w.mid.families.lb <ButtonPress-1> {fontsel::SelectFontFamily %W %y}
	bind $w.mid.families.lb <B1-Motion> {fontsel::SelectFontFamily %W %y}
	bind $w.mid.families.lb <Activate> {fontsel::SelectFontFamily %W %y}

	frame $w.cntls -relief ridge -border 3
	button $w.cntls.sav -text [_ "Apply"]  -command fontsel::FontSave \
	    -font FontControlPanelFont
	button $w.cntls.res -text [_ "Reset"] -command  fontsel::ResetToDefaults \
	    -font FontControlPanelFont
	button $w.cntls.can -text [_ "Dismiss"] -command "wm withdraw $w" \
	    -font FontControlPanelFont
	button $w.cntls.cpanel -text [_ "Here Too?"] \
	    -command fontsel::CloneMainFontAsFontControlPanelFont \
	-font FontControlPanelFont
	pack $w.cntls.cpanel -side left  -expand 1 -fill both -padx 3
	pack $w.cntls.can    -side left  -expand 1 -fill both -padx 3
	pack $w.cntls.res    -side left  -expand 1 -fill both -padx 3
	pack $w.cntls.sav    -side right -expand 1 -fill both -padx 3

	set msg [_ "Press this button to dismiss the popup."];
	balloonhelp_for $w.cntls.can $msg
	set msg [_ "Press this button to reset the font to its defaults."];
	balloonhelp_for $w.cntls.res $msg
	set msg [_ "Press this button to make the changes\nyou have made take effect."]
	balloonhelp_for $w.cntls.sav $msg
	set msg [format \
	     [_ "Press this button to set the fonts\nin this control panel to the %s font."] \
		     [_ $::FontInfo(MainFont,gloss)]]
	balloonhelp_for $w.cntls.cpanel $msg

	frame $w.curcan -relief ridge -border 1
	set ATT [frame $w.curcan.att]
	set Row 0
	foreach r {Header Current Candidate} {
	    set Column 2
	    foreach p $FontPropertyList {
		set v $w.curcan.att.r${Row}c${Column};
		label $v  -font FontControlPanelFont
		incr Column;
	    } 
	    incr Row;
	}

	font create CurrentFontExampleFont \
	    -family $FontInfo($::WhichFontToSet,family) \
	    -size $FontInfo($::WhichFontToSet,size) \
	    -weight $FontInfo($::WhichFontToSet,weight) \
	    -slant $FontInfo($::WhichFontToSet,slant) \
	    -underline $FontInfo($::WhichFontToSet,underline) \
	    -overstrike $FontInfo($::WhichFontToSet,overstrike);

	font create CandidateFontExampleFont \
	    -family $FontInfo($::WhichFontToSet,family) \
	    -size $FontInfo($::WhichFontToSet,size) \
	    -weight $FontInfo($::WhichFontToSet,weight) \
	    -slant $FontInfo($::WhichFontToSet,slant) \
	    -underline $FontInfo($::WhichFontToSet,underline) \
	    -overstrike $FontInfo($::WhichFontToSet,overstrike);

	label $w.curcan.att.r0c0 -font FontControlPanelFont
	label $w.curcan.att.r0c1 -font FontControlPanelFont
	label $w.curcan.att.r1c0  -text [_ "Current"] -font FontControlPanelFont
	entry $w.curcan.att.r1c1 -font CurrentFontExampleFont -relief flat -width $exwid
	$w.curcan.att.r1c1 insert 0 [_ "example"]
	label $w.curcan.att.r2c0  -text [_ "Candidate"] -font FontControlPanelFont
	entry $w.curcan.att.r2c1 -font CandidateFontExampleFont -relief flat  -width $exwid
	$w.curcan.att.r2c1 insert 0 [_ "example"]

	#This is for use in conjunction with my character insertion library.
	#It arranges for the various character insertion widgets to insert
	#characters into the focussed window.
	if {[llength [info commands BindInsertionTarget]]} {
	    BindInsertionTarget $w.curcan.att.r1c1;
	    BindInsertionTarget $w.curcan.att.r2c1;
	}

	set CLR [frame $w.curcan.clr]
	set ln 60;
	set wd 10
	set trc \#D4B8C1
	scale $CLR.red -orient v -digit 1 -from 255 -to 0 -tickinterval 0 \
	    -variable FontRed  -showvalue 0 -length $ln -width $wd\
	    -troughcolor $trc -activebackground \#F0AAAA \
	    -bg red -fg yellow -command fontsel::UpdateFontExampleColor
	scale $CLR.grn -orient v -digit 1 -from 255 -to 0 -tickinterval 0 \
	    -variable FontGreen  -showvalue 0 -length $ln -width $wd\
	    -troughcolor $trc -activebackground \#AAF0AA \
	    -bg green -fg yellow -command fontsel::UpdateFontExampleColor
	scale $CLR.blu -orient v -digit 1 -from 255 -to 0 -tickinterval 0 \
	    -variable FontBlue  -showvalue 0 -length $ln -width $wd\
	    -troughcolor $trc -activebackground \#AAAAF0 \
	    -bg blue -fg yellow -command fontsel::UpdateFontExampleColor
	set FSCColors(red,bg)   0x00
	set FSCColors(green,bg) 0x00
	set FSCColors(blue,bg)  0x00
	set FSCColors(red,fg)   0x00
	set FSCColors(green,fg) 0x00
	set FSCColors(blue,fg)  0x00

	bind $CLR.red <<B3>> "ScaleMoveBigIncrement $CLR.red -20 %x %y"
	bind $CLR.grn <<B3>> "ScaleMoveBigIncrement $CLR.grn -20 %x %y"
	bind $CLR.blu <<B3>> "ScaleMoveBigIncrement $CLR.blu -20 %x %y"

	set ::FontRed   255
	set ::FontGreen 255
	set ::FontBlue  255
	set FontExampleColor \#FFFFFF
	label $CLR.rdt -textvariable FontExampleColor -width 7 -relief raised
	bind $CLR.rdt <Button-1> "pack forget $CLR"
	bind $ATT <Button-1> "pack $w.curcan.clr -before $ATT -side left -expand 1 -fill both"
	set msg [_ "Left click here to remove the color selector."]
	balloonhelp_for $CLR.rdt $msg;
	set msg [_ "Use this to set the colors in the example text boxes."]
	balloonhelp_for $CLR.red $msg;
	balloonhelp_for $CLR.grn $msg;
	balloonhelp_for $CLR.blu $msg;

	frame $CLR.whi
	set ::FontExampleColorConfigureWhich bg;
	radiobutton $CLR.whi.t -variable FontExampleColorConfigureWhich \
	    -value fg -command fontsel::RestoreCSColors -text [_ "fg"] \
	    -indicatoron 0 -activebackground gray -selectcolor gray \
	    -font FontControlPanelFont
	radiobutton $CLR.whi.b -variable FontExampleColorConfigureWhich \
	    -value bg -command fontsel::RestoreCSColors -text [_ "bg"] \
	    -indicatoron 0 -activebackground gray -selectcolor gray \
	    -font FontControlPanelFont
	pack $CLR.whi.t -side left -expand 1 -fill both
	pack $CLR.whi.b -side left -expand 1 -fill both

	pack $CLR.rdt -side top -expand 1  -fill both
	pack $CLR.whi -side bottom -expand 1  -fill both
	pack $CLR.red -side left -expand 1 -fill y
	pack $CLR.grn -side left -expand 1 -fill y
	pack $CLR.blu -side left -expand 1 -fill y

	set msg [_ "Choose the color for the sample text."]
	balloonhelp_for $CLR.whi.t $msg;
	set msg [_ "Choose the background color for the sample text."]
	balloonhelp_for $CLR.whi.b $msg;

	#Now grid them all
	set xp 5
	set yp 3
	set CLimit [expr [llength $FontPropertyList] + 2];
	for {set r 0} {$r < 3} {incr r} {
	    for {set c 0} {$c < $CLimit} {incr c} {
		set v $w.curcan.att.r${r}c${c};
		grid $v -row $r -column $c -sticky w -padx $xp -pady $yp
	    } 
	}

	set xp 3
	set yp 1
	if {!$General} {
	    $w.curcan.att.r0c0 configure -text [string totitle [_ $FontInfo($::WhichFontToSet,gloss)]]
	}

	pack $w.curcan.clr -side left -expand 1 -fill both -padx 9 -pady 5
	pack $w.curcan.att -side left -expand 1 -fill both -padx 3 -pady 5

	#Put it all together
	frame $w.botsep -height 4
	pack $w.which -side top -expand 1 -fill x -padx 8 -pady 6
	pack $w.curcan -side top -expand 1 -fill x -padx 8 -pady 6
	pack $w.mid   -side top -expand 1 -fill x -padx 8 -pady 1
	pack $w.cntls -side top -expand 1 -fill x -padx 8 -pady 2
	pack $w.botsep -side top -expand 1 -fill x -padx 8 -pady 2
	if {$General} {
	    $w.which.btns.f[lindex $FontList 0] invoke;#  Default to first on list
	}
	foreach f $FontPropertyList {
	    trace add variable FontInfo($f) write fontsel::FontShow;
	}
	return $w;
    }

    #This resets the properties of the font specified by WhichFontToSet
    #to their default values, where "default" means whatever values
    #are stored in FontInfo(<font>,<property>,Default). The intention
    #is that these values will have been set by RecordDefaults at
    #a suitable point. A suitable point might be program startup or it
    #might be after init files have been read.
    #After resetting the attributes for the current font to their
    #default values, it configures the fonts for both the current and candidate
    #examples in the control panel to match.
    proc ResetToDefaults {} {
	global FontInfo;
	global WhichFontToSet
	variable FontPropertyList

	foreach prop $FontPropertyList {
	    set FontInfo($::WhichFontToSet,$prop) $FontInfo($::WhichFontToSet,$prop,Default);
	    set FontInfo($prop) $FontInfo($::WhichFontToSet,$prop,Default);
	}
	ConfigureFont $::WhichFontToSet;
	ConfigureCurrentExampleFont;
	ConfigureCandidateExampleFont;
	DescribeBothFonts;
    }

    #This is the procedure called from the control panel when the user decides
    #to apply and save the values set on the control panel. It sets the font-specific
    #attributes from the generic ones, configures the target font as well as the
    #current example font, and updates the description of the current font
    #in the control panel.
    proc FontSave {} {
	global FontInfo

	set f $::WhichFontToSet;
	FontSet $f;
	ConfigureFont $f
	ConfigureCurrentExampleFont;
	DescribeBothFonts;
    } 

    #This procedure configures the font used to display the candidate example
    #in the control panel. It is intended to be called whenever a property
    #is changed in the control panel or when the target font is changed.
    proc ConfigureCandidateExampleFont {} {
	global FontInfo
	global WhichFontToSet
	variable FontPropertyList

	foreach prop $FontPropertyList {
	    font configure CandidateFontExampleFont -$prop $FontInfo($prop)
	}
    }

    #This procedure configures the font used to display the current example
    #in the control panel. It is intended to be called when the user
    #applies new values or when the target font is changed.
    proc ConfigureCurrentExampleFont {} {
	global FontInfo
	global WhichFontToSet
	variable FontPropertyList

	foreach prop $FontPropertyList {
	    font configure CurrentFontExampleFont -$prop $FontInfo($::WhichFontToSet,$prop)
	}
    }

    #This procedure configures the candidate example font#and updates the
    #description of the candidate font in the control panel. It is intended
    #to be called whenever a proprty of the candidate font is changed.
    proc FontShow {args} {
	ConfigureCandidateExampleFont;
	DescribeBothFonts;
    }

    #This procedure generates the descriptions of the current and candidate
    #fonts that are shown in the control panel.
    proc DescribeBothFonts {} {
	global FontInfo
	global WhichFontToSet;
	variable FontPropertyList

	set f $::WhichFontToSet;
	set c 2;
	foreach prop $FontPropertyList {
	    .selectFont.curcan.att.r0c$c configure -text  [string totitle [_ $prop]] 
	    set value $FontInfo($f,$prop)
	    if {$value == 1} {set value [_ "Yes"]} else {
		if {$value == 0} {set value [_ "No"]}}
	    .selectFont.curcan.att.r1c$c configure -text $value;
	    set value $FontInfo($prop)
	    if {$value == 1} {set value [_ "Yes"]} else {
		if {$value == 0} {set value [_ "No"]}}
	    .selectFont.curcan.att.r2c$c configure -text $value; 
	    incr c;
	}
    }

#This is to be called when we change font targets.
#It resets the control panel to show the current
#configuration for the newly targeted font.
    proc SetFontSelectionDefaults {} {
	global FontInfo;
	global WhichFontToSet;
	variable FontPropertyList

	foreach prop $FontPropertyList {
	    set FontInfo($prop) $FontInfo($WhichFontToSet,$prop);
	}
	set FontChoices [.selectFont.mid.families.lb size];
	set k 1;
	while {$k <= $FontChoices} {
	    set Family [.selectFont.mid.families.lb get $k];
	    if {[string equal $Family [string tolower $FontInfo($WhichFontToSet,family)]]} {
		.selectFont.mid.families.lb selection clear 0 end;
		.selectFont.mid.families.lb see $k
		.selectFont.mid.families.lb selection set $k $k;
		.selectFont.mid.families.lb activate $k;
		set FontInfo(family) [.selectFont.mid.families.lb get $k]
		break
	    }
	    incr k;
	}
	ConfigureCandidateExampleFont
	ConfigureCurrentExampleFont;
	DescribeBothFonts;
    }

    #This is the callback that extracts a new font family
    #setting from the control panel.
    proc SelectFontFamily {w y} {
	global FontInfo

	set index [$w nearest $y]
	if {$index != ""} {
	    set FontInfo(family) [$w get $index]
	}
    }

    #This is the callback that extracts a new font size
    #from the control panel.
    proc SelectFontSize {w} {
	global WhichFontToSet
	global FontInfo

	set size [$w get]
	if {[catch {expr round($size)} size] == 0} {
	    if { ($size > 0) && ($size <= 60) } {
		set FontInfo(size) $size
		return ;
	    }
	}
	$w delete 0 end
	$w insert 0 $FontInfo($WhichFontToSet,size)
    }

    #This is presently a stub.
    #It is intended to be called on an event, probably <B3>,
    #in the font family listbox in the control panel.
    #Its purpose is to provide the user with information about
    #the particular font. 
    proc ProvideFontDescription {w y} {
	variable FontDescriptions

	set index [$w nearest $y]
	if {$index != ""} {
	    FontDescriptions([$w get $index])
	}
    }

    #Create a command for setting each combination of font and property.
    proc DefineFontSettingProcs {} {
	variable FontPropertyList
	variable FontPropertyClass
	global FontList;
	global FontProcList;

	foreach ft $FontList {
	    foreach prop $fontsel::FontPropertyList {
		if {[string equal $FontPropertyClass($prop) boolean]} {
		    set ProcName  [format "::fontsel::Set%s%sP" $ft [string totitle $prop]];
		    lappend FontProcList $ProcName;
		    set cmd [list "proc"  $ProcName  "\{v\}" \
			 "set ::FontInfo($ft,$prop) \[SlaveBoolean \$v\];\nConfigureFont $ft;"]
		} else {
		    set ProcName  [format "::fontsel::Set%s%s" $ft [string totitle $prop]];
		    lappend FontProcList $ProcName;
		    set cmd [list "proc" $ProcName "\{v\}" \
			 "set ::FontInfo($ft,$prop) \$v;\nConfigureFont $ft;"]
		}
		eval $cmd;
	    }
	}
    }

    #Create aliases in the named daughter interpreter for the font setting commands
    proc AliasFontSettings {interp} {
	variable FontPropertyList
	variable FontPropertyClass
	global FontList;
	
	foreach ft $FontList {
	    foreach prop $FontPropertyList {
		set Tprop [string totitle $prop]
		set Tprop2 $Tprop;
		if {[string equal $FontPropertyClass($prop) boolean]} {
		    set Tprop ${Tprop}P
		}
		eval [split [format "%s alias %s%s ::fontsel::Set%s%s" \
			 $interp $ft $Tprop $ft $Tprop2]]
	    }
	}
    }

    #Returns a list of init file commands representing the current font settings.
    proc SaveFontSettings {} {
	variable FontPropertyList
	variable FontPropertyClass
	global FontInfo
	global FontList;
	
	set cl [list]
	foreach ft $FontList {
	    foreach prop $FontPropertyList {
		set Tprop [string totitle $prop]
		if {[string equal $FontPropertyClass($prop) boolean]} {
		    set Tprop ${Tprop}P
		}
		lappend cl [format "%s%s %s" $ft $Tprop [list $FontInfo($ft,$prop)]]
	    }
	}
	return [lsort $cl];
    }
}

namespace import ::msgcat::mcset;
mcset de "Dismiss" "Abbrechen"
mcset de "bold" "Fett"
mcset de "Bold:" "Fett:"
mcset de "italic" "Kursiv"
mcset de "Italic:" "Kursiv:"
mcset de "Yes" "Ja"
mcset de "No" "Nein"
mcset de "underline" "Unterstrichen"
mcset de "Underline:" "Unterstrichen:"
mcset de "overstrike" "Durchgestrichen"
mcset de "Overstrike:" "Durchgestrichen:"
mcset de "size" "Gre"
mcset de "Size:" "Gre:"
mcset de "Font Selection" "Schriftart auswhlen"

# End of namespace fontsel

# This is the stuff specific to this program.

set FontList [list MainFont MenuFont BalloonHelpFont PopupTitleFont CharacterEntryFont TextFont \
		  RegexpFont AccentedLetterFont DiacriticFont];

set FontInfo(family) courier

set FontInfo(BalloonHelpFont,family) lucida
set FontInfo(BalloonHelpFont,size) 13

set FontInfo(PopupTitleFont,size) 16
set FontInfo(PopupTitleFont,family) "bookman l"

set FontInfo(MainFont,family) courier
set FontInfo(MainFont,size) 12
set FontInfo(MainFont,weight) bold

set FontInfo(MenuFont,family) courier
set FontInfo(MenuFont,size) 12

set FontInfo(AccentedLetterFont,size) 14
set FontInfo(AccentedLetterFont,family) "doulos sil"
set FontInfo(CharacterEntryLabelFont,family) bible
set FontInfo(CharacterEntryLabelFont,size) 13
set FontInfo(CharacterEntryFont,size) 14
set FontInfo(CharacterEntryFont,family) "doulos sil"
set FontInfo(RegexpFont,size) 13
set FontInfo(RegexpFont,family)  "doulos sil"
set FontInfo(DiacriticFont,size)  [expr $FontInfo(CharacterEntryFont,size) + 40];

set FontInfo(TextFont,size) 12

set FontInfo(CharacterEntryFont,size) 14
set FontInfo(AccentedLetterFont,size) 14
set FontInfo(DiacriticFont,size) 54

proc SetFontGlossHelpTranslations {} {
    global FontInfo;

    set FontInfo(BalloonHelpFont,gloss) [_ "balloon help"]
    set FontInfo(BalloonHelpFont,help) [_ "This font is used in help balloons."]

    set FontInfo(TextFont,gloss) [_ "text"]
    set FontInfo(TextFont,help) [_ "This font is used in the three text windows."]

    set FontInfo(MainFont,gloss) [_ "general"]
    set FontInfo(MainFont,help) [_ "This font is used for most things."]

    set FontInfo(MenuFont,gloss) [_ "menu"]
    set FontInfo(MenuFont,help) [_ "This font is used for menu labels."]

    set FontInfo(PopupTitleFont,gloss) [_ "popup titles"]
    set FontInfo(PopupTitleFont,help) [_ "This font is used for the titles of popup windows."]

    set FontInfo(RegexpFont,gloss) "regexp" 
    set FontInfo(RegexpFont,help) \
	[_ "This font is used for regular expressions\nand substitution expressions"];

    set FontInfo(CharacterEntryFont,gloss) [_ "character entry"]
    set FontInfo(CharacterEntryFont,help) \
	[_ "This font is used on the labels of\ncharacter insertion widgets."]
    set FontInfo(AccentedLetterFont,gloss) [_ "accented letters"]
    set FontInfo(AccentedLetterFont,help) \
	[_ "This font is used on the labels of the\naccented character insertion widget."]

    set FontInfo(DiacriticFont,gloss) [_ "diacritics"]
    set FontInfo(DiacriticFont,help) \
	[_ "This font is used on the labels of the\ndiacritic insertion widget."]
}

SetFontGlossHelpTranslations;
fontsel::SetFontInfoDefaults;
fontsel::CreateFonts;

option add *selectFont*Font FontControlPanelFont 100
option add *Label.Font MainFont 100
option add *Menu.Font MenuFont 100
option add *Radiobutton.Font MainFont 100
option add *Scale.Font MainFont 100

#This is the history system.
namespace eval hist {
    namespace export AddToHistoryList ClearHistoryList ConstructHistory ParseHistoryEntry;
    namespace export PruneHistoryList SaveHistoryList ShowHistory ToggleHistory;
    namespace export ToggleHistoryProgramDisplay HistoryIsDisplayedP AddToHistoryFile ToggleHistoryMark;
    # 0xFDDF is a codepoint guaranteeed to be unused.
    # The same value must be used as the field separator when history
    # file entries are made in ExecuteRegexp, SaveRegexp, and
    # SaveHistoryList, and when they are parsed by ParseHistoryEntry.
    variable HistoryDelimiter "\uFDDF";
    variable HistoryIsDisplayedP 0;
    variable HistoryIsToBeDisplayedP 0;
    variable HistoryCnt 0;		# The number of entries in the history list
    variable HistoryCntOffset 0;	# The number of entries read from files rather than
    				# executed in the current session.
    variable HistoryShowProgP 0;	# Should the history window display the program used?
    variable HistoryRegexps [list];	# Regular expression executed
    variable HistorySubexps [list];	# Substitution expression (may be null)
    variable HistoryMarks [list];	# Flag indicating whether entry is marked
    variable HistoryProgs [list];	# Program in use when regexp was executed

    variable HistoryListIndex 0; #Used by color configuration system.
    variable HistoryListHandle;
    variable EventNumberFieldWidth 4;
    variable ProgramFieldWidth 12;
    variable LocalP 1;
    variable RecordHistoryP 1;

    proc ShowHistory {} {
	pack .hl.hlist;
	wm deiconify .hl;
    }

    proc OpenHistoryFile {} {
	variable RecordHistoryP;
	variable HistoryListHandle;
	variable LocalP;
	if {$LocalP} {
	    set hf $::HistoryFile;
	    if {[catch {open $hf "a"} HistoryListHandle] == 0} {
		return ;
	    } else {
		ShowMessage [format \
			 [_ "Unable to open history file %s for writing in directory %s."]\
			 $hf [pwd]];
		ShowMessage [_ "Using home directory instead."]
	    }
	}
	set hf [file join $::HomeDir $::HistoryFile]
	if {[catch {open $hf "a"} HistoryListHandle] != 0} {
	    ShowMessage [format [_ "Unable to open history file %s for writing."] $hf];
	    ShowMessage [_ "History will not be automatically recorded."];
	    set RecordHistoryP 0;
	}
    }

    proc ParseHistoryEntry {entry} {
	variable HistoryProgs;
	variable HistoryRegexps;
	variable HistorySubexps;
	variable HistoryMarks;
	variable HistoryDelimiter;

	set Fields [split $entry $HistoryDelimiter];
	set FieldCnt [llength $Fields];
	lappend HistoryProgs [string trim  [lindex $Fields 0]];
	lappend HistoryRegexps [lindex $Fields 1];
	if {$FieldCnt > 2} {
	    lappend HistorySubexps [lindex $Fields 2];
	} else {
	    lappend HistorySubexps "";
	}
	lappend HistoryMarks 0;
    }

    #Delete all the entries from the history list
    proc ClearHistoryList {} {
	variable HistoryCnt;
	variable HistoryCntOffset;
	variable HistoryRegexps;
	variable HistorySubexps;
	variable HistoryMarks;
	variable HistoryProgs;
	variable HistoryIsDisplayedP;
	variable ToggleHistoryIndex;
	global m;
	
	set HistoryRegexps [lreplace $HistoryRegexps 0 end];
	set HistorySubexps [lreplace $HistorySubexps 0 end];
	set HistoryMarks   [lreplace $HistoryMarks 0 end];
	set HistoryProgs   [lreplace $HistoryProgs 0 end];
	set HistoryCnt 0;
	set HistoryCntOffset 0;
	if {$HistoryIsDisplayedP} {
	    destroy .hl;
	    set HistoryIsDisplayedP 0;
	    $m.history entryconfigure $ToggleHistoryIndex -label [_ "Popup History List"];
	}
	update;
    }

    #Delete the unmarked entries from the history list
    proc PruneHistoryList {} { 
	variable HistoryCnt;
	variable HistoryCntOffset;
	variable HistoryRegexps;
	variable HistorySubexps;
	variable HistoryMarks;
	variable HistoryProgs;
	variable HistoryIsDisplayedP;
	variable ToggleHistoryIndex;
	global m;

	set MaxIndex [expr $HistoryCnt -1];
	for {set i $MaxIndex} {$i >= 0} {incr i -1} {
	    if {[lindex $HistoryMarks $i] == 0} { #if not marked, delete entry
		set HistoryRegexps [lreplace $HistoryRegexps $i $i];
		set HistorySubexps [lreplace $HistorySubexps $i $i];
		set HistoryMarks [lreplace $HistoryMarks $i $i];
		set HistoryProgs [lreplace $HistoryProgs $i $i];
		incr HistoryCnt -1;
	    } else {#if marked, retain but unset mark
		set HistoryMarks [lreplace $HistoryMarks $i $i 0];
	    }
	}
	set HistoryCntOffset 0;
	if {$HistoryCnt > 0} {
	    ConstructHistory;
	} else {
	    if {$HistoryIsDisplayedP} {
		pack forget .hl.hlist
		pack forget .hl
		destroy .hl;
		set HistoryIsDisplayedP 0;
		$m.history entryconfigure $ToggleHistoryIndex -label [_ "Popup History List"];
	    }
	}
	update;
    }

    proc ReadHistoryFile {FileName} {
	variable HistoryCnt;
	variable HistoryCntOffset;
	if {[catch {open $FileName "r"} HistoryHandle] == 0} {
	    while { [gets $HistoryHandle line] > 0} {
		ParseHistoryEntry $line;
		incr HistoryCnt;
	    }
	    set HistoryCntOffset $HistoryCnt;
	    close $HistoryHandle;
	} else {
	    ShowMessage [format [_ "Failed to open history file %s"] $FileName];
	}
    }

    proc SaveHistoryList {} {
	variable HistoryRegexps;
	variable HistorySubexps;
	variable HistoryProgs;
	variable HistoryCnt;
	variable HistoryDelimiter;
	variable ProgramFieldWidth;

	if {$HistoryCnt == 0} {
	    ShowMessage [_ "There is nothing on the history list to save."];
	    return;
	}
	set HistorySaveFile [tk_getSaveFile -initialfile [_ "SavedHistoryList"]];
	if {[ string equal $HistorySaveFile ""] ==1} {
	    ShowMessage [_ "File selection cancelled."]
	    return;
	} else {
	    if { [catch {open $HistorySaveFile "w+"} HistorySaveHandle] != 0} {
		ShowMessage [format [_ "Unable to open file %s to save history."] \
				 [MinimizeFileName $HistorySaveFile]];
		return ;
	    }
	}
	for {set i 0} {$i < $HistoryCnt} {incr i} {
	    puts $HistorySaveHandle [format "%*s%s%s%s%s" $ProgramFieldWidth [lindex $HistoryProgs $i] $HistoryDelimiter [lindex $HistoryRegexps $i] $HistoryDelimiter [lindex $HistorySubexps $i]];
	}
	close $HistorySaveHandle;
	ShowMessage [format [_ "History list saved in %s."] [MinimizeFileName $HistorySaveFile]];
    }

    proc ToggleHistoryProgramDisplay {} {
	variable HistoryShowProgP;
	variable HistoryShowProgIndex;
	variable HistoryIsToBeDisplayedP;
	global m;

	if { $HistoryShowProgP == 0} {
	    set HistoryShowProgP 1;
	    $m.history entryconfigure $HistoryShowProgIndex -label [_ "Do Not Show Program"];
	} else {
	    set HistoryShowProgP 0;
	    $m.history entryconfigure $HistoryShowProgIndex -label [_ "Show Program"];
	}
	ConstructHistory;
    }

    proc ToggleHistory {} {
	variable HistoryIsDisplayedP;
	variable HistoryIsToBeDisplayedP;
	variable ToggleHistoryIndex;
	global m;

	if {[winfo exists .hl.hlist] == 0} {
	    if {[ConstructHistory] == 1} {return;}
	}
	if { $HistoryIsDisplayedP == 0} {
	    pack .hl.hlist
	    wm deiconify .hl
	    set HistoryIsDisplayedP 1;
	    set HistoryIsToBeDisplayedP 1;
	    $m.history entryconfigure $ToggleHistoryIndex -label [_ "Hide History"];
	} else {
	    pack forget .hl.hlist
	    wm iconify .hl
	    set HistoryIsDisplayedP 0;
	    set HistoryIsToBeDisplayedP 0;
	    $m.history entryconfigure $ToggleHistoryIndex -label [_ "Popup History"];
	}
    }

    proc HistoryDestroyed {} {
	variable HistoryIsDisplayedP;
	variable HistoryIsToBeDisplayedP;
	variable ToggleHistoryIndex;
	global m;

	set HistoryIsDisplayedP 0;
	set HistoryIsToBeDisplayedP 0;
	$m.history entryconfigure $ToggleHistoryIndex -label [_ "Popup History List"];
    }

    proc AddToHistoryList {re se pr} {
	variable HistoryCnt;
	variable HistoryRegexps;
	variable HistoryMarks;
	variable HistoryProgs;
	variable HistorySubexps;

	incr HistoryCnt;
	lappend HistoryRegexps $re;
	lappend HistoryMarks 0;
	lappend HistoryProgs $pr;
	lappend HistorySubexps $se;
    }

    proc AddToHistoryFile {re se pr} {
	variable HistoryDelimiter;
	variable HistoryListHandle;
	variable ProgramFieldWidth;
	variable RecordHistoryP;

	if {$RecordHistoryP} {
	    puts $HistoryListHandle \
		[format "%*s%s%s%s%s" \
	     $ProgramFieldWidth $pr $HistoryDelimiter $re $HistoryDelimiter $se];
	}
    }

    #Extract the event number from a history entry and convert it into the real
    #index into the history list.
    #We have to strip leading zeroes (including those following a negative sign)
    #so that Tcl won't think that the string represents an octal number.
    proc HistoryEntryToIndex {EntryLine} {
	variable HistoryCntOffset;

	set RawIndexString [string range $EntryLine 0 [string first " " $EntryLine]];
	if {[string match  "-*" $RawIndexString]} {
	    set StrippedString [string trimleft [string range $RawIndexString 1 end] "0"];
	    if {[string equal $StrippedString ""]} {set StrippedString 0}
	    set OffsetIndex [expr 0 - $StrippedString];
	} else {
	    set StrippedString [string trimleft $RawIndexString "0"];
	    if {[string equal $StrippedString ""]} {
		set OffsetIndex 0;
	    } else {
		set OffsetIndex $StrippedString;
	    }
	}
	return [expr $OffsetIndex + $HistoryCntOffset -1];
    }

    #Toggles the marked status of the active entry in the history list.
    proc ToggleHistoryMark {} {
	variable HistoryCnt;
	variable HistoryMarks;

	set RHIndex [HistoryEntryToIndex [.hl.hlist get active]];
	if { [lindex $HistoryMarks $RHIndex] == 1} {
	    set HistoryMarks [lreplace $HistoryMarks $RHIndex $RHIndex 0];
	    .hl.hlist itemconfigure [expr $HistoryCnt - $RHIndex -1] -foreground \#00000000ffff; #blue
	} else {
	    set HistoryMarks [lreplace $HistoryMarks $RHIndex $RHIndex 1];
	    .hl.hlist itemconfigure [expr $HistoryCnt - $RHIndex -1] -foreground \#ffff11111111; #red
	}
    }

    # Insert the regexp and subexp of the active history list entry.
    proc InsertHistoryEntry {} {
	variable HistoryRegexps;
	variable HistorySubexps;

	set hi [HistoryEntryToIndex [.hl.hlist get active]];
	$::REG  insert insert [lindex $HistoryRegexps $hi];
	$::SUB insert insert [lindex $HistorySubexps $hi];
    }

    # Return 0 if created, 1 if not created (due to empty history list).
    proc ConstructHistory {} {
	global ColorSpecs;
	global UseScrollbarsP;
	variable ProgramFieldWidth;
	variable EventNumberFieldWidth;
	variable ProgramFieldWidth;
	variable HistoryRegexps;
	variable HistorySubexps;
	variable HistoryMarks;
	variable HistoryProgs;
	variable HistoryCnt;
	variable HistoryCntOffset;
	variable HistoryIsDisplayedP;
	variable HistoryIsToBeDisplayedP;
	variable HistoryShowProgP;

	pack forget .hl.sbar;
	if {$HistoryCnt == 0} {
	    ShowMessage [_ "There is nothing on the history list."];
	    return 1;
	}
	if {[winfo exists .hl] == 0} {toplevel .hl}
	wm withdraw .hl
	if {[winfo exists .hl.hlist] == 0} {
	    listbox .hl.hlist -height 12 -width 0 -font MainFont \
		-fg $ColorSpecs(HistoryList,Foreground) \
		-bg $ColorSpecs(HistoryList,Background) -yscrollcommand {.hl.sbar set}
	    scrollbar .hl.sbar -command {.hl.hlist yview} \
		-trough $::ColorSpecs(HistoryList,Background);
	    bind .hl.sbar <<B3>> "ScrollbarMoveBigIncrement .hl.sbar 0.20 %x %y"
	} else {.hl.hlist delete 0 end}
	for {set i [expr $HistoryCnt -1]} {$i >= 0} {incr i -1} {
	    set UserIndex [expr $i - $HistoryCntOffset +1];
	    if {$HistoryShowProgP} {
		.hl.hlist insert end [format "%0*d %-*s  %s  %s" $EventNumberFieldWidth \
			  $UserIndex $ProgramFieldWidth [lindex $HistoryProgs $i] \
			  [lindex $HistoryRegexps $i] [lindex $HistorySubexps $i]];
	    } else {
		.hl.hlist insert end [format "%0*d  %s  %s" $EventNumberFieldWidth $UserIndex \
			  [lindex $HistoryRegexps $i] [lindex $HistorySubexps $i]];
	    }
	    if {[lindex $HistoryMarks $i] == 1} {
		.hl.hlist itemconfigure [expr $HistoryCnt - $i -1]  -foreground \#ffff11111111; #red
	    }
	}
	BindKeys .hl;
	bind .hl.hlist <Button-1> {+
	    hist::ToggleHistoryMark;
	}
	bind .hl.hlist <<B3>> {	
	    hist::InsertHistoryEntry;
	}
	bind .hl.hlist <Destroy> {
	    hist::HistoryDestroyed;
	}
	balloonhelp_for .hl.hlist  \
	    [_ "Left click to select and toggle mark.\nRight click to insert into regular expression."];
	if {$HistoryIsToBeDisplayedP} {
	    ShowHistory
	}
	return 0;
    }
}

#Check whether the PCRE regexp extension to PHP is available on this system
proc PHPPCREAvailable {} {
    global CommandFile;

    if {[catch {open $CommandFile "w"} CommandHandle ] != 0} {
	ShowMessage [format [_ "Unable to open %s."] $CommandFile];
	return -2;
    }
    puts $CommandHandle "<?php if (preg_match('t', 't')){\n\t\tprintf('Success\\n');\n}?>";
    close $CommandHandle;
    if { [catch {set result [exec php -f $CommandFile]}] != 0} {
	return 0;
    }
    if { [string length $result]  > 0 } {
	return 1;
    }
    return 0;
}

#Check whether the multibyte extension to PHP is available on this system

proc PHPMBAvailable {} {
    global CommandFile;

    if {[catch {open $CommandFile "w"} CommandHandle ] != 0} {
	ShowMessage [format [_ "Unable to open %s."] $CommandFile];
	return -2;
    }
    puts $CommandHandle "<?php mb_regex_encoding('UTF-8';\nif (mb_ereg('t', 't')){\n\t\tprintf('Success\\n');\n}?>";
    close $CommandHandle;
    if { [catch {set result [exec php -f $CommandFile]}] != 0} {
	return 0;
    }
    if { [string length $result]  > 0 } {
	return 1;
    }
    return 0;
}

# tk_exec is like exec but allows updates while the child process is running.
proc tk_exec_fileevent {id} {
    global tk_exec_data
    global tk_exec_cond
    global tk_exec_pipe

    if {[eof $tk_exec_pipe($id)]} {
	fileevent $tk_exec_pipe($id) readable ""
	set tk_exec_cond($id) 1
	return
    }
    append tk_exec_data($id) [read $tk_exec_pipe($id) 1024]
  }

  proc tk_exec {args} {
      global tk_exec_id
      global tk_exec_data
      global tk_exec_cond
      global tk_exec_pipe

      if {![info exists tk_exec_id]} {
	  set tk_exec_id 0
      } else {
	  incr tk_exec_id
      }
      set keepnewline 0

      for {set i 0} {$i < [llength $args]} {incr i} {
	  set arg [lindex $args $i]
	  switch -glob -- $arg {
	      -keepnewline {
		  set keepnewline 1
	      }
	      -- {
		  incr i
		  break
	      }
	      -* {
		  error "unknown option: $arg"
	      }
	      ?* {
		  break
	      }
	  }
      }
      if {$i > 0} {
	  set args [lrange $args $i end]
      }
      set pipe [open "|$args" r]
      set tk_exec_pipe($tk_exec_id) $pipe
      set tk_exec_data($tk_exec_id) ""
      set tk_exec_cond($tk_exec_id) 0
      set tk_exec_pipe(pid) [lindex [pid $pipe] 0]

      fconfigure $pipe -blocking 0
      fileevent $pipe readable "tk_exec_fileevent $tk_exec_id"
      vwait tk_exec_cond($tk_exec_id)
      if {$keepnewline} {
	  set data $tk_exec_data($tk_exec_id)
      } else {
	  set data [string trimright $tk_exec_data($tk_exec_id) \n]
      }

      unset tk_exec_pipe($tk_exec_id)
      unset tk_exec_data($tk_exec_id)
      unset tk_exec_cond($tk_exec_id)

      if {[catch {close $pipe} err]} {
	  error "pipe error: $err"
      }
      return $data
  }


proc SelectProgram {prog} {
    global Program;
    global program;
    global m;
    global PHPMB;
    global PHPPCRE;
    global ButtonName;
    global ExecName;
    global Features;
    global Locale;
    global LeftImplicitStar;
    global RightImplicitStar;
    global FeatureTestDebugP;
    
    ClearMessageWindow;
    set ::PreviousProgram $program;
    set ActualProgram $prog;
    if {[string range $prog 0 3] == "php-"} {
	set ActualProgram "php";
    }
    set Prog [format "%s%s" [string toupper [string range $ActualProgram 0 0]] [string range $ActualProgram 1 end]];

    #If we're running, tcl is obviously available.
    if {![expr [string equal $ActualProgram "tcl"] || [string equal $ActualProgram "tclglob"]]} {
	if {![info exists ExecName($ActualProgram)]} {
	    ShowMessage [format [_ "Redet does not support the program %s."] $ActualProgram]
	    return 0;
	}
	if { [string length [auto_execok $ExecName($ActualProgram)]]  == 0 } {
	    ShowMessage [format [_ "%s is not available on this machine or not in your path."] $Prog];
	    return 0;
	}
    }
    set ::ProgramInfo($ActualProgram,version) [GetVersion $ActualProgram];

    set PHPMB 0;
    set PHPPCRE 0;
    if { $ActualProgram == "php" } {
	set suffix [string range $prog 4 end];
	if { $suffix == "mb"} {
	    if {[PHPMBAvailable] == 0} {
		set PHPMB 1;
	    } else {
		ShowMessage [_ "The multibyte extension to PHP is not available."];
		return 0;
	    }
	}
	if { $suffix == "pcre"} {
	    if {[PHPPCREAvailable] == 0} {
		set PHPPCRE 1;
	    } else {
		ShowMessage [_ "The PCRE extension to PHP is not available."];
		return 0;
	    }
	}
    }
    set program $ActualProgram;
    set Program $Prog;
    set ButtonName [format "%s%s" [string toupper [string range $prog 0 0]] [string range $prog 1 end]];
    if { [FeaturesUnSetP $program $Locale] } {
	TestFeatures
	RefreshProginfo;
    }
    if {$FeatureTestDebugP} {
	puts "Program is now $program";
	puts "Size of Features array [array size Features]";
    }
    ConstructPalette;
    if { [FeaturesUnSetP $program $Locale] == 0} {
	if {[expr $Features(embedding,$program,$Locale) || $Features(embeddingLeft,$program,$Locale)]} {
	    set LeftImplicitStar "*";
	} else {
	    set LeftImplicitStar "^";
	}
	if {[expr $Features(embedding,$program,$Locale) || $Features(embeddingRight,$program,$Locale)]} {
	    set RightImplicitStar "*";
	} else {
	    set RightImplicitStar "$";
	}
	set ExecLabel [format [_ "Execute-%s%s%s"] $LeftImplicitStar $ButtonName $RightImplicitStar]
    } else {
	set ExecLabel [format [_ "Execute-%s"]  $ButtonName];
    }

    if {$::AquaP} {
	.cmnds.execute configure -text $ExecLabel;
    } else {
	$m entryconfigure 2 -label $ExecLabel;
    }
    UpdateProgramControlPanel;
    CheckUserClassAvailability;
    CheckModeCompatibility;
    return 1;
}

proc CheckUserClassAvailability {} {
    if {[info exists ::Features(alttype,$::program,$::Locale)]} {
	if {$::UserClassCnt > 0 && ($::Features(alttype,$::program,$::Locale) == 0)} {
	    PopupAlert "UserClass" [format [_ "Warning: named character classes are defined\nbut %s does not support them."] $::program];
	    ShowMessage [format [_ "Warning: named character classes are defined\nbut %s does not support them."] $::program];
	}
    }
}

proc CheckModeCompatibility {} {
    if { $::DoSubstitutionsP == 1 &&   ([info exists ::ExecCmd($::program,sub)] ==0) } {
	PopupAlert "Sub" [format [_ "Warning: redet is in substitution mode\nbut %s does not support substitution."] $::program];
	ShowMessage [format [_ "Warning: redet is in substitution mode but %s does not support substitution."] $::program];
	return 0;
    }
    if { $::DoSubstitutionsP == 0 &&   ([info exists ::ExecCmd($::program,match)] ==0) } {
	PopupAlert "Sub" [format [_ "Warning: redet is in match mode\nbut %s does not support matching."] $::program];
	ShowMessage [format [_ "Warning: redet is in match mode but %s does not support matching."] $::program];
	return 0;
    }
    return 1;
}

proc YViewBothPalette {args} {
    set ac [llength $args];
    set a  [lindex $args 0]
    set b  [lindex $args 1]
    if {$ac == 3} {
	set c  [lindex $args 2]
	.pal.lba yview $a $b $c;
	.pal.lbb yview $a $b $c;
    } else {
	.pal.lba yview $a $b;
	.pal.lbb yview $a $b;
    }
}


proc DefineUserEtextProc {name etext} {
    set procname Explain$name
    set etext [lindex $etext 0]
    eval [list "proc" $procname \
	      \
	      "" \
    "global HPWidth;
    global HPLines;
    global HelpPopups;
    if \{\[PopupDown $name\] ==1\} \{return\}
    set po \[CreateTextDisplay \"$name\" \$HPWidth \$HPLines\]
    BindKeys \$po;
    set HelpPopups($name) \$po;
    AppendToTextDisplay \$po \"$etext\""]
}

proc ConstructPalette {} {
    global Palette;
    global Program;
    global program;
    global Locale;
    global Features;
    global PropertyList
    global PropertyUse
    global PaletteIsDisplayedP;
    global PaletteToBeDisplayedP;
    global PaletteFeatures;
    global UserPalette;
    global ButtonName;
    global MaxPaletteHeight;
    global FeatureTestP;
    global ColorSpecs;
    global linkNum;
    set HeightLimit 15

    destroy .pal.lba;
    destroy .pal.lbb;
    destroy .pal.sbar;
    set PaletteIsDisplayedP 0;

    #See if we have a record of palette features for this program.
    if { [FeaturesUnSetP $program $Locale] } {
	ShowMessage [_ "No feature list is available for this program and locale."]
	if {$FeatureTestP == 0} {
	    ShowMessage [_ "Feature testing is disabled."]
	}
	return;
    }
    #See if this program supports any palette features.
    set fcnt 0;
    foreach x $PropertyList {
	if {$PropertyUse($x,PaletteP)} {
	    set fcnt [expr $Features($x,$program,$Locale) + $fcnt];
	}
    }
    set PaletteFeatures [expr $fcnt + $UserPalette($program,0)];
    if {$PaletteFeatures == 0} {
	destroy .pal;
	return;
    }
    if {[winfo exists .pal] == 0} { toplevel .pal; }
    if {[string equal $program agrep]} {
	if {$::ProgramInfo(agrep,TreAgrepP) == 1} {
	    set which "TRE Agrep"
	} elseif {$::ProgramInfo(agrep,TreAgrepP) == 0} {
	    set which "Wu-Manber Agrep"
	} else {
	    set which "Agrep";
	}
	set TitleName $which
    } else {
	set TitleName $ButtonName
    }
    
    wm title .pal [format [_ "Regular Expression Palette for %s"] $TitleName];
    wm withdraw .pal;

    if {$PaletteFeatures < $HeightLimit} {
	set ht $PaletteFeatures;
    } else {
	set ht $HeightLimit;
    }
    text .pal.lba -bd 0 -relief flat \
	-bg $ColorSpecs(PaletteGloss,Background) -fg $ColorSpecs(PaletteGloss,Foreground) -font MainFont \
	-yscrollcommand {.pal.sbar set} -width 62 -height $ht
    text  .pal.lbb -bd 0 -relief flat \
	-bg $ColorSpecs(PaletteNotation,Background) -fg $ColorSpecs(PaletteNotation,Foreground) -font MainFont \
	-yscrollcommand {.pal.sbar set} -width 28 -height $ht

    scrollbar .pal.sbar -command {YViewBothPalette} \
	-troughcolor $::ColorSpecs(PaletteNotation,Background) \
	-bg $::ColorSpecs(PaletteNotation,Background) \
	-activebackground $::ColorSpecs(PaletteScrollbarSlider,Highlight)
    if {$::UseScrollbarsP} {
	pack .pal.sbar -side right -expand 0 -fill y
    }
    bind .pal.sbar <<B3>> "ScrollbarMoveBigIncrement .pal.sbar 0.25 %x %y"
    pack .pal.lba -fill none -expand 0 -side left;
    pack .pal.lbb -fill none    -expand 0 -side right;
    bind .pal.lba <Motion>  {.pal.lbb yview moveto [lindex [.pal.lba yview] 0]}
    bind .pal.lbb <Motion>  {.pal.lba yview moveto [lindex [.pal.lbb yview] 0]}

    bind .pal.lba <Button-1> {+
	.pal.lbb yview moveto [lindex [.pal.lba yview] 0];
	set ::PaletteLineNumber [lindex [split [.pal.lba index @%x,%y] "."] 0]
	MarkPaletteSelection;
    }
    bind .pal.lbb <Button-1> {+
	.pal.lba yview moveto [lindex [.pal.lbb yview] 0];
	set ::PaletteLineNumber [lindex [split [.pal.lbb index @%x,%y] "."] 0]
	MarkPaletteSelection;
    }
    bind .pal.lbb <<B3>> {InsertPaletteEntry}
    bind .pal.lbb <Double-Button-1> {UndoPaletteEntry;break}
    bind .pal.lba <Destroy> {
	destroy .pal.lbb;
	set PaletteIsDisplayedP 0;
	ClearPaletteUndoStacks;
    }
    bind .pal.lbb <Destroy> {
	destroy .pal.lba;
	set PaletteIsDisplayedP 0;
    }
    BindKeys .pal;
    foreach test $PropertyList {
	if {$PropertyUse($test,PaletteP)} {
	    if { $Features($test,$program,$Locale) == 1} {
		if {![info exists Palette($test,gloss)]} {
		    continue ;
		}
		set gloss $Palette($test,gloss);
		set re   $Palette($test,re);
		if {[info exist Palette($test,link)]} {
		    set LinkCode [list ShowInfo $::Palette($test,link)]
		    set tag "link[incr linkNum]"
		    .pal.lba insert end [format " %s\n" $gloss] [list body $tag]
		    .pal.lba tag bind $tag <Enter> \
			".pal.lba tag configure $tag -background $::ColorSpecs(PaletteHighlight,Background);\
		    .pal.lba tag configure $tag -foreground $::ColorSpecs(PaletteHighlight,Foreground)"
		    .pal.lba tag bind $tag <Leave> \
			".pal.lba tag configure $tag -background $::ColorSpecs(PaletteGloss,Background);\
		    .pal.lba tag configure $tag -foreground $::ColorSpecs(PaletteGloss,Foreground)"
		    .pal.lba tag bind $tag <<B3>> \
			"$LinkCode"
		} else {
		    .pal.lba insert end [format " %s\n" $gloss]
		}
		.pal.lbb insert end "\040"
		foreach x $re {
		    .pal.lbb insert end [lindex $x 0] [list [lindex $x 1]]
		}
		.pal.lbb insert end "\n"
	    }
	}
    }
    if {$UserPalette($program,0) > 0} {
	.pal.lba insert end "______________________________________________________________\n"
	.pal.lbb insert end "____________________________\n"
    }
    foreach pe [array names ::UserPalette] {
	set pel [split $pe ","]
	set WhichProgram [lindex $pel 0];
	if {![string equal $WhichProgram $program]} {continue}
	set f [lindex $pel 1]; 
	if {[string equal $f 0]} {continue}
	DefineUserEtextProc $f [lindex $UserPalette($WhichProgram,$f) 1]
	set Body [lindex $UserPalette($WhichProgram,$f) 0]
	set LinkCode [list ShowInfo $f]
	set tag "link[incr linkNum]"
	.pal.lba insert end " $f\n" [list body $tag]
	.pal.lba tag bind $tag <Enter> ".pal.lba tag configure $tag -background $::ColorSpecs(PaletteHighlight,Background);\
		    .pal.lba tag configure $tag -foreground $::ColorSpecs(PaletteHighlight,Foreground)"
	.pal.lba tag bind $tag <Leave> \
		".pal.lba tag configure $tag -background $::ColorSpecs(PaletteGloss,Background);\
		    .pal.lba tag configure $tag -foreground $::ColorSpecs(PaletteGloss,Foreground)"
	.pal.lba tag bind $tag <<B3>> \
		"$LinkCode"
    	.pal.lbb insert end " ";# This keeps the space from being within the tag.
	.pal.lbb insert end  $Body [list F]
	.pal.lbb insert end "\n"
    }
    .pal.lbb tag configure F -background $::ColorSpecs(Palette,Fixed)
    .pal.lbb tag configure V -background $::ColorSpecs(Palette,Variable)
    .pal.lba configure -state disabled
    .pal.lbb configure -state disabled
    balloonhelp_for .pal.lba  \
	[_ "Left click to select. Right click for further information."]
    balloonhelp_for .pal.lbb  \
	[_ "Left click to select. Right click to insert into regular expression.\n\Double left click to undo the insertion.\n"]
    set ::PaletteLineNumber 1;
    if {$PaletteToBeDisplayedP} {
	ShowPalette;
    }
}

proc WritePaletteToFile {} {
    global Program
    global program
    global Locale
    global Features
    global PropertyList
    global FeatureTestP;
    global PropertyUse
    global UserPalette
    global Palette

    #See if we have a record of palette features for this program.
    if { [FeaturesUnSetP $program $Locale] } {
	ShowMessage [_ "No feature list is available for this program and locale."]
	if {$FeatureTestP == 0} {
	    ShowMessage [_ "Feature testing is disabled."]
	}
	return;
    }
    #See if this program supports any palette features.
    set fcnt 0;
    foreach x $::PropertyList {
	if {$::PropertyUse($x,PaletteP)} {
	    set fcnt [expr $Features($x,$program,$Locale) + $fcnt];
	}
    }
    set PaletteFeatures [expr $fcnt + $::UserPalette($program,0)];
    if {$PaletteFeatures == 0} {
	ShowMessage [_ "This program does not support any palette features."]
	return
    }

    #Open file
    set PaletteInfoSaveFile [tk_getSaveFile -initialfile \
			      [format [_ "%sPalette"] $Program]]
    if {[ string equal $PaletteInfoSaveFile ""]} {
	ShowMessage [_ "File selection cancelled."]
	return ;
    } else {
	if { [catch {open $PaletteInfoSaveFile "w+"} PaletteInfoSaveHandle]} {
	    ShowMessage [format \
		     [_ "Unable to open file %s in which to save palette information"] \
			     [MinimizeFileName $PaletteInfoSaveFile]];
	    return ;
	}
    }

    #Identify the precise program we are dealing with
    if {[string equal $Program agrep]} {
	if {$::ProgramInfo(agrep,TreAgrepP) == 1} {
	    set which "TRE Agrep"
	} elseif {$::ProgramInfo(agrep,TreAgrepP) == 0} {
	    set which "Wu-Manber Agrep"
	} else {
	    set which "Agrep";
	}
	set TitleName $which
    } else {
	set TitleName $::ButtonName
    }
    
    #Write out header
    puts $PaletteInfoSaveHandle [format \
	     [_ "Regular Expression Palette for %s in Locale %s."] \
	     $TitleName $Locale];
    puts $PaletteInfoSaveHandle [format \
	     [_ "Program version: %s"] $::ProgramInfo($::program,version)];
    puts $PaletteInfoSaveHandle [format \
	     [_ "Generated %s by Redet %s.\n\n"] [clock format [clock seconds]] $::Version];

    #Write out the internal palette
    foreach test $PropertyList {
	if {$PropertyUse($test,PaletteP)} {
	    if { $Features($test,$program,$Locale) == 1} {
		if {![info exists Palette($test,gloss)]} {
		    continue ;
		}
		set gloss $Palette($test,gloss);
		set re [StripTclQuotes [StripTags $Palette($test,re)]];
		puts $PaletteInfoSaveHandle [format "%-50s\t%s" $gloss $re]
	    }
	}
    }
    #Write out the user palette
    if {$UserPalette($program,0) > 0} {
	puts $PaletteInfoSaveHandle "\#User-defined palette entries"
    }
    foreach x [array names UserPalette] {
	set el [split $x ","];
	set prg [lindex $el 0]; 
	if {![string equal $prg $program]} {continue}
	set en  [lindex $el 1]; 
	if {$en == 0} {continue}
 	puts $PaletteInfoSaveHandle \
 	    [format "%-50s\t%s\n" $en \
		 [StripTclQuotes [StripTags [lindex $::UserPalette($program,$en) 0]]]]
    }
     #Clean up
     close $PaletteInfoSaveHandle;
    ShowMessage [format [_ "Palette saved in file %s."] [MinimizeFileName $PaletteInfoSaveFile]]
} 

proc StripTags {s} {
    return [regsub -all "(^\{)|(\[\u0020\u0009\]\{)| \[FV\]\}" $s ""]
}

proc StripTclQuotes {s} {
    return [regsub -all "\\\\" [regsub -all "\\\]" [regsub -all "\\\[" [regsub -all "\\\}" \
	    [regsub -all "\\\{" $s \{] "\}"] "\["] "\]"] "\\"]
}


 proc MarkPaletteSelection {} {
     .pal.lba tag delete Selected
     .pal.lbb tag delete Selected
     .pal.lba tag add Selected $::PaletteLineNumber.0 $::PaletteLineNumber.end
     .pal.lbb tag add Selected $::PaletteLineNumber.0 $::PaletteLineNumber.end
     .pal.lba tag configure Selected -underline 1
     .pal.lbb tag configure Selected -underline 1
 }

 array set PStack {}
 set PStack($REG) [list]
 set PStack($SUB) [list]

 proc ClearPaletteUndoStacks {} {
     set ::PStack($::REG) [list]
     set ::PStack($::SUB) [list]
 }

 proc InsertPaletteEntry {} {
     set w $::InsertionTarget;
     set str [string trimleft [.pal.lbb get $::PaletteLineNumber.0 $::PaletteLineNumber.end]]
     if {[string equal $w $::SUB] == 0}  {
 	set w $::REG;
     }
     #Push the length of the entry on the stack
     lappend ::PStack($w) [string length $str];
     $w insert insert $str;
 }

 proc UndoPaletteEntry {} {
     set w $::InsertionTarget;
     if {[string equal $w $::SUB] == 0}  {
 	set w $::REG;
     }
     #Pop the stack
     set l $::PStack($w)
     set Last [expr [llength $l] -1];
     if {$Last < 0} {
 	ShowMessage [_ "Nothing remains to delete."]
 	return ;
     }
     set CharsToDelete [lindex $l $Last];
     set ::PStack($w) [lreplace $l $Last $Last];
     #Compute the range to delete and delete it.
     set ins [$w index insert]
     set FirstToDelete [expr $ins - $CharsToDelete]
     $w delete $FirstToDelete $ins;
 }

 proc ShowInfo {TopicList} {
     foreach k $TopicList { 
 	Explain$k
     }
 }

 proc WriteJournal {msg} {
     global JournalHandle;
     puts $JournalHandle $msg;
 }

 proc FlushJournal {} {
     global JournalHandle;
     flush $JournalHandle;
 }

 proc ShowMessage {msg} {
     if {[winfo exists .msg]} {
 	.msg configure -state normal;
 	.msg delete 1.0 end;
 	.msg insert 1.0 $msg;
 	.msg configure -state disabled;
     } else {
 	puts $msg;
     }
     WriteJournal $msg;
 }

 proc ClearMessageWindow {} {
      .msg configure -state normal
      .msg delete 1.0 end;
      .msg configure -state disabled
}

#Write data to temporary test file
proc WriteTestData {tdata} {
    global TestFile;

    if {[catch {open $TestFile "w"} TempDataHandle ] != 0} {
	ShowMessage [format [_ "Unable to open %s."] $TestFile];
	return ;
    }
    puts $TempDataHandle $tdata;
    close $TempDataHandle; 
}

# Check whether we already have tested this combination of
# program and locale. 
proc FeaturesUnSetP {pro loc} {
    global Features;
    if { [info exists Features(tested,$pro,$loc)] } {
	return 0;
    }
    return 1;
}

proc DumpFeatures {pro loc} {
    global Features;

    set fn [format [_ "FeatureList-%s-%s"]  $pro $loc] ;
    set FeatureSaveFile [tk_getSaveFile -initialfile $fn];
    if {[string equal $FeatureSaveFile ""] == 1} {
	return ;
    } else {
        if { [catch {open $FeatureSaveFile "w+"} FeatureSaveHandle] != 0} {
	    ShowMessage [format [_ "Unable to open file %s in which to save features."] \
			     [MinimizeFileName $FeatureSaveFile]];
	    return ;
        }
    }
    set TF [list "F" "T"];
    puts $FeatureSaveHandle [format "%s\t%s" $pro $loc];
    # Extract just the entries for the current program and locale.
    # En passant we convert 0s and 1s to Fs and Ts.
    foreach idx [array names Features] {
	set triple [split $idx ","]
	if { [string equal [lindex $triple 1] $pro] } {
	    if { [string equal [lindex $triple 2]  $loc] } {
		set cd([lindex $triple 0]) [lindex $TF $Features($idx)];
	    }
	}
    }    
    # Now we write out the feature-value pairs in the order of PropertyList;
    foreach test $::PropertyList {
	puts $FeatureSaveHandle [format "\t%-15s  %1s" $test $cd($test)];
    }
    close $FeatureSaveHandle;
}

proc ShowTestProgress {cnt StartTime FeatureCnt} {
    if {[expr $cnt % 5] == 0} {
	if {[winfo exists .placard]} {
	    set TimeElapsed [expr [clock seconds] - $StartTime];
	    set TotalTime [expr double($TimeElapsed) * (double($FeatureCnt)/double($cnt))];
	    set TimeRemaining [expr $TotalTime - $TimeElapsed];
	    set RoundedTimeRemaining [expr round($TimeRemaining)];
	    set RoundedTotalTime [expr round($TotalTime)];
	    set ElapsedMinutes [expr $TimeElapsed / 60]
	    set ElapsedSeconds [expr $TimeElapsed % 60]
	    set TotalMinutes [expr $RoundedTotalTime / 60]
	    set TotalSeconds [expr $RoundedTotalTime % 60]
	    set RemainingMinutes [expr $RoundedTimeRemaining / 60]
	    set RemainingSeconds [expr $RoundedTimeRemaining % 60]

	    SetProgress .placard.progbar $cnt $FeatureCnt;
	    .placard.time configure -text\
		[format [_ "time elapsed: %1d minutes %2d seconds\nestimated total time: %1d minutes %2d seconds\nestimated time remaining: %1d minutes %2d seconds"]\
		     $ElapsedMinutes $ElapsedSeconds  $TotalMinutes $TotalSeconds $RemainingMinutes $RemainingSeconds]
	}
    }
}

proc ExplicateErrorStatus {} {
    global FeatureTestDebugP;
    global FeatureTestLogHandle;
    switch -exact -- [lindex $::errorCode 0] {
	CHILDKILLED {
	    foreach { - pid sigName msg } $::errorCode break
	    if {$FeatureTestDebugP} {
		puts $FeatureTestLogHandle [format "Child process %d died on signal %s" $pid $sigName];
		puts $FeatureTestLogHandle [format "Error message: %s" $msg];
	    }
	}
	CHILDSTATUS {
	    foreach { - pid code } $::errorCode break
	    if {$FeatureTestDebugP} {
		puts $FeatureTestLogHandle [format "Child process %d exited with error code %d" $pid $code];
	    }
	}
	CHILDSUSP {
	    foreach { - pid sigName msg } $::errorCode break
	    if {$FeatureTestDebugP} {
		puts $FeatureTestLogHandle [format "Child process %d has been suspended due to signal %d" $pid $sigName];
		puts $FeatureTestLogHandle [format "Error message: %s" $msg];
	    }
	}
	POSIX {
	    foreach { - errName msg } $::errorCode break
	    if {$FeatureTestDebugP} {
		puts $FeatureTestLogHandle \
		    [format "One of the kernel calls to launch the command failed with error %s" $errName];
		puts $FeatureTestLogHandle [format "Error message: %s" $msg];
	    }
	}
    }
}


proc SetCompoundFeatures {} {
    global Features;
    global program;
    global Locale;

    set Features(alttype,$program,$Locale) 0;
    if {$Features(pipebs,$program,$Locale) == 1} {
	set Features(alttype,$program,$Locale) 3; # (a\|b)
    }
    if {$Features(pipe,$program,$Locale) == 1} {
	set Features(alttype,$program,$Locale) 2; # (a|b)
    }
    if {$Features(pipedbs,$program,$Locale) == 1} {
	set Features(alttype,$program,$Locale) 6; # (a\\|b)
    }
    if {$Features(pipedbsall,$program,$Locale) == 1} {
	set Features(alttype,$program,$Locale) 7; # \\(a\\|b\\)
    }
    if {$Features(altcomma,$program,$Locale) == 1} {
	set Features(alttype,$program,$Locale) 4; # {a,b}
    }
    if {$Features(piperebol,$program,$Locale) == 1} {
	set Features(alttype,$program,$Locale) 5; # ("a"|"b")
    }
    # In programs that have them, sets are more efficient than alternation, so we
    # let sets override alternation if they are available.
    if {$Features(set,$program,$Locale) == 1} {
	set Features(alttype,$program,$Locale) 1;# [ab]
    }

    #Compound tests for Selfish quantifiers
    if {$Features(PossStarA,$program,$Locale) && $Features(PossStarB,$program,$Locale)} {
	set Features(PossStar,$program,$Locale) 1;
    } else {
	set Features(PossStar,$program,$Locale) 0;
    }

    if {$Features(PossPlusA,$program,$Locale) && $Features(PossPlusB,$program,$Locale)} {
	set Features(PossPlus,$program,$Locale) 1;
    } else {
	set Features(PossPlus,$program,$Locale) 0;
    }

    if {$Features(PossQMarkA,$program,$Locale) && $Features(PossQMarkB,$program,$Locale)} {
	set Features(PossQMark,$program,$Locale) 1;
    } else {
	set Features(PossQMark,$program,$Locale) 0;
    }

    if {$Features(PossAtLeastMA,$program,$Locale) && $Features(PossAtLeastMB,$program,$Locale)} {
	set Features(PossAtLeastM,$program,$Locale) 1;
    } else {
	set Features(PossAtLeastM,$program,$Locale) 0;
    }

    if {$Features(PossMToNA,$program,$Locale) && \
	    $Features(PossMToNB,$program,$Locale) && \
	    $Features(PossMToNC,$program,$Locale)} {
	set Features(PossMToN,$program,$Locale) 1;
    } else {
	set Features(PossMToN,$program,$Locale) 0;
    }

    if {$Features(SelfishNoCaptureGroupA,$program,$Locale) &&\
	    $Features(SelfishNoCaptureGroupB,$program,$Locale) &&\
	    $Features(SelfishNoCaptureGroupC,$program,$Locale) } {
	set Features(SelfishNoCaptureGroup,$program,$Locale) 1;
    } else {
	set Features(SelfishNoCaptureGroup,$program,$Locale) 0;
    }
    # Case-sensitivity
    if {$Features(flagiAsciiLiteral,$program,$Locale)} {
	set Features(flagi,$program,$Locale) 1;
    } else {
	set Features(flagi,$program,$Locale) 0;
    }

    if {$Features(flagiuNonAsciiLiteral,$program,$Locale)} {
	set Features(flagiu,$program,$Locale) 1;
    } else {
	set Features(flagiu,$program,$Locale) 0;
    }

    #Miscellaenous
    if {($Features(atsignonenext,$program,$Locale) == 1) &&\
	    ($Features(group,$program,$Locale) == 0)  &&\
	    ($Features(groupbs,$program,$Locale) == 0)  &&\
	    ($Features(groupdbs,$program,$Locale) == 0)  &&\
	    ($Features(ncgroup,$program,$Locale) == 0)  &&\
	    ($Features(ncgroupdb,$program,$Locale) == 0)} {
	set Features(ObligatoryQuantifierGroup,$program,$Locale) 1;
    } else {
	set Features(ObligatoryQuantifierGroup,$program,$Locale) 0;
    }
}

proc TestFeatures {} {
    global DoSubstitutionsP;
    global ExecCmd;
    global Program;
    global program;
    global Features;
    global RegexpResult;
    global ComparisonData;
    global ComparisonDataFromWindowP;
    global FeatureTestDebugP;
    global TestData;
    global Intended;
    global Regexp;
    global TestRegexp;
    global TestSubexp;
    global Locale;
    global errorCode;
    global TestingFeaturesP;
    global FeatureTestP;

    if {$FeatureTestP == 0} {
	ShowMessage [_ "Feature testing is disabled."];
	return;
    }
    if {[string equal $program agrep]} {
	WhichAgrep;
    }
    set TestingFeaturesP 1;
    PopupTestPatiencePlacard \
	[format [_ "Testing features of %1\$s in locale %2\$s\nand constructing palette.\nPlease be patient."]  $Program $Locale] $::FirstTestP;
    update;
    set RedetFeatureTestFile [_ "RedetFeatureTestFile"];
    set StartTime [clock seconds];

    #We need to prevent the comparison data from being read from 
    #the window, but it is perfectly possible that a user
    #will change programs while in edit mode, so we save
    #the comparison data source, set it to non-window, then
    #restore it when we are done.
    set SaveComparisonDataFromWindowP $ComparisonDataFromWindowP;
    set ComparisonDataFromWindowP 0;

    if {$FeatureTestDebugP} {
	if {[catch {open $RedetFeatureTestFile "w"} FeatureTestLogHandle ] != 0} {
	    ShowMessage [format [_ "Unable to open %s."] $RedetFeatureTestFile];
	    return ;
	}
	puts $FeatureTestLogHandle [format [_ "%s Locale: %s"] \
			[clock format [clock seconds]] $::Locale]
	puts $FeatureTestLogHandle 
    }
    set tcnt 0;
    set FeatureCnt 0;
    foreach test $::PropertyList {
	if {$::PropertyUse($test,TestP)} {incr FeatureCnt}
    }
    #We can't do tests properly with global costs non-zero in those programs that
    #do approximate matching.
    if {[info exists ::ProgramInfo($::program,TotalCost)] } {
	set SavedTotalCost $::ProgramInfo($::program,TotalCost);
	set ::ProgramInfo($::program,TotalCost) 0;
    }
    set SavedDoSubstitutionsP $DoSubstitutionsP;
    set DoSubstitutionsP 0;#For now we have to run the tests in match mode no matter what.
    foreach test $::PropertyList {
	if {$::AbortFeatureTestP} {
	    set ::AbortFeatureTestP 0;
	    if {[info exists ::Features(tested,$program,$Locale)]} {
		unset ::Features(tested,$program,$Locale);
	    }
	    set DoSubstitutionsP $SavedDoSubstitutionsP;
	    set ComparisonData "";
	    set RegexpResult "";
	    set ComparisonDataFromWindowP $SaveComparisonDataFromWindowP;
	    destroy .placard;
	    set TestingFeaturesP 0;
	    if {$FeatureTestDebugP} {
		puts $FeatureTestLogHandle [_ "Test run aborted by user."];
		close $FeatureTestLogHandle;
	    }
	    ShowMessage [_ "Test run aborted by user."];
	    if {[SelectProgram $::InitialProgram] != 1} {
		after 5000; #Give the user a chance to see the message
		SelectProgram tcl
	    }
	    return ;
	}
	if {$::PropertyUse($test,TestP) == 0} {continue}
	#This seems like an awful kludge, but the selfish quantifier tests hang emacs 
	#and mawk for some reason.
	if {[regexp {^Poss.*} $test]} {
	    if { ([string equal $program "mawk"]) || ([string equal $program "emacs"]) } {
		set ::Features($test,$program,$Locale) 0;
		continue ;
	    }
	}				
	# Python hangs when given a subbackref index greater than 9.
	if {[string equal $test SubBackRefbsAtLeastTen]} {
	    if {[string equal $program python]} {
		set ::Features($test,$program,$Locale) 0;
		continue;
	    }
	}
	incr tcnt;
	ShowTestProgress $tcnt $StartTime $FeatureCnt;
	if {$FeatureTestDebugP} {
	    puts -nonewline $FeatureTestLogHandle  [format "\[%3d/%3d\] %s - test %s" $tcnt $FeatureCnt $Program $test];
	}
	WriteTestData $TestData($test);
	set Features($test,$program,$Locale) 0;
	set RegexpResult "";
	set ComparisonData $Intended($test);
	if {[string equal [string range $test 0 2] "Sub"]} {
	    if {[info exists ExecCmd($program,sub)]} {
		set SubExp $TestSubexp($test)
		set status [catch { $ExecCmd($program,sub) $TestRegexp($test) $SubExp} RegexpResult];
	    } else {
		if {$FeatureTestDebugP} { puts $FeatureTestLogHandle "\tn/a - skipped"}
		continue
	    }
	} else {
	    set SubExp "";
	    if {[info exists ExecCmd($program,match)]} {
		if {[info exists ExecCmd($program,match,$test)]} {
		    set tx $ExecCmd($program,match,$test);
		    set status [catch { $ExecCmd($program,match) $TestRegexp($test) $tx} RegexpResult];
		} else {
		    set status [catch { $ExecCmd($program,match) $TestRegexp($test)} RegexpResult];
		}
	    } else {
		if {$FeatureTestDebugP} { puts $FeatureTestLogHandle "\tn/a - skipped"}
		continue
	    }
	}
	set RegexpResult [string trimright $RegexpResult "\n"];
	# Command succeeded and wrote nothing to stderr.
	if { $status == 0} {
	    if {[string equal $program "tcsh"] || \
		    [string equal $program "bash"] || \
		    [string equal $program "rc"] || \
		    [string equal $program "ksh"] || \
		    [string equal $program "fish"] } {
		set RegexpResult [lsort $RegexpResult]
		set ComparisonData [lsort $ComparisonData]
	    }
	    if {[string equal $RegexpResult $ComparisonData]} {
		set Features($test,$program,$Locale) 1;
		if {$FeatureTestDebugP} {
		    puts $FeatureTestLogHandle "\t\tPassed"
   puts $FeatureTestLogHandle "Regexp: $TestRegexp($test)\n"
		    if {[string equal $SubExp ""] == 0} {
			puts $FeatureTestLogHandle "Subexp: $SubExp\n"
		    }
		    puts $FeatureTestLogHandle [format "Result:\n%s\nIntended:\n%s" $RegexpResult $ComparisonData];
		}
	    } else {
		set Features($test,$program,$Locale) 0;
		if {$FeatureTestDebugP} {
		    puts $FeatureTestLogHandle "\t\tFailed on diff";
		    puts $FeatureTestLogHandle "Regexp: $TestRegexp($test)\n"
		    if {[string equal $SubExp ""] == 0} {
			puts $FeatureTestLogHandle "Subexp: $SubExp\n"
		    }
		    puts $FeatureTestLogHandle [format "Result:\n%s\nIntended:\n%s" $RegexpResult $ComparisonData];
		}
	    }
	} elseif { [string equal $::errorCode NONE] } {
	    # The command exited with a normal status, but wrote something
	    # to stderr, which is included in RegexpResult.
	    set Features($test,$program,$Locale) 0;
	    if {$FeatureTestDebugP} {
		puts $FeatureTestLogHandle "\tCommand exited normally but failed due to output to stderr: $errorCode";
		puts $FeatureTestLogHandle "RegexpResult = $RegexpResult";
	    }
	} else {
	    set Features($test,$program,$Locale) 0;
	    if {$FeatureTestDebugP} {
		puts $FeatureTestLogHandle "\tCommand exited abnormally\nRegexpResult = $RegexpResult";
	    }
	    ExplicateErrorStatus;
	}
	if {$FeatureTestDebugP} {
	    flush $FeatureTestLogHandle;
	}
    }; #End of loop over feature tests
    # Implications
    if {$Features(taggedgroup,$program,$Locale)} {
	set Features(taggedgroupref,$program,$Locale) 1;
    } else {
	set Features(taggedgroupref,$program,$Locale) 0;
    }

    # We don't need to set to 0 in the else case because that will already have been done
    # when dollar was tested for.
#    if {$Features(AbsoluteEndOfString,$program,$Locale)} {
#	set Features(dollar,$program,$Locale) 1;
#    }

    if {$Features(CondLookaroundSimple,$program,$Locale)} {
	set Features(CondPosLookaheadSimple,$program,$Locale) 1;
	set Features(CondPosLookbackSimple,$program,$Locale) 1;
	set Features(CondNegLookaheadSimple,$program,$Locale) 1;
	set Features(CondNegLookbackSimple,$program,$Locale) 1;
    } else {
	set Features(CondPosLookaheadSimple,$program,$Locale) 0;
	set Features(CondPosLookbackSimple,$program,$Locale) 0;
	set Features(CondNegLookaheadSimple,$program,$Locale) 0;
	set Features(CondNegLookbackSimple,$program,$Locale) 0;
    }

    if {$Features(CondLookaroundElse,$program,$Locale)} {
	set Features(CondPosLookaheadElse,$program,$Locale) 1;
	set Features(CondPosLookbackElse,$program,$Locale) 1;
	set Features(CondNegLookaheadElse,$program,$Locale) 1;
	set Features(CondNegLookbackElse,$program,$Locale) 1;
    } else {
	set Features(CondPosLookaheadElse,$program,$Locale) 0;
	set Features(CondPosLookbackElse,$program,$Locale) 0;
	set Features(CondNegLookaheadElse,$program,$Locale) 0;
	set Features(CondNegLookbackElse,$program,$Locale) 0;
    }

    SetCompoundFeatures;

    #To force a feature to appear in the palette for debugging purposes,
    #Insert its name in place of F below and uncomment.
    #set Features(F,$program,$Locale) 1;
#    set Features(BooleanAnd,$program,$Locale) 1;

    #Clean up
    set ComparisonData "";
    set RegexpResult "";
    set ComparisonDataFromWindowP $SaveComparisonDataFromWindowP;
    destroy .placard;
    set TestingFeaturesP 0;
    if {$FeatureTestDebugP} {
	puts $FeatureTestLogHandle [format [_ "Elapsed time: %d seconds."] [expr [clock seconds] - $StartTime]];
	close $FeatureTestLogHandle;
    }
    set DoSubstitutionsP $SavedDoSubstitutionsP;
    if {[info exists ::ProgramInfo($::program,TotalCost)] } {
	set ::ProgramInfo($::program,TotalCost) $SavedTotalCost;
    }
    set ::UpdateJavaByteCodeP 1;
    set ::FirstTestP 0;
    set ::Features(tested,$program,$Locale) 1;
}

#Shut down gracefully.
proc ShutDown {} {

    WriteJournal [format [_ "Session ended: %s\n"] [clock format [clock seconds]]];
    close $hist::HistoryListHandle;
    close $::JournalHandle;
    #Clean up temp files.
    #Use -f flag so that there is no error if a file does not exist.
    if {$::DebugP} {
	puts [format [_ "Temporary files left in %s. Clean up when you're done."] $::TempDir];
    } else {
	file delete -force $::CommandFile;
	file delete -force $::JavaMatchClassFile;
	file delete -force $::JavaMatchFile;
	file delete -force $::JavaSubClassFile;
	file delete -force $::JavaSubFile;
	file delete -force $::TestFile;
	file delete -force $::TempCompFile;
	file delete -force $::TempOutputFile;
	file delete -force $::TempSortFile;
	file delete -force $::TempGlobDir;
	file delete -force $::DiffResultFile;
	file delete -force $::EmacsWrapper
	file delete -force $::EmacsOutputFile
	file delete -force $::VersionFile
    }
    #Shutdown child browsers
    foreach pid $::BrowserPIDS {
	catch {exec kill $pid};
    }
    exit 0;
}

proc SaveRegexpAsHistory {} {
    global program;

    set rexp [string trim [$::REG get] "\n"];
    set sexp ""; # Just to be safe.
    set sexp [string trim [$::SUB get] "\n"];
    if {$rexp == ""} {
	ShowMessage [_ "There is no regular expression to save."];
	return;
    }
    set ReSaveFile [tk_getSaveFile -initialfile "Regexp"];
    if {$ReSaveFile != ""} {
	if {[catch {open $ReSaveFile "w"} ReSaveHandle ] != 0} {
	    ShowMessage [format [_ "Unable to open %s."] [MinimizeFileName $ReSaveFile]];
	    return;
	}
	puts $ReSaveHandle [format "%-*s%s%s%s%s" $hist::ProgramFieldWidth $program $hist::HistoryDelimiter $rexp $hist::HistoryDelimiter $sexp];
	close $ReSaveHandle;
	ShowMessage [format [_ "Regular expression saved in %s."] [MinimizeFileName $ReSaveFile]];
    }
}

proc SaveRegexpPlain {} {
    global program;

    set rexp [string trim [$::REG get] "\n"];
    set sexp ""; # Just to be safe.
    set sexp [string trim [$::SUB get] "\n"];
    if {$rexp == ""} {
	ShowMessage [_ "There is no regular expression to save."];
	return;
    }
    set ReSaveFile [tk_getSaveFile -initialfile "RegularExpression"];
    if {$ReSaveFile != ""} {
	if {[catch {open $ReSaveFile "w"} ReSaveHandle ] != 0} {
	    ShowMessage [format [_ "Unable to open %s."] [MinimizeFileName $ReSaveFile]];
	    return;
	}
	puts $ReSaveHandle $rexp;
	close $ReSaveHandle;
	ShowMessage [format [_ "Regular expression saved in %s."] [MinimizeFileName $ReSaveFile]];
    }
}

proc SaveSubexpPlain {} {
    global program;

    set sexp [string trim [$::SUB get] "\n"];
    if {$sexp == ""} {
	ShowMessage [_ "There is no substitution expression to save."];
	return;
    }
    set SeSaveFile [tk_getSaveFile -initialfile "SubstitutionExpression"];
    if {$SeSaveFile != ""} {
	if {[catch {open $SeSaveFile "w"} SeSaveHandle ] != 0} {
	    ShowMessage [format [_ "Unable to open %s."] [MinimizeFileName $SeSaveFile]];
	    return;
	}
	puts $SeSaveHandle $sexp;
	close $SeSaveHandle;
	ShowMessage [format [_ "Substitution expression saved in %s."] [MinimizeFileName $SeSaveFile]];
    }
}

proc SaveOutput {} {
    global RegexpResult;
    global OutputFromWindowP;

    if {$OutputFromWindowP} {
	set RegexpResult [$::OUT get 1.0 end];
    }
    if {$RegexpResult == ""} {
	ShowMessage [_ "There is no output to save."];
	return ;
    }
    set OutputSaveFile [tk_getSaveFile -initialfile [_ "REDETOutput"]];
    if {$OutputSaveFile == ""} {
	ShowMessage [format [_ "Unable to open %s."] [MinimizeFileName $OutputSaveFile]];
	return ;
    }
    if {[catch {open $OutputSaveFile "w"} OutputSaveHandle ] != 0} {
	ShowMessage [format [_ "Unable to open file %s to save regular expression output."] \
			 [MinimizeFileName $OutputSaveFile]];
	return ;
    }
    puts $OutputSaveHandle $RegexpResult;
    close $OutputSaveHandle;

    ShowMessage [format [_ "Regular expression output saved in %s."] [MinimizeFileName $OutputSaveFile]];
}

proc TogglePalette {} {
    global PaletteIsDisplayedP;
    global PaletteToBeDisplayedP;
    global Program;
    global PaletteFeatures;
    global FeatureTestP;

    if {$::TestingFeaturesP} {
	ShowMessage [_ "Testing of palette features is in progress. Please wait a moment."]
	return ;
    }

    if {$PaletteFeatures == 0} {
	if {$FeatureTestP == 0} {
	    ShowMessage [_ "Feature testing is disabled."];
	} else {
	    ShowMessage [format [_ "%s does not support any palette entries."] $Program];
	}
	return;
    }

    if {[winfo exists .pal.lba] == 0} {ConstructPalette;}

    if { $PaletteIsDisplayedP == 0} {
	ShowPalette;
	set PaletteIsDisplayedP 1;
	set PaletteToBeDisplayedP 1;
    } else {
	wm withdraw .pal
	pack forget .pal.lba
	pack forget .pal.lbb
	set PaletteIsDisplayedP 0;
	set PaletteToBeDisplayedP 0;
    }
}



proc ShowPalette {} {
    pack .pal.lba -fill x -expand 1 -side left;
    pack .pal.lbb -fill x -expand 1 -side left;
    wm deiconify .pal
}

# The following sets up a progress bar.
option add *Progress.undoneForeground black  widgetDefault
option add *Progress.undoneBackground white  widgetDefault
option add *Progress.doneForeground   white  widgetDefault
option add *Progress.doneBackground   \#EFAC49 widgetDefault
option add *Progress.borderWidth      3      widgetDefault
option add *Progress$.relief           sunken widgetDefault

namespace eval dkfprogress {
    namespace export Progress SetProgress

    proc Progress {w args} {
	uplevel 1 [list frame $w -class Progress] $args

	foreach {val} {
	    undoneForeground doneForeground
	    undoneBackground doneBackground
	} {
	    set class [string toupper [string index $val 0]\
		    ][string range $val 1 end]
	    set $val [option get $w $val $class]
	}

	set varname [namespace current]::progressPercent($w)
	frame $w.l -borderwidth 0 -background $undoneBackground
	label $w.l.l -textvariable $varname -borderwidth 0 \
		-foreground $undoneForeground -background $undoneBackground
	$w.l configure -height [expr {int([winfo reqheight $w.l.l]+2)}]
	frame $w.l.fill -background $doneBackground
	label $w.l.fill.l -textvariable $varname -borderwidth 0 \
		-foreground $doneForeground -background $doneBackground

	bind $w.l <Configure> [namespace code [list ProgressConf $w "%w"]]

	pack $w.l -fill both -expand 1
	place $w.l.l -relx 0.5 -rely 0.5 -anchor center
	place $w.l.fill -x 0 -y 0 -relheight 1 -relwidth 0
	place $w.l.fill.l -x 0 -rely 0.5 -anchor center

	SetProgress $w 0
	return $w
    }

    proc ProgressConf {w width} {
	place conf $w.l.fill.l -x [expr {int($width/2)}]
    }

    proc ColorSequence n {
	if {$n<0} {set n 0} elseif {$n>100} {set n 100}
	set green 0; 
	set red 0;
	set blue 0;
	set red  [expr int(2.55 *(100 - $n))];
	set green [expr  int(2.55 * $n)];
	return [format "#%02x%02x%02x" $red $green $blue];
    }

    proc SetProgress {win value {range 100}} {
	set progress [expr {int(100*$value)/int($range)}]
	set relwidth [expr {double($value)/double($range)}]
	variable progressPercent
	place conf $win.l.fill -relwidth $relwidth
	.placard.progbar.l.fill configure -bg [ColorSequence $progress];
	set progressPercent($win) "${progress}%"
    }
}

namespace import dkfprogress::Progress dkfprogress::SetProgress

#This works, but it could probably be made more efficient if we figured out
#what the cause of the extra newlines is and eliminated them at the source.
proc CountChanges {a b} {
    if { [string length $a] < 1} {return 0;}
    if { [string length $b] < 1} {return 0;}
    set a [string trimright $a "\n"];
    set b [string trimright $b "\n"];
    set ALines [split $a "\n"];
    set BLines [split $b "\n"];
    set ALength [llength $ALines];
    set BLength [llength $BLines];
    if {$ALength != $BLength} {
	ShowMessage [_ "Substitution error: input and output do not contain the same number of lines"];
	puts [format "len(a) = %d\tlen(B) = %d" $ALength $BLength];
	return -1;
    }
    set ChangeCount 0;
    for {set i 0} {$i < $ALength} {incr i} {
	if { [string equal [lindex $ALines $i]  [lindex $BLines $i]] != 1} {
	    incr ChangeCount;
	}
    }
    return $ChangeCount;
}

proc GetChanges {a b} {
    set ChangedLines [list];
    set a [string trimright $a "\n"];
    set b [string trimright $b "\n"];
    set ALines [split $a "\n"];
    set BLines [split $b "\n"];
    set ALength [llength $ALines];
    set BLength [llength $BLines];
    if {$ALength != $BLength} {
	ShowMessage [format [_ "Possible substitution error: test lines %d != output lines %d"] $ALength $BLength];
    }
    if {$ALength < $BLength} {
	set len $ALength;
    } else {
	set len $BLength;
    }
    for {set i 0} {$i < $len} {incr i} {
	set BLine [lindex $BLines $i];
	if { [string equal [lindex $ALines $i]  $BLine] != 1} {
	    lappend ChangedLines $BLine;
	}
    }
    return $ChangedLines;
}

proc CountChars {t} {
    return  [llength [split $t ""]];
}
					
#This is MUCH faster than directly counting newline characters.
proc CountLines {s} {
    if { [string length $s] < 1} {return 0;}
    return [llength [split $s "\n"]];
}

proc ToggleSubstitutionMode {} {
    global DoSubstitutionsP;
    global m;
    global SubstitutionModeIndex;
    global Features;
    global program;

    if {$DoSubstitutionsP == 0} {
	set DoSubstitutionsP 1;
	ShowMessage [_ "Entering substitution mode."]
	$m.configure entryconfigure $SubstitutionModeIndex -label \
	    [_ "Change to Match Mode"];
	CheckModeCompatibility;
	if {$::StandardConfigurationP} {
	    set ::SideBySideLayoutP 1;
	    set ::RegSubSideBySideP 1;
	}
    } else {
	set DoSubstitutionsP 0;
	ShowMessage [_ "Entering match mode."]
	$m.configure entryconfigure $SubstitutionModeIndex -label \
	    [_ "Change to Substitution Mode"];
	CheckModeCompatibility;
	if {$::StandardConfigurationP} {
	    set ::SideBySideLayoutP 0;
	    set ::RegSubSideBySideP 0;
	}
    }
    SetRegReturnBinding;
    SetTitle $::Version [ProgramTimeDateStamp] $::Locale $::DoSubstitutionsP;
    LayoutWindows;
}

proc InOutScrollLinkage {} {
    global DoSubstitutionsP;
    global OutputOnlyChangedLinesP;
    if {$DoSubstitutionsP} {
	if {$OutputOnlyChangedLinesP == 0} {
	    bind $::IND  <Motion>  {$::OUT yview moveto [lindex [$::IND yview] 0]}
	    bind $::OUT <Motion>  {$::IND yview moveto [lindex [$::OUT yview] 0]}
	    return ;
	}	      
    }
    bind $::IND  <Motion> "";  
    bind $::OUT <Motion> "";
}


#Character entry code begins here
#Set this to the path to character entry menu
set CEM .menubar.tools.charentry
#Set the default insertion target here.
set InsertionTarget $::REG;
#Anywhere that you want to insert characters, set up a binding like this:
#bind WIDGETPATHNAME <FocusIn> {SetInsertionTargets WIDGETPATHNAME}

set DisplayConsonantChartColumnLabelsP 1
set DisplayConsonantChartRowLabelsP 1
set DisplayVowelChartColumnLabelsP 1
set DisplayVowelChartRowLabelsP 1

proc BindInsertionTarget {v} {
    bind $v <FocusIn> "+SetInsertionTargets $v"
}

option add *ipaec.Button.font CharacterEntryFont 100
option add *ipaec.Label.background  $ColorSpecs(IPAEntry,Background)
option add *ipaec.Button.background $ColorSpecs(IPAEntry,Background)
option add *ipaec.Button.foreground $ColorSpecs(IPAEntry,Foreground)
option add *ipaec.Label.relief raised

option add *ipaev.Button.font CharacterEntryFont 100
option add *ipaev.Label.background  $ColorSpecs(IPAEntry,Background)
option add *ipaev.Button.background $ColorSpecs(IPAEntry,Background)
option add *ipaev.Button.foreground $ColorSpecs(IPAEntry,Foreground)
option add *ipaev.Label.relief raised

option add *ipaea.Button.font AccentedLetterFont 100
option add *ipaea.Label.background  "\#E0E0E0"
option add *ipaea.Button.background "\#FFFFFF"
option add *ipaea.Button.foreground "\#000000"
option add *ipaea.Label.relief raised

option add *ipaed.Button.font DiacriticFont 100
#option add *ipaed.Label.background  $ColorSpecs(IPAEntry,Background)
option add *ipaed.Button.background "\#E0E0FF"
option add *ipaed.Label.background "\#E0E0E0"
option add *ipaed.Button.foreground "\#000000"
option add *ipaed.Label.relief raised

proc SetInsertionTargets {tgt} {
    set ::InsertionTarget $tgt;
    set ::CharByCodeInsertionTarget $tgt;
}

option add *ipae*.*Label.font CharacterEntryLabelFont 100
option add *ipaec.*Button.font CharacterEntryFont 100
namespace eval ipaentry {
    variable IPAECColumnLabelList [list];
    variable IPAECRowLabelList [list];
    variable IPAEVColumnLabelList [list];
    variable IPAEVRowLabelList [list];

    set row 0;
    variable poa $row;
    incr row;
    variable vlstop $row;
    incr row;
    variable vdstop $row;
    incr row;
    variable vdimplosive $row;
    incr row;
    variable click $row;
    incr row;
    variable nasal  $row;
    incr row;
    variable trill $row;
    incr row;
    variable tap $row;
    incr row;
    variable vlfric $row;
    incr row;
    variable vdfric $row;
    incr row;
    variable vlaffric $row;
    incr row;
    variable vdaffric $row;
    incr row;
    variable approx $row;
    incr row; 
    variable latapprox $row;
    variable lastrow $row;

    set col 0;
    variable manner $col; 
    incr col;
    variable labial $col; 
    incr col;
    variable labiodental $col; 
    incr col;
    variable dental $col; 
    incr col;
    variable alveolar $col;
    incr col;
    variable postalveolar $col; 
    incr col;
    variable retroflex $col; 
    incr col;
    variable palatal $col; 
    incr col;
    variable velar $col; 
    incr col;
    variable uvular $col; 
    incr col;
    variable pharyngeal $col; 
    incr col;
    variable epiglottal $col; 
    incr col;
    variable glottal $col;
    variable lastcolumn $col;

    proc cfesh {} {
	variable vlfric
	variable postalveolar
	eval [list [format ".ipaec.r%dc%d" $vlfric $postalveolar] configure -text "\u0161"];
    }
    proc cresh {} {
	variable vlfric
	variable postalveolar
	eval [list [format ".ipaec.r%dc%d" $vlfric $postalveolar] configure -text "\u0283"];
    }

    proc cfeshr {} {
	variable vlfric
	variable retroflex
	eval [list [format ".ipaec.r%dc%d" $vlfric $retroflex] configure -text "\u1E63"];
    }
    proc creshr {} {
	variable vlfric
	variable retroflex
	eval [list [format ".ipaec.r%dc%d" $vlfric $retroflex] configure -text "\u0282"];
    }

    proc cryod {} {
	variable approx
	variable palatal
	eval [list [format ".ipaec.r%dc%d" $approx $palatal] configure -text "j"];
    }

    proc cfyod {} {
	variable approx
	variable palatal
	eval [list [format ".ipaec.r%dc%d" $approx $palatal] configure -text "y"];
    }

    proc crny {} {
	variable nasal
	variable palatal
	eval [list [format ".ipaec.r%dc%d" $nasal $palatal] configure -text "\u0272"];
    }
    proc cfny {} {
	variable nasal
	variable palatal
	eval [list [format ".ipaec.r%dc%d" $nasal $palatal] configure -text "\u00F1"];
    }

    proc crch {} {
	variable vlaffric
	variable postalveolar
	eval [list [format ".ipaec.r%dc%d" $vlaffric $postalveolar] configure -text "t\u0283"];
    }
    proc cfch {} {
	variable vlaffric
	variable postalveolar
	eval [list [format ".ipaec.r%dc%d" $vlaffric $postalveolar] configure -text "\u010D"];
    }

    proc crchr {} {
	variable vlaffric
	variable retroflex
	eval [list [format ".ipaec.r%dc%d" $vlaffric $retroflex] configure -text "\u0288\u0282"];
    }

    proc cfchr {} {
	variable vlaffric
	variable retroflex
	eval [list [format ".ipaec.r%dc%d" $vlaffric $retroflex] configure -text "\u1E6D\u1E63"];
    }


    proc crdj {} {
	eval [list [format ".ipaec.r%dc%d" $ipaentry::vdaffric $ipaentry::postalveolar] configure -text "d\u0292"];
    }

    proc cfdj {} {
	eval [list [format ".ipaec.r%dc%d" $ipaentry::vdaffric $ipaentry::postalveolar] configure -text "\u01C6"];
    }

    proc crdjr {} {
	eval [list [format ".ipaec.r%dc%d" $ipaentry::vdaffric $ipaentry::retroflex] configure -text "\u0256\u0290"];
    }

    proc cfdjr {} {
	eval [list [format ".ipaec.r%dc%d" $ipaentry::vdaffric $ipaentry::retroflex] configure -text "\u1E0D\u1E93"];
    }

    proc crzh {} {
	variable vdfric
	variable postalveolar
	eval [list [format ".ipaec.r%dc%d" $vdfric $postalveolar] configure -text "\u0292"];
    }
    proc cfzh {} {
	variable vdfric
	variable postalveolar
	eval [list [format ".ipaec.r%dc%d" $vdfric $postalveolar] configure -text "\u017E"];
    }

    proc crtr {} {
	variable vlstop
	variable retroflex
	eval [list [format ".ipaec.r%dc%d" $vlstop $retroflex] configure -text "\u0288"];
    }
    proc cftr {} {
	variable vlstop
	variable retroflex
	eval [list [format ".ipaec.r%dc%d" $vlstop $retroflex] configure -text "\u1E6D"];
    }

    proc crdr {} {
	variable vdstop
	variable retroflex
	eval [list [format ".ipaec.r%dc%d" $vdstop $retroflex] configure -text "\u0256"];
    }
    proc cfdr {} {
	variable vdstop
	variable retroflex
	eval [list [format ".ipaec.r%dc%d" $vdstop $retroflex] configure -text "\u1E0D"];
    }


    proc crnr {} {
	variable nasal
	variable retroflex
	eval [list [format ".ipaec.r%dc%d" $nasal $retroflex] configure -text "\u0273"];
    }
    proc cfnr {} {
	variable nasal
	variable retroflex
	eval [list [format ".ipaec.r%dc%d" $nasal $retroflex] configure -text "\u1E47"];
    }


    proc crzhr {} {
	variable vdfric
	variable retroflex
	eval [list [format ".ipaec.r%dc%d" $vdfric $retroflex] configure -text "\u0290"];
    }
    proc cfzhr {} {
	variable vdfric
	variable retroflex
	eval [list [format ".ipaec.r%dc%d" $vdfric $retroflex] configure -text "\u1E93"];
    }

    proc crflapr {} {
	variable tap;
	variable retroflex
	eval [list [format ".ipaec.r%dc%d" $tap $retroflex] configure -text "\u027D"];
    }
    proc cfflapr {} {
	variable tap;
	variable retroflex
	eval [list [format ".ipaec.r%dc%d" $tap $retroflex] configure -text "\u1E5B"];
    }

    proc crlr {} {
	variable latapprox;
	variable retroflex
	eval [list [format ".ipaec.r%dc%d" $latapprox $retroflex] configure -text "\u026D"];
    }
    proc cflr {} {
	variable latapprox;
	variable retroflex
	eval [list [format ".ipaec.r%dc%d" $latapprox $retroflex] configure -text "\u1E37"];
    }

    proc crrr {} {
	variable approx;
	variable retroflex
	eval [list [format ".ipaec.r%dc%d" $approx $retroflex] configure -text "\u027B"];
    }
    proc cfrr {} {
	variable approx;
	variable retroflex
	eval [list [format ".ipaec.r%dc%d" $approx $retroflex] configure -text "\u1E5B"];
    }

    proc bhcham {w} {
	balloonhelp_for $w "The standard IPA character is shown by default. When the mouse\npointer is over the button, the \"North American\" variant is shown.\nRight click to insert the variant."
    }

    proc bhsp {w} {
	balloonhelp_for $w "The characters below and to the right are characters\nthat do not fit neatly into the chart."
    }

    proc UnpackConsonantColumnLabels {} {
	variable IPAECColumnLabelList;
	foreach l $IPAECColumnLabelList {
	    grid forget $l;
	}
    }

    proc PackConsonantColumnLabels {} {
	destroy .ipaec
	PopupIPAEntryC;
    }

    proc UnpackConsonantRowLabels {} {
	variable IPAECRowLabelList;
	foreach l $IPAECRowLabelList {
	    grid forget $l;
	}
    }

    proc PackConsonantRowLabels {} {
	destroy .ipaec;
	PopupIPAEntryC;
    }

    proc UnpackVowelColumnLabels {} {
	variable IPAEVColumnLabelList;
	foreach l $IPAEVColumnLabelList {
	    grid forget $l;
	}
    }

    proc PackVowelColumnLabels {} {
	destroy .ipaev;
	PopupIPAEntryV;
    }

    proc UnpackVowelRowLabels {} {
	variable IPAEVRowLabelList;
	foreach l $IPAEVRowLabelList {
	    grid forget $l;
	}
    }

    proc PackVowelRowLabels {} {
	destroy .ipaev;
	PopupIPAEntryV;
    }

    proc PopupIPAEntryC {} {
	variable poa
	variable vlstop 
	variable vdstop
	variable vdimplosive 
	variable click 
	variable nasal  
	variable trill 
	variable tap 
	variable vlfric 
	variable vdfric 
	variable vlaffric 
	variable vdaffric 
	variable approx 
	variable latapprox
	variable lastrow

	variable manner 
	variable labial 
	variable labiodental 
	variable dental 
	variable alveolar 
	variable postalveolar 
	variable retroflex 
	variable palatal 
	variable velar 
	variable uvular 
	variable pharyngeal 
	variable epiglottal 
	variable glottal
	variable lastcolumn

	variable IPAECColumnLabelList;
	variable IPAECRowLabelList;
	global DisplayConsonantChartColumnLabelsP
	global DisplayConsonantChartRowLabelsP

	set IPAECColumnLabelList [list];
	set IPAECRowLabelList [list];
	
	set xp 2;
	set yp 3;
	set spcolor 	\#c46276;
	toplevel .ipaec -borderwidth 3 -class CharEntry
	wm title .ipaec [_ "Consonant Symbols"]
	BindKeys .ipaec;
	set DownMsg [_ "Display IPA Consonant Chart"];
	set UpMsg   [_ "Remove IPA Consonant Chart"];
	bind .ipaec <Destroy> \
	    "set ::IPACIsDisplayedP 0;$::CEM entryconfigure $::ToggleIPACIndex -label \"$DownMsg\""
	bind .ipaec <Unmap> \
	    "set ::IPACIsDisplayedP 0;$::CEM entryconfigure $::ToggleIPACIndex -label \"$DownMsg\""
	bind .ipaec <Map> \
	    "set ::IPACIsDisplayedP 1;$::CEM entryconfigure $::ToggleIPACIndex -label \"$UpMsg\""
	set tmp [label [format ".ipaec.r%dc%d" $manner $poa] \
	  -text [_ "IPA\nConsonants"]  -padx 5 -pady $yp -bg $::ColorSpecs(IPAHeadings,Background)]
	lappend IPAECColumnLabelList $tmp;
	lappend IPAECRowLabelList $tmp;
	lappend IPAECColumnLabelList [label [format ".ipaec.r%dc%d" $manner $labial] \
	    -text [_ "labial"]   -padx $xp -pady $yp -bg $::ColorSpecs(IPAHeadings,Background)]
	lappend IPAECColumnLabelList [label [format ".ipaec.r%dc%d" $manner $labiodental] \
	    -text [_ "labio\ndental"]   -padx $xp -pady $yp -bg $::ColorSpecs(IPAHeadings,Background)]
	lappend IPAECColumnLabelList [label [format ".ipaec.r%dc%d" $manner $dental] \
	    -text [_ "dental"]   -padx $xp -pady $yp -bg $::ColorSpecs(IPAHeadings,Background)]
	lappend IPAECColumnLabelList [label [format ".ipaec.r%dc%d" $manner $alveolar] \
	    -text [_ "alveolar"]   -padx $xp -pady $yp -bg $::ColorSpecs(IPAHeadings,Background)]
	lappend IPAECColumnLabelList [label [format ".ipaec.r%dc%d" $manner $postalveolar] \
	    -text [_ "post\nalveolar"]   -padx $xp -pady $yp -bg $::ColorSpecs(IPAHeadings,Background)]
	lappend IPAECColumnLabelList [label [format ".ipaec.r%dc%d" $manner $retroflex] \
	    -text [_ "retro\nflex"]   -padx $xp -pady $yp -bg $::ColorSpecs(IPAHeadings,Background)]
	lappend IPAECColumnLabelList [label [format ".ipaec.r%dc%d" $manner $palatal] \
	    -text [_ "palatal"]   -padx $xp -pady $yp -bg $::ColorSpecs(IPAHeadings,Background)]
	lappend IPAECColumnLabelList [label [format ".ipaec.r%dc%d" $manner $velar] \
	    -text [_ "velar"]   -padx $xp -pady $yp -bg $::ColorSpecs(IPAHeadings,Background)]
	lappend IPAECColumnLabelList [label [format ".ipaec.r%dc%d" $manner $uvular] \
	    -text [_ "uvular"]   -padx $xp -pady $yp -bg $::ColorSpecs(IPAHeadings,Background)]
	lappend IPAECColumnLabelList [label [format ".ipaec.r%dc%d" $manner $pharyngeal] \
	    -text [_ "pharyn\ngeal"]   -padx $xp -pady $yp -bg $::ColorSpecs(IPAHeadings,Background)]
	lappend IPAECColumnLabelList [label [format ".ipaec.r%dc%d" $manner $epiglottal] \
	    -text [_ "epi\nglottal"]   -padx $xp -pady $yp -bg $::ColorSpecs(IPAHeadings,Background)]
	lappend IPAECColumnLabelList [label [format ".ipaec.r%dc%d" $manner $glottal] \
	    -text [_ "glottal"]   -padx $xp -pady $yp -bg $::ColorSpecs(IPAHeadings,Background)]

	#Voiceless oral stops
	lappend IPAECRowLabelList [label [format ".ipaec.r%dc%d" $vlstop $poa] \
	       -text [_ "voiceless stops"] -anchor w  -padx $xp -pady $yp \
	       -bg $::ColorSpecs(IPAHeadings,Background)]
	set cmd {$::InsertionTarget insert insert [list p]}
	set bn [format ".ipaec.r%dc%d"  $vlstop $labial]
	button $bn  -text "p" -padx $xp -pady $yp -command  $cmd \
	    -fg $::ColorSpecs(UserTextEntry,Foreground); #debug
	balloonhelpd_for $bn [_ "voiceless labial stop"]

	label [format ".ipaec.r%dc%d" $vlstop $labiodental] \
	    -text " " -padx $xp -pady $yp

	set cmd {$::InsertionTarget insert insert [list t\u032A]}
	set bn [format ".ipaec.r%dc%d"  $vlstop $dental]
	button $bn  -text "t\u032A"   -padx $xp -pady $yp -command  $cmd
	balloonhelpd_for $bn [_ "voiceless dental stop"]

	set cmd {$::InsertionTarget insert insert [list t]}
	set bn [format ".ipaec.r%dc%d"  $vlstop $alveolar]
	button $bn -text "t"   -padx $xp -pady $yp -command $cmd
	balloonhelpd_for $bn [_ "voiceless alveolar stop"]

	label [format ".ipaec.r%dc%d"  $vlstop $postalveolar] -text " "   -padx $xp -pady $yp

	set cmd {$::InsertionTarget insert insert [list \u0288]}
	set bn [format ".ipaec.r%dc%d"  $vlstop $retroflex]
	button $bn  -text \u0288   -padx $xp -pady $yp -command $cmd
	bind $bn <<B3>> {$::InsertionTarget insert insert [list \u1E6D]}
	bind $bn <Enter> {ipaentry::cftr}
	bind $bn <Leave> {ipaentry::crtr}
	bhcham $bn;
	balloonhelpd_for $bn [_ "voiceless retroflex stop"]

	set cmd {$::InsertionTarget insert insert [list c]}
	set bn [format ".ipaec.r%dc%d"  $vlstop $palatal]
	button $bn -text "c"   -padx $xp -pady $yp -command $cmd
	balloonhelpd_for $bn [_ "voiceless palatal stop"]

	set cmd {$::InsertionTarget insert insert [list k]}
	set bn [format ".ipaec.r%dc%d" $vlstop $velar]
	button $bn -text "k" -padx $xp -pady $yp -command $cmd
	balloonhelpd_for $bn [_ "voiceless velar stop"]

	set cmd {$::InsertionTarget insert insert [list q]}
	set bn [format ".ipaec.r%dc%d" $vlstop $uvular]
	button $bn  -text "q"   -padx $xp -pady $yp -command $cmd
	balloonhelpd_for $bn [_ "voiceless uvular stop"]

	label [format ".ipaec.r%dc%d" $vlstop $pharyngeal] -text " "   -padx $xp -pady $yp
	label [format ".ipaec.r%dc%d" $vlstop $epiglottal] -text " "   -padx $xp -pady $yp

	set cmd {$::InsertionTarget insert insert [list \u0294]}
	set bn [format ".ipaec.r%dc%d" $vlstop $glottal]
	button $bn -text \u0294   -padx $xp -pady $yp -command $cmd
	balloonhelpd_for $bn [_ "voiceless glottal stop"]

	#Voiced oral stops
	lappend IPAECRowLabelList [label [format ".ipaec.r%dc%d" $vdstop $poa] \
	       -text [_ "voiced stops"] -anchor w   -padx $xp -pady $yp \
	       -bg $::ColorSpecs(IPAHeadings,Background)]
	set cmd {$::InsertionTarget insert insert [list b]}
	set bn [format ".ipaec.r%dc%d" $vdstop $labial]
	button $bn -text "b"   -padx $xp -pady $yp -command $cmd
	balloonhelpd_for $bn [_ "voiced bilabial stop"]

	label [format ".ipaec.r%dc%d" $vdstop $labiodental] -text " "   -padx $xp -pady $yp

	set cmd {$::InsertionTarget insert insert [list d\u032A]}
	set bn [format ".ipaec.r%dc%d" $vdstop $dental]
	button $bn -text "d\u032A"   -padx $xp -pady $yp -command $cmd
	balloonhelpd_for $bn [_ "voiced dental stop"]

	set cmd {$::InsertionTarget insert insert [list d]}
	set bn [format ".ipaec.r%dc%d" $vdstop $alveolar]
	button  $bn -text "d"   -padx $xp -pady $yp -command $cmd
	balloonhelpd_for $bn [_ "voiced alveolar stop"]

	label [format ".ipaec.r%dc%d"  $vdstop $postalveolar] -text " "   -padx $xp -pady $yp

	set cmd {$::InsertionTarget insert insert [list \u0256]}
	set bn [format ".ipaec.r%dc%d"  $vdstop $retroflex]
	button $bn  -text \u0256   -padx $xp -pady $yp -command $cmd
	bind $bn <<B3>> {$::InsertionTarget insert insert [list \u1E0D]}
	bind $bn <Enter> {ipaentry::cfdr}
	bind $bn <Leave> {ipaentry::crdr}
	bhcham $bn;
	balloonhelpd_for $bn [_ "voiced retroflex stop"]

	set cmd {$::InsertionTarget insert insert [list \u025F]}
	set bn [format ".ipaec.r%dc%d" $vdstop $palatal]
	button $bn -text \u025F   -padx $xp -pady $yp -command $cmd
	balloonhelpd_for $bn [_ "voiced palatal stop"]


	set cmd {$::InsertionTarget insert insert [list g]}
	set bn [format ".ipaec.r%dc%d" $vdstop $velar]
	button $bn -text "g"   -padx $xp -pady $yp -command $cmd
	balloonhelpd_for $bn [_ "voiced velar stop"]

	set cmd {$::InsertionTarget insert insert [list \u0262]}
	set bn [format ".ipaec.r%dc%d" $vdstop $uvular]
	button $bn -text \u0262  -padx $xp -pady $yp -command $cmd
	balloonhelpd_for $bn [_ "voiced uvular stop"]

	label [format ".ipaec.r%dc%d" $vdstop $pharyngeal] -text " "  -padx $xp -pady $yp

	set cmd {$::InsertionTarget insert insert [list \u02A1]}
	set bn [format ".ipaec.r%dc%d" $vdstop $epiglottal]
	button $bn -text \u02A1  -padx $xp -pady $yp -command $cmd
	balloonhelpd_for $bn [_ "voiced epiglottal stop"]

	label [format ".ipaec.r%dc%d" $vdstop $glottal] -text " "  -padx $xp -pady $yp

	#Nasals
	lappend IPAECRowLabelList [label [format ".ipaec.r%dc%d" $nasal $poa] \
	       -text [_ "nasals"] -anchor w -padx $xp -pady $yp \
	       -bg $::ColorSpecs(IPAHeadings,Background)]

	set cmd {$::InsertionTarget insert insert [list m]}
	set bn [format ".ipaec.r%dc%d" $nasal $labial]
	button $bn -text "m" -padx $xp -pady $yp -command $cmd
	balloonhelpd_for $bn [_ "bilabial nasal"]

	set cmd {$::InsertionTarget insert insert [list \u0271]}
	set bn [format ".ipaec.r%dc%d" $nasal $labiodental]
	button $bn -text \u0271   -padx $xp -pady $yp -command $cmd
	balloonhelpd_for $bn [_ "labiodental nasal"]

	set cmd {$::InsertionTarget insert insert [list n\u032A]}
	set bn [format ".ipaec.r%dc%d" $nasal $dental]
	button $bn -text n\u032A   -padx $xp -pady $yp -command $cmd
	balloonhelpd_for $bn [_ "dental nasal"]

	set cmd {$::InsertionTarget insert insert [list n]}
	set bn [format ".ipaec.r%dc%d" $nasal $alveolar]
	button $bn -text "n"      -padx $xp -pady $yp -command $cmd
	balloonhelpd_for $bn [_ "alveolar nasal"]

	label [format ".ipaec.r%dc%d"  $nasal $postalveolar] -text " "   -padx $xp -pady $yp

	set cmd {$::InsertionTarget insert insert [list \u0273]}
	set bn [format ".ipaec.r%dc%d"  $nasal $retroflex]
	button $bn  -text \u0273   -padx $xp -pady $yp -command $cmd
	bind $bn <<B3>> {$::InsertionTarget insert insert [list \u1E47]}
	bind $bn <Enter> {ipaentry::cfnr}
	bind $bn <Leave> {ipaentry::crnr}
	bhcham $bn;
	balloonhelpd_for $bn [_ "retroflex nasal"]

	set cmd {$::InsertionTarget insert insert [list \u0272]}
	set bn [format ".ipaec.r%dc%d" $nasal $palatal]
	button $bn  -text \u0272    -padx $xp -pady $yp -command $cmd
	bind $bn <<B3>> {$::InsertionTarget insert insert [list \u00F1]}
	bind $bn <Enter> {ipaentry::cfny}
	bind $bn <Leave> {ipaentry::crny}
	bhcham $bn;
	balloonhelpd_for $bn [_ "palatal nasal"]

	set cmd {$::InsertionTarget insert insert [list \u014B]}
	set bn [format ".ipaec.r%dc%d" $nasal $velar]
	button $bn -text \u014B    -padx $xp -pady $yp -command $cmd
	balloonhelpd_for $bn [_ "velar nasal"]

	set cmd {$::InsertionTarget insert insert [list \u0274]}
	set bn [format ".ipaec.r%dc%d" $nasal $uvular]
	button $bn -text \u0274    -padx $xp -pady $yp -command $cmd
	balloonhelpd_for $bn [_ "uvular nasal"]

	label [format ".ipaec.r%dc%d" $nasal $pharyngeal] -text " "    -padx $xp -pady $yp
	label [format ".ipaec.r%dc%d" $nasal $epiglottal] -text " "    -padx $xp -pady $yp
	label [format ".ipaec.r%dc%d" $nasal $glottal] -text " "    -padx $xp -pady $yp

	#Voiceless fricatives
	lappend IPAECRowLabelList [label [format ".ipaec.r%dc%d" $vlfric $poa] \
	       -text [_ "voiceless fricatives"] -anchor w  -padx $xp -pady $yp \
	       -bg $::ColorSpecs(IPAHeadings,Background)]

	set cmd {$::InsertionTarget insert insert [list \u03C6]}
	set bn [format ".ipaec.r%dc%d" $vlfric $labial]
	button $bn -text \u03C6  -padx $xp -pady $yp -command $cmd
	balloonhelpd_for $bn [_ "voiceless bilabial fricative"]

	set cmd {$::InsertionTarget insert insert [list f]}
	set bn [format ".ipaec.r%dc%d" $vlfric $labiodental]
	button $bn  -text "f"   -padx $xp -pady $yp -command $cmd
	balloonhelpd_for $bn [_ "voiceless labiodental fricative"]

	set cmd {$::InsertionTarget insert insert [list \u03B8]}
	set bn [format ".ipaec.r%dc%d" $vlfric $dental]
	button $bn -text \u03B8   -padx $xp -pady $yp -command $cmd
	balloonhelpd_for $bn [_ "voiceless dental fricative"]

	set cmd {$::InsertionTarget insert insert [list "s"]}
	set bn [format ".ipaec.r%dc%d" $vlfric $alveolar]
	button $bn -text "s"  -padx $xp -pady $yp -command $cmd
	balloonhelpd_for $bn [_ "voiceless alveolar fricative"]

	set cmd {$::InsertionTarget insert insert [list \u0283]}
	set bn [format ".ipaec.r%dc%d" $vlfric $postalveolar];
	button $bn -text \u0283   -padx $xp -pady $yp -command $cmd
	bind $bn <<B3>> {$::InsertionTarget insert insert [list \u0161]}
	bind $bn <Enter> {ipaentry::cfesh}
	bind $bn <Leave> {ipaentry::cresh}
	bhcham $bn;
	balloonhelpd_for $bn [_ "voiceless postalveolar fricative"]

	set cmd {$::InsertionTarget insert insert [list \u0282]}
	set bn [format ".ipaec.r%dc%d" $vlfric $retroflex];
	button $bn -text \u0282   -padx $xp -pady $yp -command $cmd
	bind $bn <<B3>> {$::InsertionTarget insert insert [list \u1E63]}
	bind $bn <Enter> {ipaentry::cfeshr}
	bind $bn <Leave> {ipaentry::creshr}
	bhcham $bn;
	balloonhelpd_for $bn [_ "voiceless retroflex fricative"]

	set cmd {$::InsertionTarget insert insert [list \u0255]}
	set bn [format ".ipaec.r%dc%d" $vlfric $palatal]
	button $bn -text \u0255  -padx $xp -pady $yp -command $cmd
	balloonhelpd_for $bn [_ "voiceless palatal fricative"]

	set cmd {$::InsertionTarget insert insert [list "x"]}
	set bn [format ".ipaec.r%dc%d" $vlfric $velar]
	button $bn -text "x" -padx $xp -pady $yp -command $cmd
	balloonhelpd_for $bn [_ "voiceless velar fricative"]

	set cmd {$::InsertionTarget insert insert [list "\u03C7"]}
	set bn [format ".ipaec.r%dc%d" $vlfric $uvular]
	button $bn -text "\u03C7"    -padx $xp -pady $yp -command $cmd
	balloonhelpd_for $bn [_ "voiceless uvular fricative"]

	set cmd {$::InsertionTarget insert insert [list \u0127]}
	set bn [format ".ipaec.r%dc%d" $vlfric $pharyngeal]
	button $bn -text \u0127 -padx $xp -pady $yp -command $cmd
	balloonhelpd_for $bn [_ "voiceless pharyngeal fricative"]

	set cmd {$::InsertionTarget insert insert [list \u029C]}
	set bn [format ".ipaec.r%dc%d" $vlfric $epiglottal]
	button $bn -text \u029C   -padx $xp -pady $yp -command $cmd
	balloonhelpd_for $bn [_ "voiceless epiglottal fricative"]

	set cmd {$::InsertionTarget insert insert [list "h"]}
	set bn [format ".ipaec.r%dc%d" $vlfric $glottal]
	button $bn -text "h" -padx $xp -pady $yp -command $cmd
	balloonhelpd_for $bn [_ "voiceless glottal fricative"]

	#Voiced fricatives
	lappend IPAECRowLabelList [label [format ".ipaec.r%dc%d" $vdfric $poa] \
	       -text [_ "voiced fricatives"] -anchor w \
	       -padx $xp -pady $yp -bg $::ColorSpecs(IPAHeadings,Background)]

	set cmd {$::InsertionTarget insert insert [list \u03B2]}
	set bn [format ".ipaec.r%dc%d" $vdfric $labial]
	button $bn -text \u03B2  -padx $xp -pady $yp -command $cmd
	balloonhelpd_for $bn [_ "voiced bilabial fricative"]

	set cmd {$::InsertionTarget insert insert [list v]}
	set bn [format ".ipaec.r%dc%d" $vdfric $labiodental]
	button $bn -text "v" -padx $xp -pady $yp -command $cmd
	balloonhelpd_for $bn [_ "voiced labiodental fricative"]

	set cmd {$::InsertionTarget insert insert [list "\u00F0"]}
	set bn [format ".ipaec.r%dc%d" $vdfric $dental]
	button $bn -text "\u00F0"    -padx $xp -pady $yp -command $cmd
	balloonhelpd_for $bn [_ "voiced dental fricative"]

	set cmd {$::InsertionTarget insert insert [list "z"]}
	set bn [format ".ipaec.r%dc%d" $vdfric $alveolar]
	button $bn -text "z"   -padx $xp -pady $yp -command $cmd
	balloonhelpd_for $bn [_ "voiced alveolar fricative"]

	set cmd {$::InsertionTarget insert insert [list \u0292]}
	set bn [format ".ipaec.r%dc%d" $vdfric $postalveolar]
	button $bn -text \u0292  -padx $xp -pady $yp -command $cmd
	bind $bn <<B3>> {$::InsertionTarget insert insert [list \u017E]}
	bind $bn <Enter> {ipaentry::cfzh}
	bind $bn <Leave> {ipaentry::crzh}
	bhcham $bn;
	balloonhelpd_for $bn [_ "voiced postalveolar fricative"]

	set cmd {$::InsertionTarget insert insert [list \u0290]}
	set bn [format ".ipaec.r%dc%d" $vdfric $retroflex]
	button $bn -text \u0290   -padx $xp -pady $yp -command $cmd
	bind $bn <<B3>> {$::InsertionTarget insert insert [list \u1E93]}
	bind $bn <Enter> {ipaentry::cfzhr}
	bind $bn <Leave> {ipaentry::crzhr}
	bhcham $bn;
	balloonhelpd_for $bn [_ "voiced retroflex fricative"]

	set cmd {$::InsertionTarget insert insert [list \u029D]}
	set bn [format ".ipaec.r%dc%d" $vdfric $palatal]
	button $bn -text  \u029D  -padx $xp -pady $yp -command $cmd
	balloonhelpd_for $bn [_ "voiced palatal fricative"]

	set cmd {$::InsertionTarget insert insert [list \u0263]}
	set bn [format ".ipaec.r%dc%d" $vdfric $velar]
	button $bn -text \u0263  -padx $xp -pady $yp -command $cmd
	balloonhelpd_for $bn [_ "voiced velar fricative"]

	set cmd {$::InsertionTarget insert insert [list "\u0281"]}
	set bn [format ".ipaec.r%dc%d" $vdfric $uvular]
	button $bn -text "\u0281" -padx $xp -pady $yp -command $cmd
	balloonhelpd_for $bn [_ "voiced uvular fricative"]

	set cmd {$::InsertionTarget insert insert [list \u0295]}
	set bn [format ".ipaec.r%dc%d" $vdfric $pharyngeal]
	button $bn -text \u0295 -padx $xp -pady $yp -command $cmd
	balloonhelpd_for $bn [_ "voiced pharyngeal fricative"]

	set cmd {$::InsertionTarget insert insert [list \u02A2]}
	set bn [format ".ipaec.r%dc%d" $vdfric $epiglottal] 
	button $bn -text \u02A2    -padx $xp -pady $yp -command $cmd
	balloonhelpd_for $bn [_ "voiced epiglottal fricative"]

	set cmd {$::InsertionTarget insert insert [list \u0266]}
	set bn [format ".ipaec.r%dc%d" $vdfric $glottal]
	button $bn -text \u0266    -padx $xp -pady $yp -command $cmd
	balloonhelpd_for $bn [_ "voiced glottal fricative"]

	#trills
	lappend IPAECRowLabelList [label [format ".ipaec.r%dc%d" $trill $poa] \
	       -text [_ "trills"] -anchor w   -padx $xp -pady $yp -bg $::ColorSpecs(IPAHeadings,Background)]
	set cmd {$::InsertionTarget insert insert [list \u0299]}
	set bn [format ".ipaec.r%dc%d" $trill $labial]
	button  $bn -text \u0299      -padx $xp -pady $yp -command $cmd
	balloonhelpd_for $bn [_ "bilabial trill"]

	label [format ".ipaec.r%dc%d" $trill $labiodental] -text " "   -padx $xp -pady $yp
	label [format ".ipaec.r%dc%d" $trill $dental] -text " "   -padx $xp -pady $yp
	set cmd {$::InsertionTarget insert insert [list r]}
	set bn [format ".ipaec.r%dc%d" $trill $alveolar]
	button $bn -text "r"      -padx $xp -pady $yp -command $cmd
	balloonhelpd_for $bn [_ "alveolar trill"]

	label [format ".ipaec.r%dc%d"  $trill $postalveolar] -text " "   -padx $xp -pady $yp
	label [format ".ipaec.r%dc%d"  $trill $retroflex] -text " "   -padx $xp -pady $yp
	label [format ".ipaec.r%dc%d" $trill $palatal] -text " "    -padx $xp -pady $yp
	label [format ".ipaec.r%dc%d" $trill $velar] -text " "    -padx $xp -pady $yp

	set cmd {$::InsertionTarget insert insert [list \u0280]}
	set bn [format ".ipaec.r%dc%d" $trill $uvular]
	button $bn -text \u0280    -padx $xp -pady $yp
	balloonhelpd_for $bn [_ "uvular trill"]

	label [format ".ipaec.r%dc%d" $trill $pharyngeal] -text " "    -padx $xp -pady $yp
	label [format ".ipaec.r%dc%d" $trill $epiglottal] -text " "    -padx $xp -pady $yp
	label [format ".ipaec.r%dc%d" $trill $glottal] -text " "    -padx $xp -pady $yp

	#taps and flaps
	lappend IPAECRowLabelList [label [format ".ipaec.r%dc%d" $tap $poa] \
	       -text [_ "taps/flaps"] -anchor w   -padx $xp -pady $yp -bg $::ColorSpecs(IPAHeadings,Background)]
	label [format ".ipaec.r%dc%d" $tap $labial] -text " "      -padx $xp -pady $yp
	label [format ".ipaec.r%dc%d" $tap $labiodental] -text " "   -padx $xp -pady $yp
	label [format ".ipaec.r%dc%d" $tap $dental] -text " "   -padx $xp -pady $yp

	set cmd {$::InsertionTarget insert insert [list \u027E]}
	set bn [format ".ipaec.r%dc%d" $tap $alveolar]
	button $bn -text \u027E -padx $xp -pady $yp -command $cmd
	balloonhelpd_for $bn [_ "uvular trill"]

	label [format ".ipaec.r%dc%d"  $tap $postalveolar] -text " "   -padx $xp -pady $yp

	set cmd {$::InsertionTarget insert insert [list \u027D]}
	set bn [format ".ipaec.r%dc%d"  $tap $retroflex];
	button $bn -text \u027D   -padx $xp -pady $yp -command $cmd
	bind $bn <<B3>> {$::InsertionTarget insert insert [list \u1E5B]}
	bind $bn <Enter> {ipaentry::cfflapr}
	bind $bn <Leave> {ipaentry::crflapr}
	bhcham $bn;
	balloonhelpd_for $bn [_ "retroflex tap"]

	label [format ".ipaec.r%dc%d" $tap $palatal] -text " "    -padx $xp -pady $yp
	label [format ".ipaec.r%dc%d" $tap $velar] -text " "    -padx $xp -pady $yp
	label [format ".ipaec.r%dc%d" $tap $uvular] -text " "    -padx $xp -pady $yp
	label [format ".ipaec.r%dc%d" $tap $pharyngeal] -text " "    -padx $xp -pady $yp
	label [format ".ipaec.r%dc%d" $tap $epiglottal] -text " "    -padx $xp -pady $yp
	label [format ".ipaec.r%dc%d" $tap $glottal] -text " "    -padx $xp -pady $yp

	#approximants
	lappend IPAECRowLabelList [label [format ".ipaec.r%dc%d" $approx $poa] \
	       -text [_ "approximants"] -anchor w \
	       -padx $xp -pady $yp -bg $::ColorSpecs(IPAHeadings,Background)]
	label [format ".ipaec.r%dc%d" $approx $labial] -text " "      -padx $xp -pady $yp
	set cmd {$::InsertionTarget insert insert [list \u028B]}
	set bn [format ".ipaec.r%dc%d" $approx $labiodental]
	button $bn -text \u028B   -padx $xp -pady $yp -command $cmd
	balloonhelpd_for $bn [_ "labiodental approximant"]

	label [format ".ipaec.r%dc%d" $approx $dental] -text " "   -padx $xp -pady $yp
	set cmd {$::InsertionTarget insert insert [list \u0279]}
	set bn [format ".ipaec.r%dc%d" $approx $alveolar]
	button $bn -text  \u0279 -padx $xp -pady $yp -command $cmd
	balloonhelpd_for $bn [_ "alveolar approximant"]

	label [format ".ipaec.r%dc%d"  $approx $postalveolar] -text " "   -padx $xp -pady $yp

	set cmd {$::InsertionTarget insert insert [list \u027B]}
	set bn [format ".ipaec.r%dc%d"  $approx $retroflex]
	button $bn -text \u027B   -padx $xp -pady $yp -command $cmd
	bind $bn <<B3>> {$::InsertionTarget insert insert [list \u1E5B]}
	bind $bn <Enter> {ipaentry::cfrr}
	bind $bn <Leave> {ipaentry::crrr}
	bhcham $bn;
	balloonhelpd_for $bn [_ "retroflex approximant"]

	set cmd {$::InsertionTarget insert insert [list "j"]}
	set bn [format ".ipaec.r%dc%d" $approx $palatal]
	button $bn -text "j"    -padx $xp -pady $yp -command $cmd
	bind $bn <<B3>> {$::InsertionTarget insert insert [list "y"]}
	bind $bn <Enter> {ipaentry::cfyod}
	bind $bn <Leave> {ipaentry::cryod}
	bhcham $bn;
	balloonhelpd_for $bn [_ "palatal approximant"]

	set cmd {$::InsertionTarget insert insert [list \u0270]}
	set bn [format ".ipaec.r%dc%d" $approx $velar]
	button $bn  -text \u0270    -padx $xp -pady $yp -command $cmd
	balloonhelpd_for $bn [_ "velar approximant"]

	label [format ".ipaec.r%dc%d" $approx $uvular] -text " "  \
	    -padx $xp -pady $yp -bg $spcolor
	label [format ".ipaec.r%dc%d" $approx $pharyngeal] -text " "  \
	    -padx $xp -pady $yp -bg $spcolor

	#label [format ".ipaec.r%dc%d" $approx $epiglottal] -text " "  \
	    -padx $xp -pady $yp -bg $spcolor
	#label [format ".ipaec.r%dc%d" $approx $glottal] -text " "   \
	    -padx $xp -pady $yp -bg $spcolor

	#lateral approximants
	lappend IPAECRowLabelList [label [format ".ipaec.r%dc%d" $latapprox $poa] \
	       -text [_ "lateral approximants"] -anchor w \
	       -padx $xp -pady $yp -bg $::ColorSpecs(IPAHeadings,Background)]
	label [format ".ipaec.r%dc%d" $latapprox $labial] -text " "      -padx $xp -pady $yp
	label [format ".ipaec.r%dc%d" $latapprox $labiodental] -text " "   -padx $xp -pady $yp
	label [format ".ipaec.r%dc%d" $latapprox $dental] -text " "   -padx $xp -pady $yp

	set cmd {$::InsertionTarget insert insert [list "l"]}
	set bn [format ".ipaec.r%dc%d" $latapprox $alveolar]
	button $bn -text "l"    -padx $xp -pady $yp -command $cmd
	balloonhelpd_for $bn [_ "alveolar lateral approximant"]

	label [format ".ipaec.r%dc%d"  $latapprox $postalveolar] -text " "   -padx $xp -pady $yp

	set cmd {$::InsertionTarget insert insert [list \u026D]}
	set bn [format ".ipaec.r%dc%d"  $latapprox $retroflex]
	button $bn  -text \u026D   -padx $xp -pady $yp -command $cmd
	bind $bn <<B3>> {$::InsertionTarget insert insert [list \u1E37]}
	bind $bn <Enter> {ipaentry::cflr}
	bind $bn <Leave> {ipaentry::crlr}
	bhcham $bn;
	balloonhelpd_for $bn [_ "retroflex lateral approximant"]

	set cmd {$::InsertionTarget insert insert [list \u028E]}
	set bn [format ".ipaec.r%dc%d" $latapprox $palatal]
	button $bn -text \u028E    -padx $xp -pady $yp -command $cmd
	balloonhelpd_for $bn [_ "palatal lateral approximant"]

	set cmd {$::InsertionTarget insert insert [list \u029F]}
	set bn [format ".ipaec.r%dc%d" $latapprox $velar]
	button $bn -text \u029F    -padx $xp -pady $yp -command $cmd
	balloonhelpd_for $bn [_ "velar lateral approximant"]

	label [format ".ipaec.r%dc%d" $latapprox $uvular] -text " "  \
	    -padx $xp -pady $yp -bg $spcolor
	#label [format ".ipaec.r%dc%d" $latapprox $pharyngeal] -text " "  \
	    -padx $xp -pady $yp -bg $spcolor
	#label [format ".ipaec.r%dc%d" $latapprox $epiglottal] -text " "  \
	    -padx $xp -pady $yp
	#label [format ".ipaec.r%dc%d" $latapprox $glottal] -text " "  \
	    -padx $xp -pady $yp

	#voiced implosives
	lappend IPAECRowLabelList [label [format ".ipaec.r%dc%d" $vdimplosive $poa] \
	       -text [_ "voiced implosives"] -anchor w \
	       -padx $xp -pady $yp -bg $::ColorSpecs(IPAHeadings,Background)]

	set cmd {$::InsertionTarget insert insert [list \u0253]}
	set bn [format ".ipaec.r%dc%d" $vdimplosive $labial]
	button $bn -text \u0253 -padx $xp -pady $yp -command $cmd
	balloonhelpd_for $bn [_ "voiced bilabial implosive"]

	label [format ".ipaec.r%dc%d" $vdimplosive $labiodental] -text " " \
	    -padx $xp -pady $yp
	label [format ".ipaec.r%dc%d" $vdimplosive $dental] -text " "  \
	    -padx $xp -pady $yp

	set cmd {$::InsertionTarget insert insert [list \u0257]}
	set bn [format ".ipaec.r%dc%d" $vdimplosive $alveolar]
	button $bn -text \u0257   -padx $xp -pady $yp -command $cmd
	balloonhelpd_for $bn [_ "voiced alveolar implosive"]

	label [format ".ipaec.r%dc%d"  $vdimplosive $postalveolar] -text " " \
	    -padx $xp -pady $yp

	#Not officially recognized by IPA yet.
	set cmd {$::InsertionTarget insert insert [list \u1D91]}
	set bn [format ".ipaec.r%dc%d"  $vdimplosive $retroflex]
	button $bn -text \u1D91  -padx $xp -pady $yp -command $cmd
	balloonhelpd_for $bn [_ "voiced retroflex implosive"]

	set cmd {$::InsertionTarget insert insert [list \u0284]}
	set bn [format ".ipaec.r%dc%d" $vdimplosive $palatal]
	button $bn -text \u0284  -padx $xp -pady $yp -command $cmd
	balloonhelpd_for $bn [_ "voiced palatal implosive"]

	set cmd {$::InsertionTarget insert insert [list \u0260]}
	set bn [format ".ipaec.r%dc%d" $vdimplosive $velar]
	button $bn -text \u0260 -padx $xp -pady $yp -command $cmd
	balloonhelpd_for $bn [_ "voiced velar implosive"]

	set cmd {$::InsertionTarget insert insert [list \u029B]}
	set bn [format ".ipaec.r%dc%d" $vdimplosive $uvular]
	button $bn -text \u029B    -padx $xp -pady $yp -command $cmd
	balloonhelpd_for $bn [_ "voiced uvular implosive"]

	label [format ".ipaec.r%dc%d" $vdimplosive $pharyngeal] -text " "    -padx $xp -pady $yp
	label [format ".ipaec.r%dc%d" $vdimplosive $epiglottal] -text " "    -padx $xp -pady $yp
	label [format ".ipaec.r%dc%d" $vdimplosive $glottal] -text " "    -padx $xp -pady $yp

	#clicks
	lappend IPAECRowLabelList [label [format ".ipaec.r%dc%d" $click $poa] \
	       -text [_ "clicks"] -anchor w  -padx $xp -pady $yp -bg $::ColorSpecs(IPAHeadings,Background)]

	set cmd {$::InsertionTarget insert insert [list \u0298]}
	set bn [format ".ipaec.r%dc%d" $click $labial]
	button $bn -text \u0298      -padx $xp -pady $yp -command $cmd
	balloonhelpd_for $bn [_ "labial click"]

	label [format ".ipaec.r%dc%d" $click $labiodental] -text " "   -padx $xp -pady $yp

	set cmd {$::InsertionTarget insert insert [list \u01C0]}
	set bn [format ".ipaec.r%dc%d" $click $dental]
	button $bn -text \u01C0   -padx $xp -pady $yp -command $cmd
	balloonhelpd_for $bn [_ "dental click"]

	set cmd {$::InsertionTarget insert insert [list \u01C2]}
	set bn [format ".ipaec.r%dc%d" $click $alveolar]
	button $bn -text \u01C2   -padx $xp -pady $yp -command $cmd
	balloonhelpd_for $bn [_ "alveolar click"]

	set cmd {$::InsertionTarget insert insert [list \u01C3]}
	set bn [format ".ipaec.r%dc%d"  $click $postalveolar]
	button $bn -text \u01C3 \
	    -padx $xp -pady $yp  -command $cmd
	balloonhelpd_for $bn [_ "postalveolar click"]

	label [format ".ipaec.r%dc%d"  $click $retroflex] -text " "   -padx $xp -pady $yp
	label [format ".ipaec.r%dc%d" $click $palatal] -text " "  -padx $xp -pady $yp
	label [format ".ipaec.r%dc%d" $click $velar] -text " "    -padx $xp -pady $yp
	label [format ".ipaec.r%dc%d" $click $uvular] -text " "    -padx $xp -pady $yp
	label [format ".ipaec.r%dc%d" $click $pharyngeal] -text " "    -padx $xp -pady $yp
	label [format ".ipaec.r%dc%d" $click $epiglottal] -text " "    -padx $xp -pady $yp
	set cmd {BackDelete $::InsertionTarget}
	set bn [format ".ipaec.r%dc%d" $click $glottal];
	button $bn -text [_ "Delete"]  -padx $xp -pady $yp -command $cmd -background "\#E0D0FF";
	set DeleteButton $bn;


	#Voiceless affricates
	lappend IPAECRowLabelList [label [format ".ipaec.r%dc%d" $vlaffric $poa] \
	       -text [_ "voiceless affricates"] -anchor w -padx $xp -pady $yp \
	       -bg $::ColorSpecs(IPAHeadings,Background)]

	set cmd {$::InsertionTarget insert insert [list p\u03C6]}
	set bn [format ".ipaec.r%dc%d" $vlaffric $labial]
	button $bn -text "p\u03C6"      -padx $xp -pady $yp -command $cmd
	balloonhelpd_for $bn [_ "voiceless bilabial affricate"]

	label [format ".ipaec.r%dc%d" $vlaffric $labiodental] -text "" -padx $xp -pady $yp

	set cmd {$::InsertionTarget insert insert [list t\u03B8]}
	set bn [format ".ipaec.r%dc%d" $vlaffric $dental]
	button $bn -text "t\u03B8"   -padx $xp -pady $yp -command $cmd
	balloonhelpd_for $bn [_ "voiceless dental affricate"]

	set cmd {$::InsertionTarget insert insert [list "ts"]}
	set bn [format ".ipaec.r%dc%d" $vlaffric $alveolar]
	button $bn -text "ts"    -padx $xp -pady $yp -command $cmd
	balloonhelpd_for $bn [_ "voiceless alveolar affricate"]

	set cmd {$::InsertionTarget insert insert [list t\u0283]}
	set bn [format ".ipaec.r%dc%d"  $vlaffric $postalveolar]
	button $bn -text "t\u0283"   -padx $xp -pady $yp -command $cmd
	bind $bn <<B3>> {$::InsertionTarget insert insert [list \u010D]}
	bind $bn <Enter> {ipaentry::cfch}
	bind $bn <Leave> {ipaentry::crch}
	bhcham $bn;
	balloonhelpd_for $bn [_ "voiceless postalveolar affricate"]

	set cmd {$::InsertionTarget insert insert [list \u0288\u0282]}
	set bn [format ".ipaec.r%dc%d"  $vlaffric $retroflex]
	button $bn -text \u0288\u0282   -padx $xp -pady $yp -command $cmd
	bind $bn <<B3>> {$::InsertionTarget insert insert [list \u1E6D\u1E63]}
	bind $bn <Enter> {ipaentry::cfchr}
	bind $bn <Leave> {ipaentry::crchr}
	bhcham $bn;
	balloonhelpd_for $bn [_ "voiceless retroflex affricate"]

	set cmd {$::InsertionTarget insert insert [list t\u0255]}
	set bn [format ".ipaec.r%dc%d" $vlaffric $palatal]
	button $bn -text t\u0255 -padx $xp -pady $yp -command $cmd
	balloonhelpd_for $bn [_ "voiceless palatal affricate"]

	set cmd {$::InsertionTarget insert insert [list "kx"]}
	set bn [format ".ipaec.r%dc%d" $vlaffric $velar]
	button $bn -text "kx"    -padx $xp -pady $yp -command $cmd
	balloonhelpd_for $bn [_ "voiceless velar affricate"]

	set cmd {$::InsertionTarget insert insert [list "q\u03C7"]}
	set bn [format ".ipaec.r%dc%d" $vlaffric $uvular]
	button $bn -text "q\u03C7"    -padx $xp -pady $yp -command $cmd
	balloonhelpd_for $bn [_ "voiceless uvular affricate"]

	label [format ".ipaec.r%dc%d" $vlaffric $pharyngeal] -text "" \
	    -padx $xp -pady $yp -bg $spcolor
	label [format ".ipaec.r%dc%d" $vlaffric $epiglottal] -text "" \
	    -padx $xp -pady $yp -bg $spcolor
	label [format ".ipaec.r%dc%d" $vlaffric $glottal] -text "" \
	    -padx $xp -pady $yp -bg $spcolor

	#Voiced affricate
	lappend IPAECRowLabelList [label [format ".ipaec.r%dc%d" $vdaffric $poa] \
	       -text [_ "voiced affricates"] -anchor w -padx $xp -pady $yp \
	       -bg $::ColorSpecs(IPAHeadings,Background)]

	set cmd {$::InsertionTarget insert insert [list b\u03B2]}
	set bn [format ".ipaec.r%dc%d" $vdaffric $labial]
	button $bn -text b\u03B2      -padx $xp -pady $yp -command $cmd
	balloonhelpd_for $bn [_ "voiced bilabial affricate"]

	label [format ".ipaec.r%dc%d" $vdaffric $labiodental] -text ""   -padx $xp -pady $yp

	set cmd {$::InsertionTarget insert insert [list "d\u00F0"]}
	set bn [format ".ipaec.r%dc%d" $vdaffric $dental]
	button $bn -text "d\u00F0"    -padx $xp -pady $yp -command $cmd
	balloonhelpd_for $bn [_ "voiced dental affricate"]

	set cmd {$::InsertionTarget insert insert [list "dz"]}
	set bn [format ".ipaec.r%dc%d" $vdaffric $alveolar]
	button  $bn -text "dz"  -padx $xp -pady $yp -command $cmd
	balloonhelpd_for $bn [_ "voiced alveolar affricate"]

	set cmd {$::InsertionTarget insert insert [list d\u0292]}
	set bn [format ".ipaec.r%dc%d" $vdaffric $postalveolar]
	button $bn -text d\u0292  -padx $xp -pady $yp -command $cmd
	bind $bn <<B3>> {$::InsertionTarget insert insert [list \u01C6]}
	bind $bn <Enter> {ipaentry::cfdj}
	bind $bn <Leave> {ipaentry::crdj}
	bhcham $bn;
	balloonhelpd_for $bn [_ "voiced postalveolar affricate"]

	set cmd {$::InsertionTarget insert insert [list \u0256\u0290]}
	set bn [format ".ipaec.r%dc%d" $vdaffric $retroflex]
	button $bn -text \u0256\u0290   -padx $xp -pady $yp -command $cmd
	bind $bn <<B3>> {$::InsertionTarget insert insert [list \u1E0D\u1E93]}
	bind $bn <Enter> {ipaentry::cfdjr}
	bind $bn <Leave> {ipaentry::crdjr}
	bhcham $bn;
	balloonhelpd_for $bn [_ "voiced retroflex affricate"]

	set cmd {$::InsertionTarget insert insert [list d\u029D]}
	set bn [format ".ipaec.r%dc%d" $vdaffric $palatal]
	button $bn -text  d\u029D  -padx $xp -pady $yp -command $cmd
	balloonhelpd_for $bn [_ "voiced palatal affricate"]

	set cmd {$::InsertionTarget insert insert [list g\u0263]}
	set bn [format ".ipaec.r%dc%d" $vdaffric $velar]
	button $bn -text g\u0263    -padx $xp -pady $yp -command $cmd
	balloonhelpd_for $bn [_ "voiced velar affricate"]

	set cmd {$::InsertionTarget insert insert [list "\u0262\u0281"]}
	set bn [format ".ipaec.r%dc%d" $vdaffric $uvular]
	button $bn -text "\u0262\u0281"    -padx $xp -pady $yp -command $cmd
	balloonhelpd_for $bn [_ "voiced uvular affricate"]

	label [format ".ipaec.r%dc%d" $vdaffric $pharyngeal] -text "" \
	    -padx $xp -pady $yp -bg $spcolor
	#label [format ".ipaec.r%dc%d" $vdaffric $epiglottal] -text "" \
	    -padx $xp -pady $yp -bg $spcolor
	#label [format ".ipaec.r%dc%d" $vdaffric $glottal] -text ""   \
	    -padx $xp -pady $yp -bg $spcolor

	set cmd {$::InsertionTarget insert insert [list "\u028D"]}
	button .ipaec.r13c10 -text \u028D -padx $xp -pady $yp -command $cmd
	balloonhelpd_for .ipaec.r13c10  [_ "Voiceless labio-velar fricative"]
	set cmd {$::InsertionTarget insert insert [list "\u0265"]}
	button .ipaec.r11c11 -text \u0265 -padx $xp -pady $yp -command $cmd
	balloonhelpd_for .ipaec.r11c11  [_ "Voiced labio-palatal approximant"]
	set cmd {$::InsertionTarget insert insert [list "\u0077"]}
	button .ipaec.r11c12 -text \u0077 -padx $xp -pady $yp -command $cmd
	balloonhelpd_for .ipaec.r11c12  [_ "Voiced labio-velar approximant"]
	set cmd {$::InsertionTarget insert insert [list "\u01C1"]}
	button .ipaec.r12c11 -text \u01C1 -padx $xp -pady $yp -command $cmd
	set cmd {$::InsertionTarget insert insert [list "\u02A0"]}
	button .ipaec.r12c12 -text \u02A0 -padx $xp -pady $yp -command $cmd
	set cmd {$::InsertionTarget insert insert [list "\u026C"]}
	button .ipaec.r13c11 -text \u026C -padx $xp -pady $yp -command $cmd
	set cmd {$::InsertionTarget insert insert [list "\u026E"]}
	button .ipaec.r13c12 -text \u026E -padx $xp -pady $yp -command $cmd

	for {set row 0} {$row <= $lastrow} {incr row} {
	    set line [list];
	    for {set col 0} {$col <= $lastcolumn} {incr col} {
		set cell [format ".ipaec.r%dc%d" $row $col]
		lappend line $cell
		if {[string equal [winfo class $cell] "Label"]} {
		    balloonhelp_for $cell  [_ "Left click to insert standard characters.\nRight click to insert alternative characters."]
		}
	    }
	    eval grid $line -sticky news;
	}
	balloonhelpd_for .ipaec.r12c11  [_ "Lateral click"]
	balloonhelpd_for .ipaec.r12c12  [_ "Voiceless uvular implosive"]
	balloonhelpd_for .ipaec.r13c11  [_ "Voiceless lateral fricative"]
	balloonhelpd_for .ipaec.r13c12  [_ "Voiced lateral fricative"]
	bhsp [format ".ipaec.r%dc%d" $latapprox $uvular]
	bhsp [format ".ipaec.r%dc%d" $approx $uvular]
	bhsp [format ".ipaec.r%dc%d" $approx $pharyngeal]
	bhsp [format ".ipaec.r%dc%d" $vlaffric $pharyngeal]
	bhsp [format ".ipaec.r%dc%d" $vlaffric $epiglottal]
	bhsp [format ".ipaec.r%dc%d" $vlaffric $glottal]
	bhsp [format ".ipaec.r%dc%d" $vdaffric $pharyngeal]
	balloonhelpd_for $DeleteButton [_ "No, there isn't a glottal click  called \"Delete\".\nThis is so that you can correct mistakes while using\nthe mouse, without having to go back to the keyboard."]
	after idle {
	    update idletasks
	    raise .ipaec;
	}
	if {!$DisplayConsonantChartColumnLabelsP} {UnpackConsonantColumnLabels}
	if {!$DisplayConsonantChartRowLabelsP} {UnpackConsonantRowLabels}
    }

    set row 0;
    variable frontness $row;
    incr row;
    variable close $row;
    incr row;
    variable closeclosemid $row;
    incr row;
    variable closemid $row;
    incr row;
    variable midmid $row;
    incr row;
    variable openmid $row;
    incr row;
    variable openopenmid $row;
    incr row;
    variable open $row;
    variable lastvrow $row;

    set col 0;
    variable height $col; 
    incr col;
    variable fronturd $col;
    incr col;
    variable frontrnd $col;
    incr col;
    variable centurd $col;
    incr col;
    variable centrnd $col;
    incr col;
    variable backurd $col;
    incr col;
    variable backrnd $col;
    variable lastvcolumn $col;

    proc vry {} {
	variable close
	variable frontrnd
	eval [list [format ".ipaev.r%dc%d" $close $frontrnd] configure -text "y"];
	}
    
    proc vfy {} {
	variable close
	variable frontrnd
	eval [list [format ".ipaev.r%dc%d" $close $frontrnd] configure -text "\u00FC"];
	}

    proc vrphi {} {
	variable frontrnd;
	variable closemid
	eval [list [format ".ipaev.r%dc%d" $closemid $frontrnd] configure -text "\u00F8"];
    }
    
    proc vfphi {} {
	variable frontrnd;
	variable closemid
	eval [list [format ".ipaev.r%dc%d" $closemid $frontrnd] configure -text "o\u0308"];
    }

    proc vroe {} {
	variable frontrnd;
	variable openmid
	eval [list [format ".ipaev.r%dc%d" $openmid $frontrnd] configure -text "\u0153"];
    }

    proc vfoe {} {
	variable frontrnd;
	variable openmid
	eval [list [format ".ipaev.r%dc%d" $openmid $frontrnd] configure -text "\u0254\0308"];
    }


    proc PopupIPAEntryV {} {
	variable frontness
	variable close
	variable closeclosemid
	variable closemid
	variable openmid
	variable midmid
	variable openopenmid
	variable open
	variable lastvrow

	variable height
	variable fronturd
	variable frontrnd
	variable centurd
	variable centrnd
	variable backurd
	variable backrnd
	variable lastvcolumn

	variable IPAEVColumnLabelList
	variable IPAEVRowLabelList
	global DisplayVowelChartColumnLabelsP
	global DisplayVowelChartRowLabelsP

	set xp 2;
	set yp 3;
	toplevel .ipaev -borderwidth 3
	wm title .ipaev [_ "Vowel Symbols"]
	BindKeys .ipaev;
	set DownMsg [_ "Display IPA Vowel Chart"];
	set UpMsg   [_ "Remove IPA Vowel Chart"];
	bind .ipaev <Destroy> \
	    "set ::IPAVIsDisplayedP 0;$::CEM entryconfigure $::ToggleIPAVIndex -label \"$DownMsg\""
	bind .ipaev <Unmap> \
	    "set ::IPAVIsDisplayedP 0;$::CEM entryconfigure $::ToggleIPAVIndex -label \"$DownMsg\""
	bind .ipaev <Map> \
	    "set ::IPAVIsDisplayedP 1;$::CEM entryconfigure $::ToggleIPAVIndex -label \"$UpMsg\""

	#Column headers
	set tmp [label [format ".ipaev.r%dc%d" $height $frontness] \
	     -text [_ "IPA\nVowels"]  -padx $xp -pady $yp -bg $::ColorSpecs(IPAHeadings,Background)]
	lappend IPAEVColumnLabelList $tmp;
	lappend IPAEVRowLabelList $tmp;
	lappend IPAEVColumnLabelList [label [format ".ipaev.r%dc%d" $height $fronturd] \
	     -text [_ "Front\nUnrounded"]  -padx $xp -pady $yp \
     	     -bg $::ColorSpecs(IPAHeadings,Background)]
	lappend IPAEVColumnLabelList [label [format ".ipaev.r%dc%d" $height $frontrnd] \
	     -text [_ "Front\nRounded"]  -padx $xp -pady $yp \
  	     -bg $::ColorSpecs(IPAHeadings,Background)]
	lappend IPAEVColumnLabelList [label [format ".ipaev.r%dc%d" $height $centurd] \
	     -text [_ "Central\nUnrounded"]  -padx $xp -pady $yp \
	     -bg $::ColorSpecs(IPAHeadings,Background)]
	lappend IPAEVColumnLabelList [label [format ".ipaev.r%dc%d" $height $centrnd] \
	     -text [_ "Central\nRounded"]  -padx $xp -pady $yp \
   	     -bg $::ColorSpecs(IPAHeadings,Background)]
	lappend IPAEVColumnLabelList [label [format ".ipaev.r%dc%d" $height $backurd] \
	     -text [_ "Back\nUnrounded"]  -padx $xp -pady $yp \
  	     -bg $::ColorSpecs(IPAHeadings,Background)]
	lappend IPAEVColumnLabelList [label [format ".ipaev.r%dc%d" $height $backrnd] \
	     -text [_ "Back\nRounded"]  -padx $xp -pady $yp \
  	     -bg $::ColorSpecs(IPAHeadings,Background)]


	#Close vowels
	lappend IPAEVRowLabelList [label [format ".ipaev.r%dc%d" $close $frontness] \
	   -text [_ "Close"] -anchor w  -padx $xp -pady $yp \
  	   -bg $::ColorSpecs(IPAHeadings,Background)]
	set cmd {$::InsertionTarget insert insert [list i]}
	button [format ".ipaev.r%dc%d"  $close $fronturd] \
	     -text "i"   -padx $xp -pady $yp -command  $cmd
	set cmd {$::InsertionTarget insert insert [list y]}
	set bn  [format ".ipaev.r%dc%d"  $close $frontrnd]
	button $bn -text "y"   -padx $xp -pady $yp -command  $cmd
	bind $bn <<B3>> {$::InsertionTarget insert insert [list \u00FC]}
	bind $bn <Enter> {ipaentry::vfy}
	bind $bn <Leave> {ipaentry::vry}
	bhcham $bn;

	set cmd {$::InsertionTarget insert insert [list \u0268]}
	button [format ".ipaev.r%dc%d"  $close $centurd] \
	     -text "\u0268"   -padx $xp -pady $yp -command  $cmd
	set cmd {$::InsertionTarget insert insert [list \u0289]}
	button [format ".ipaev.r%dc%d"  $close $centrnd] \
	     -text "\u0289"   -padx $xp -pady $yp -command  $cmd
	set cmd {$::InsertionTarget insert insert [list \u0268]}
	button [format ".ipaev.r%dc%d"  $close $backurd] \
	     -text "\u0268"   -padx $xp -pady $yp -command  $cmd
	set cmd {$::InsertionTarget insert insert [list u]}
	button [format ".ipaev.r%dc%d"  $close $backrnd] \
	     -text "u"   -padx $xp -pady $yp -command  $cmd

	# Close close mid vowels
	lappend IPAEVRowLabelList [label [format ".ipaev.r%dc%d" $closeclosemid $frontness] \
	     -text [_ "Close Close Mid"] -anchor w  -padx $xp -pady $yp \
	  -bg $::ColorSpecs(IPAHeadings,Background)]
	set cmd {$::InsertionTarget insert insert [list I]}
	button [format ".ipaev.r%dc%d"  $closeclosemid $fronturd] \
	     -text "I"   -padx $xp -pady $yp -command  $cmd
	set cmd {$::InsertionTarget insert insert [list Y]}
	button [format ".ipaev.r%dc%d"  $closeclosemid $frontrnd] \
	     -text "Y"   -padx $xp -pady $yp -command  $cmd
	label [format ".ipaev.r%dc%d"  $closeclosemid $centurd] \
	     -text ""   -padx $xp -pady $yp
	set cmd {$::InsertionTarget insert insert [list \u028A]}
	button [format ".ipaev.r%dc%d"  $closeclosemid $centrnd] \
	     -text "\u028A"   -padx $xp -pady $yp -command  $cmd
	label [format ".ipaev.r%dc%d"  $closeclosemid $backurd] \
	     -text ""   -padx $xp -pady $yp
	label [format ".ipaev.r%dc%d"  $closeclosemid $backrnd] \
	     -text ""   -padx $xp -pady $yp

	# Close mid vowels
	lappend IPAEVRowLabelList [label [format ".ipaev.r%dc%d" $closemid $frontness] \
	     -text [_ "Close Mid"] -anchor w  -padx $xp -pady $yp \
	  -bg $::ColorSpecs(IPAHeadings,Background)]
	set cmd {$::InsertionTarget insert insert [list e]}
	button [format ".ipaev.r%dc%d"  $closemid $fronturd] \
	     -text "e"   -padx $xp -pady $yp -command  $cmd

	set cmd {$::InsertionTarget insert insert [list \u00F8]}
	set bn [format ".ipaev.r%dc%d"  $closemid $frontrnd]
	button $bn -text "\u00F8"   -padx $xp -pady $yp -command  $cmd
	bind $bn <<B3>> {$::InsertionTarget insert insert [list o\u0308]}
	bind $bn <Enter> {ipaentry::vfphi}
	bind $bn <Leave> {ipaentry::vrphi}
	bhcham $bn;

	set cmd {$::InsertionTarget insert insert [list \u0258]}
	button [format ".ipaev.r%dc%d"  $closemid $centurd] \
	     -text "\u0258"   -padx $xp -pady $yp -command  $cmd
	set cmd {$::InsertionTarget insert insert [list \u0275]}
	button [format ".ipaev.r%dc%d"  $closemid $centrnd] \
	     -text "\u0275"   -padx $xp -pady $yp -command  $cmd
	set cmd {$::InsertionTarget insert insert [list \u0264]}
	button [format ".ipaev.r%dc%d"  $closemid $backurd] \
	     -text "\u0264"   -padx $xp -pady $yp -command  $cmd
	set cmd {$::InsertionTarget insert insert [list o]}
	button [format ".ipaev.r%dc%d"  $closemid $backrnd] \
	     -text "o"   -padx $xp -pady $yp -command  $cmd

	# Mid mid vowels
	lappend IPAEVRowLabelList [label [format ".ipaev.r%dc%d" $midmid $frontness] \
	     -text [_ "Mid Mid"] -anchor w  -padx $xp -pady $yp \
	  -bg $::ColorSpecs(IPAHeadings,Background)]
	label [format ".ipaev.r%dc%d"  $midmid $fronturd] \
	     -text ""   -padx $xp -pady $yp
	label [format ".ipaev.r%dc%d"  $midmid $frontrnd] \
	     -text ""   -padx $xp -pady $yp
	set cmd {$::InsertionTarget insert insert [list \u0259]}
	button [format ".ipaev.r%dc%d"  $midmid $centurd] \
	     -text "\u0259"   -padx $xp -pady $yp -command  $cmd
	set cmd {BackDelete $::InsertionTarget}
	set bn [format ".ipaev.r%dc%d" $midmid $centrnd];
	button $bn -text [_ "Delete"]  \
	     -padx $xp -pady $yp -command $cmd -background "\#E0D0FF";
	set DeleteButton $bn;
	label [format ".ipaev.r%dc%d"  $midmid $backurd] -text ""   -padx $xp -pady $yp
	label [format ".ipaev.r%dc%d"  $midmid $backrnd] -text ""   -padx $xp -pady $yp

	# Open mid vowels
	lappend IPAEVRowLabelList [label [format ".ipaev.r%dc%d" $openmid $frontness] \
	     -text [_ "Open Mid"] -anchor w  -padx $xp -pady $yp \
  	     -bg $::ColorSpecs(IPAHeadings,Background)]
	set cmd {$::InsertionTarget insert insert [list \u025B]}
	button [format ".ipaev.r%dc%d"  $openmid $fronturd] \
	     -text \u025B   -padx $xp -pady $yp -command  $cmd

	set cmd {$::InsertionTarget insert insert [list \u0153]}
	set bn [format ".ipaev.r%dc%d"  $openmid $frontrnd]
	button $bn -text "\u0153"   -padx $xp -pady $yp -command  $cmd
	bind $bn <<B3>> {$::InsertionTarget insert insert [list \u0254\u0308]}
	bind $bn <Enter> {ipaentry::vfoe}
	bind $bn <Leave> {ipaentry::vroe}
	bhcham $bn;

	set cmd {$::InsertionTarget insert insert [list \u025C]}
	button [format ".ipaev.r%dc%d"  $openmid $centurd] \
	     -text "\u025C"   -padx $xp -pady $yp -command  $cmd
	set cmd {$::InsertionTarget insert insert [list \u025E]}
	button [format ".ipaev.r%dc%d"  $openmid $centrnd] \
	     -text "\u025E"   -padx $xp -pady $yp -command  $cmd
	set cmd {$::InsertionTarget insert insert [list \u028C]}
	button [format ".ipaev.r%dc%d"  $openmid $backurd] \
	     -text "\u028C"   -padx $xp -pady $yp -command  $cmd
	set cmd {$::InsertionTarget insert insert [list \u0254]}
	button [format ".ipaev.r%dc%d"  $openmid $backrnd] \
	     -text "\u0254"   -padx $xp -pady $yp -command  $cmd

	# Open open mid vowels
	lappend IPAEVRowLabelList [label [format ".ipaev.r%dc%d" $openopenmid $frontness] \
	     -text [_ "Open Open Mid"] -anchor w  -padx $xp -pady $yp \
  	     -bg $::ColorSpecs(IPAHeadings,Background)]
	set cmd {$::InsertionTarget insert insert [list \u00E6]}
	button [format ".ipaev.r%dc%d"  $openopenmid $fronturd] \
	     -text \u00E6   -padx $xp -pady $yp -command  $cmd
	label [format ".ipaev.r%dc%d"  $openopenmid $frontrnd] -text ""   -padx $xp -pady $yp
	set cmd {$::InsertionTarget insert insert [list \u0250]}
	button [format ".ipaev.r%dc%d"  $openopenmid $centurd] \
	     -text "\u0250"   -padx $xp -pady $yp -command  $cmd
	label [format ".ipaev.r%dc%d"  $openopenmid $centrnd] \
		     -text ""   -padx $xp -pady $yp
	label [format ".ipaev.r%dc%d"  $openopenmid $backurd] \
	     -text ""   -padx $xp -pady $yp
	label [format ".ipaev.r%dc%d"  $openopenmid $backrnd] \
	     -text ""   -padx $xp -pady $yp

	# Open  vowels
	lappend IPAEVRowLabelList [label [format ".ipaev.r%dc%d" $open $frontness] \
	   -text [_ "Open"] -anchor w  -padx $xp -pady $yp \
	   -bg $::ColorSpecs(IPAHeadings,Background)]
	set cmd {$::InsertionTarget insert insert [list a]}
	button [format ".ipaev.r%dc%d"  $open $fronturd] \
	     -text "a"   -padx $xp -pady $yp -command  $cmd
	set cmd {$::InsertionTarget insert insert [list \u0276]}
	button [format ".ipaev.r%dc%d"  $open $frontrnd] \
	     -text "\u0276"   -padx $xp -pady $yp -command  $cmd
	label [format ".ipaev.r%dc%d"  $open $centurd] \
	     -text ""   -padx $xp -pady $yp
	label [format ".ipaev.r%dc%d"  $open $centrnd] \
	     -text ""   -padx $xp -pady $yp
	set cmd {$::InsertionTarget insert insert [list \u0251]}
	button [format ".ipaev.r%dc%d"  $open $backurd] \
	     -text "\u0251"   -padx $xp -pady $yp -command  $cmd
	set cmd {$::InsertionTarget insert insert [list \u0252]}
	button [format ".ipaev.r%dc%d"  $open  $backrnd] \
	     -text "\u0252"   -padx $xp -pady $yp -command  $cmd

	for {set row 0} {$row <= $lastvrow} {incr row} {
	    set line [list];
	    for {set col 0} {$col <= $lastvcolumn} {incr col} {
		set cell [format ".ipaev.r%dc%d" $row $col]
		lappend line $cell
		balloonhelp_for $cell  \
		    [_ "Left click to insert standard characters.\n\
Right click to insert alternative characters."]
	    }
	    eval grid $line -sticky news;
	}
	balloonhelpd_for $DeleteButton [_ "No, there isn't a mid-mid central rounded vowel called \"Delete\".\nThis is so that you can correct mistakes while using\nthe mouse, without having to go back to the keyboard."]
	if {!$DisplayVowelChartColumnLabelsP} {UnpackVowelColumnLabels}
	if {!$DisplayVowelChartRowLabelsP} {UnpackVowelRowLabels}
    }

#Rearrange into functional groups, e.g. tone marks, vowel quality marks,
#etc. Separate IPA and non-IPA.

    proc PopupIPAEntryD {} {
	set PerRow 10;
	set BaseChar "o";
	set xp 2;
	set yp 3;
	toplevel .ipaed -borderwidth 3
	wm title .ipaed [_ "Phonetic Diacritics"]
	BindKeys .ipaed
	set DownMsg [_ "Display IPA Diacritic Chart"];
	set UpMsg   [_ "Remove IPA Diacritic Chart"];
	bind .ipaed <Destroy> \
	    "set ::IPADIsDisplayedP 0;$::CEM entryconfigure $::ToggleIPADIndex -label \"$DownMsg\""
	bind .ipaed <Unmap> \
	    "set ::IPADIsDisplayedP 0;$::CEM entryconfigure $::ToggleIPADIndex -label \"$DownMsg\""
	bind .ipaed <Map> \
	    "set ::IPADIsDisplayedP 1;$::CEM entryconfigure $::ToggleIPADIndex -label \"$UpMsg\""
	array set Diacritics [list\
				  0  {"\u02D0" "long"}\
				  1  {"\u02D1" "half long"}\
				  2  {"\u0303" "nasalized"}\
				  3  {"\u0324" "breathy voice"}\
				  4  {"\u0325" "voiceless"}\
				  5  {"\u032C" "voiced"}\
				  6  {"\u031A" "unreleased"}\
				  7  {"\u031C" "lower/open variety of vowel"}\
				  8  {"\u031D" "raised/closed variety of vowel"}\
				  9  {"\u031E" "lower/open variety of vowel"}\
				  10  {"\u031F" "advanced/fronted"}\
				  11  {"\u0320" "retracted/backed"}\
				  12  {"\u0321" "palatalized"}\
				  13  {"\u0322" "retroflex"}\
				  14  {"\u0323" "closer variety of vowel/retroflex"}\
				  15  {"\u0329" "syllabic"}\
				  16  {"\u032A" "dental"}\
				  17  {"\u032B" "labialized"}\
				  18  {"\u0330" "creaky voice"}\
				  19  {"\u0334" "velarized/pharyngealized"}\
				  20  {"\u0346" "dentolabial"}\
				  21  {"\u0347" "alveolar"}\
				  22  {"\u0348" "strong articulation"}\
				  23  {"\u0349" "weak articulation"}\
				  24  {"\u02CA" "high tone"}\
				  25  {"\u02CB" "low tone"}\
				  26  {"\u0302" "falling tone"}\
				  27  {"\u0304" "long"}\
				  28  {"\u0306" "short"}\
				  29  {"\u0308" "non-canonical backness"}\
				  30  {"\u02CC" "secondary stress"}\
				  31  {"\u02C8" "primary stress/downstep"}\
				  32  {"\u02B8" "palatalized"}\
				  33  {"\u02DE" "rhotacized"}\
				  34  {"\u0328" "nasalized"}\
				  35  {"\u034A" "denasal"}\
				  36  {"\u034B" "nasal escape"}\
				  37  {"\u034C" "velopharyngeal friction"}\
				  38  {"\u034D" "labial spreading"}\
				  39  {"\u034E" "whistled"}
				 ];

	set DiacriticCnt [llength [array names Diacritics]];
	set Rows [expr ceil(double($DiacriticCnt)/double($PerRow))]
	set Total [expr $PerRow * $Rows]
	#Generate buttons with blank labels for empty padding slots
	for {set k 0} {$k < $Total} {incr k} {
	    set row [expr $k/$PerRow]
	    set col [expr $k%$PerRow]
	    if {[info exist Diacritics($k)]} {
		button .ipaed.r${row}c${col} -text "$BaseChar[lindex $Diacritics($k) 0]"\
		    -padx $xp -pady $yp\
		    -command "\$::InsertionTarget insert insert  [lindex $Diacritics($k) 0]"
		balloonhelpd_for .ipaed.r${row}c${col} [_ [lindex $Diacritics($k) 1]]  
	    } else {
		label .ipaed.r${row}c${col} -text "";
	    }
	    set LastRow $row;
	    set LastCol $col;
	}
	#Lay the buttons and labels out in a grid.
	for {set row 0} {$row <= $LastRow} {incr row} {
	    set line [list];
	    for {set col 0} {$col <= $LastCol} {incr col} {
		set cell [format ".ipaed.r%dc%d" $row $col]
		lappend line $cell
	    }
	    eval grid $line -sticky news;
	}
    }

#Accented letters
    proc PopupIPAEntryA {} {
	set PerRow 12;
	set xp 3;
	set yp 3;
	toplevel .ipaea -borderwidth 4
	wm title .ipaea [_ "Accented Letters"]
	BindKeys .ipaea
	set DownMsg [_ "Display Accented Letter Chart"]
	set UpMsg   [_ "Display Accented Letter Chart"]
	bind .ipaea <Destroy> \
	    "set ::IPAAIsDisplayedP 0;$::CEM entryconfigure $::ToggleIPAAIndex -label \"$DownMsg\""
	bind .ipaea <Unmap> \
	    "set ::IPAAIsDisplayedP 0;$::CEM entryconfigure $::ToggleIPAAIndex -label \"$DownMsg\""
	bind .ipaea <Map> \
	    "set ::IPAAIsDisplayedP 0;$::CEM entryconfigure $::ToggleIPAAIndex -label \"$UpMsg\""
	set AccentedLetters [list \
				 {"\u00E0" "a with grave"}\
				 {"\u00E1" "a with acute"}\
				 {"\u00E2" "a with circumflex"}\
				 {"\u00E3" "a with tilde"}\
				 {"\u00E4" "a with diaresis"}\
				 {"\u00E5" "a with ring above"}\
				 {"\u0101" "a with macron"}\
				 {"\u0103" "a with breve"}\
				 {"\u0105" "a with ogonek"}\
				 {"\u01CE" "a with caron"}\
				 {"\u0201" "a with double grave"}\
				 {"\u0203" "a with inverted breve"}\
				 {"\u01DF" "a with diaresis and macron"}\
				 {"\u01E1" "a with dot above and macron"}\
				 {"\u01FB" "a with ring above"}\
				 {"\u0227" "a with dot above"}\
				 {"\u1EA1" "a with dot below"}\
				 {"\u01E3" "ae with macron"}\
				 {"\u01FD" "ash with acute"}\
				 {"\u0180" "b with stroke"}\
				 {"\u0183" "b with topbar"}\
				 {"\u1E03" "b with dot above"}\
				 {"\u1E05" "b with dot below"}\
				 {"\u1E07" "b with line below"}\
				 {"\u0188" "c with hook"}\
				 {"\u0107" "c with acute"}\
				 {"\u0109" "c with circumflex"}\
				 {"\u010B" "c with dot above"}\
				 {"\u00E7" "c with cedilla"}\
				 {"\u1E09" "c with cedilla and acute"}\
				 {"\u010D" "c with caron"}\
				 {"\u018c" "d with topbar"}\
				 {"\u010F" "d with caron"}\
				 {"\u0111" "d with stroke"}\
				 {"\u0221" "d with curl"}\
				 {"\u1E0B" "d with dot above"}\
				 {"\u1E0D" "d with dot below"}\
				 {"\u1E0F" "d with line below"}\
				 {"\u021F" "h with caron"}\
				 {"\u00E8" "e with grave"}\
				 {"\u00E9" "e with acute"}\
				 {"\u00EA" "e with circumflex"}\
				 {"\u00EB" "e with diaresis"}\
				 {"\u0113" "e with macron"}\
				 {"\u0115" "e with breve"}\
				 {"\u0117" "e with dot above"}\
				 {"\u1EB9" "e with dot below"}\
				 {"\u0119" "e with ogonek"}\
				 {"\u011B" "e with caron"}\
				 {"\u0229" "e with cedilla"}\
				 {"\u0205" "e with double grave"}\
				 {"\u0207" "e with inverted breve"}\
				 {"\u01F5" "g with acute"}\
				 {"\u011D" "g with circumflex"}\
				 {"\u011F" "g with breve"}\
				 {"\u0121" "g with dot above"}\
				 {"\u0123" "g with cedilla"}\
				 {"\u01E5" "g with stroke"}\
				 {"\u01E7" "g with caron"}\
				 {"\u0125" "h with circumflex"}\
				 {"\u0127" "h with stroke"}\
				 {"\u1E25" "h with dot below"}\
				 {"\u00EC" "i with grave"}\
				 {"\u00ED" "i with acute"}\
				 {"\u00EE" "i with circumflex"}\
				 {"\u00EF" "i with diaresis"}\
				 {"\u0129" "i with tilde"}\
				 {"\u012B" "i with macron"}\
				 {"\u012D" "i with breve"}\
				 {"\u012F" "i with ogonek"}\
				 {"\u01D0" "i with caron"}\
				 {"\u0209" "i with double grave"}\
				 {"\u020B" "i with inverted breve"}\
				 {"\u1ECB" "i with dot below"}\
				 {"\u0131" "dotless i"}\
				 {"\u0135" "j with circumflex"}\
				 {"\u01F0" "j with caron"}\
				 {"\u01E9" "k with caron"}\
				 {"\u0199" "k with hook"}\
				 {"\u0137" "k with cedilla "}\
				 {"\u1E33" "k with dot below"}\
				 {"\u013A" "l with acute"}\
				 {"\u013C" "l with cedilla"}\
				 {"\u013E" "l with caron"}\
				 {"\u0140" "l with middle dot"}\
				 {"\u0142" "l with stroke"}\
				 {"\u019A" "l with bar"}\
				 {"\u0234" "l with curl"}\
				 {"\u1E37" "l with dot below"}\
				 {"\u1E39" "l with dot below and macron"}\
				 {"\u1E3B" "l with line below"}\
				 {"\u019B" "lambda with stroke"}\
				 {"\u0235" "n with a curl"}\
				 {"\u0146" "n with cedilla"}\
				 {"\u0148" "n with caron"}\
				 {"\u01F9" "n with grave"}\
				 {"\u00F1" "n with tilde"}\
				 {"\u019E" "n with long right leg"}\
				 {"\u0144" "n with acute"}\
				 {"\u1E43" "m with dot below"}\
				 {"\u1E45" "n with dot above"}\
				 {"\u1E47" "n with dot below"}\
				 {"\u1E49" "n with line below"}\
				 {"\u00F2" "o with grave"}\
				 {"\u00F3" "o with acute"}\
				 {"\u00F4" "o with circumflex"}\
				 {"\u00F5" "o with tilde"}\
				 {"\u00F6" "o with diaresis"}\
				 {"\u00F8" "o with stroke"}\
				 {"\u014D" "o with macron"}\
				 {"\u014F" "o with breve"}\
				 {"\u0151" "o with double acute"}\
				 {"\u01A1" "o with horn"}\
				 {"\u01EB" "o with ogonek"}\
				 {"\u01ED" "o with ogonek and macron"}\
				 {"\u01D2" "o with caron"}\
				 {"\u022B" "o with diaresis and macron"}\
				 {"\u022D" "o with tilde and macron"}\
				 {"\u022F" "o with dot above"}\
				 {"\u01FF" "o with stroke and acute"}\
				 {"\u020D" "o with double grave"}\
				 {"\u020F" "o with inverted breve"}\
				 {"\u0231" "o with dot above and macron"}\
				 {"\u1ECD" "o with dot below"}\
				 {"\u0223" "ou"}\
				 {"\u01A5" "p with hook"}\
				 {"\u0155" "r with acute"}\
				 {"\u0157" "r with cedilla"}\
				 {"\u0159" "r with caron"}\
				 {"\u0211" "r with double grave"}\
				 {"\u0213" "r with inverted breve"}\
				 {"\u1E5B" "r with dot below"}\
				 {"\u027F" "reversed r with fishhook"}\
				 {"\u015B" "s with acute"}\
				 {"\u015D" "s with circumflex"}\
				 {"\u015F" "s with cedilla"}\
				 {"\u0161" "s with caron"}\
				 {"\u0219" "s with comma below"}\
				 {"\u1E63" "s with dot below"}\
				 {"\u021B" "t with comma below"}\
				 {"\u01AB" "t with palatal hook"}\
				 {"\u01AD" "t with hook"}\
				 {"\u0163" "t wwith cedilla"}\
				 {"\u0165" "t with caron"}\
				 {"\u0167" "t with stroke"}\
				 {"\u0236" "t with curl"}\
				 {"\u00F9" "u with grave"}\
				 {"\u00FA" "u with acute"}\
				 {"\u00FB" "u with circumflex"}\
				 {"\u00FC" "u with diaresis"}\
				 {"\u01D4" "u with caron"}\
				 {"\u01D6" "u with diaresis and macron"}\
				 {"\u01D8" "u with diaresis and acute"}\
				 {"\u01DA" "u with diaresis and caron"}\
				 {"\u01DC" "u with diaresis and grave"}\
				 {"\u01B0" "u with horn"}\
				 {"\u0169" "u with tilde"}\
				 {"\u016B" "u with macron"}\
				 {"\u016D" "u with breve"}\
				 {"\u016F" "u with ring above"}\
				 {"\u0171" "u with double acute"}\
				 {"\u0173" "u with ogonek"}\
				 {"\u0215" "u with double grave"}\
				 {"\u0217" "u with inverted breve"}\
				 {"\u1EE5" "u with dot below"}\
				 {"\u01B4" "y with hook"}\
				 {"\u00FD" "y with acute"}\
				 {"\u00FF" "y with diaresis"}\
				 {"\u0233" "y with macron"}\
				 {"\u0175" "w with circumflex"}\
				 {"\u0177" "y with circumflex"}\
				 {"\u017A" "z with acute"}\
				 {"\u017C" "z with dot above"}\
				 {"\u017E" "z with caron"}\
				 {"\u01B6" "z with stroke"}\
				 {"\u0225" "z with hook"}\
				 {"\u01EF" "ezh with caron"}\
							 ];

#Done through 0236 			 {"\u" ""}\

	set AccentedLetterCnt [llength $AccentedLetters];
	set Rows [expr ceil(double($AccentedLetterCnt)/double($PerRow))]
	set Total [expr $PerRow * $Rows]
	#Generate buttons with blank labels for empty padding slots
	for {set k 0} {$k < $Total} {incr k} {
	    set row [expr $k/$PerRow]
	    set col [expr $k%$PerRow]
	    if {$k < $AccentedLetterCnt} {
		button .ipaea.r${row}c${col} -text "[lindex [lindex $AccentedLetters $k] 0]"\
		    -padx $xp -pady $yp\
		    -command "\$::InsertionTarget insert insert  [lindex [lindex $AccentedLetters $k] 0]"
		balloonhelpd_for .ipaea.r${row}c${col} [_ [lindex [lindex $AccentedLetters $k] 1] ]  
	    } else {
		label .ipaea.r${row}c${col} -text "";
	    }
	}
	set LastRow $row;
	set LastCol $col;
	set LastCell .ipaea.r${row}c${col}
	destroy $LastCell
	button $LastCell -image $::LeftArrowImage -command {BackDelete $::InsertionTarget}
	balloonhelpd_for $LastCell  [_ "Delete, so that you can correct mistakes while using\nthe mouse, without having to go back to the keyboard."]
	
	#Lay the buttons and labels out in a grid.
	for {set row 0} {$row <= $LastRow} {incr row} {
	    set line [list];
	    for {set col 0} {$col <= $LastCol} {incr col} {
		set cell [format ".ipaea.r%dc%d" $row $col]
		lappend line $cell
	    }
	    eval grid $line -sticky news;
	}
    }

}



set LeftArrowImage [image create photo -data {
R0lGODlhFAAUAIAAAAAAAL+/vyH5BAEAAAEALAAAAAAUABQAAAIqjI+py43gGIAxTVrNxXVz
54WTIopWGZ7oRq7X4o4wm2lvbX+ZjGv9/ysAADs=
}]

proc BackDelete {w} {
    if {[string equal [winfo class $w] "Text"]} {
	set Insert [$w index insert]
	set FirstHalf  [$w get 1.0 $Insert-1chars]
	set SecondHalf [string trimright [$w get insert end]]
	$w delete 1.0 end;
	$w insert 1.0 $FirstHalf$SecondHalf;
    } else {
	set delind [expr [$w index insert] -1];
	$w delete $delind;
    }
}

proc PopupCharEntryByCode {} {
    toplevel .charent -borderwidth 4 -relief raised
    BindKeys .charent;
    wm title .charent "Entry By Codepoint";
    after idle {
	update idletasks
	set xmax [winfo screenwidth .charent]
	set ymax [winfo screenheight .charent]
	set x0 [expr 1 * ($xmax -[winfo reqwidth .charent])/3];
	set y0 [expr 1 * ($ymax -[winfo reqheight .charent])/3];
	wm geometry .charent "+$x0+$y0";
    }
    label .charent.title -text [_ "Insert Character by Numerical Code"]
    frame .charent.ef;
    entry .charent.ef.ent -width 8 -font MainFont -relief flat -bg \#E0EEFF;
    label .charent.ef.prefix -text "0x" -font MainFont
    pack .charent.ef.prefix -side left  -expand 1 -fill x -anchor e
    pack .charent.ef.ent    -side right -expand 1 -fill x -anchor w
    button .charent.d  -text [_ "Dismiss"] -command {destroy .charent}
    button .charent.x  -text [_ "Delete"] -command [list BackDelete $::CharByCodeInsertionTarget]
    button .charent.i  -text [_ "Insert"] -command {InsertUnicode}
    pack .charent.title -side top
    pack .charent.ef -side top
    pack .charent.d -side left -expand 1 -fill both
    pack .charent.x -side left -expand 1 -fill both
    pack .charent.i -side right -expand 1 -fill both
    focus .charent.ef.ent;
    set DownMsg [_ "Display Widget for Entering Characters by Unicode Code"];
    set UpMsg   [_ "Remove Widget for Entering Characters by Unicode Code"];
    bind .charent <Destroy> \
	"set ::CharEntryByCodeIsDisplayedP 0;$::CEM entryconfigure $::ToggleCharEntryByCodeIndex -label \"$DownMsg\""
    bind .charent <Unmap> \
	"set ::CharEntryByCodeIsDisplayedP 0;$::CEM entryconfigure $::ToggleCharEntryByCodeIndex -label \"$DownMsg\""
    bind .charent <Map> \
	"set ::CharEntryByCodeIsDisplayedP 1;$::CEM entryconfigure $::ToggleCharEntryByCodeIndex -label \"$UpMsg\""
    bind .charent.ef.ent <Destroy> {set ::InsertionTarget $::REG}
    bind .charent.ef.ent <Return> {InsertUnicode}
    bind .charent.ef.ent <Control-k> {.charent.ef.ent delete 0 end;break}


    set charentbh  [_ "Enter a character by its Unicode code, as a sequence of four hexadecimal digits.\nFor example, you may specify \'\u0298\', the International Phonetic Alphabet\nsymbol for the bilabial click, as 0298, and the Chinese character \'\u4E39\' \"egg\" as 4E39.\nDo not type the prefix 0x shown to the left of the entry box.\nIt is entered for you automatically. Return inserts the current character.\nControl-k erases the current character code."]
    balloonhelp_for .charent $charentbh
    balloonhelp_for .charent.title $charentbh
    balloonhelp_for .charent.ef.ent $charentbh
    balloonhelp_for .charent.i $charentbh
    balloonhelp_for .charent.d $charentbh
    balloonhelp_for .charent.x $charentbh
    set ::CharEntryByCodeIsDisplayedP 1;
}

#Get entry from popup, validate it, and insert it into the insertion target.
proc InsertUnicode {} {
    ClearMessageWindow;
    set str [.charent.ef.ent get];
    if {[string length $str] == 0} {
	ShowMessage [_ "The empty string is not a valid Unicode codepoint"]
	return ;
    }
    #Validate
    set BadValueP 0;
    #Make sure all digits are hex and that prefix is appropriate.
    if {[regexp {[[:xdigit:]]{4,4}} $str] == 0} {
	ShowMessage [_ "$str is not a well-formed hexadecimal Unicode value"]
	return;
    }
    set str [format "0x%s" $str]
    if {[scan $str "%x" num] < 1} {
	ShowMessage [format [_ "Ill-formed code %s"] $str]
	return;
    }

    #Reject illegal codepoints.
    if {$num  >  65535} {
	ShowMessage [_ "Tcl/Tk may not support codepoints outside the BMP (Plane 0)."]
    }
    set BadValueP 0;
    set BadRanges [list\
  	       0x0750 0x077F\
	       0x07C0 0x08FF\
	       0x1380 0x139F\
	       0x18B0 0x18FF\
	       0x1980 0x19DF\
	       0x1A00 0x1CFF\
	       0x1D80 0x1DFF\
	       0x2C00 0x2E7F\
	       0x2FE0 0x2FEF\
	       0x31C0 0x31EF\
	       0x9FB0 0x9FFF\
	       0xA4D0 0xABFF\
	       0xD7B0 0xD7FF\
	       0xD800 0xDBFF\
	       0xDC00 0xDFFF\
	       0xFE10 0xFE1F\
	       0x10140 0x102FF\
	       0x104B0 0x107FF\
	       0x10840 0x1CFFF\
	       0x1D200 0x1D2FF\
	       0x1D360 0x1D3FF\
	       0x1D800 0x1FFFF\
	       0x2A6E0 0x2F7FF\
	       0x2FAB0 0x2FFFF\
	       0xE0080 0xE00FF\
	       0xE01F0 0xEFFFF\
	       0xFFFFE 0xFFFFF];

    for {set k 0} {$k < [llength $BadRanges]} {incr k} {
	if { ($num >= [lindex $BadRanges [expr 2 * $k]]) &&\
		 ($num <= [lindex $BadRanges [expr (2 * $k) + 1]])} { 
	    set BadValueP 1;
	    break; 
	}
    }
    if {$BadValueP} {
	ShowMessage [format [_ "%s is not a valid Unicode codepoint"] $str]
	return;
    }
    if {$num >= 1114110} {
	ShowMessage [_ "Warning: codepoints above 0x10FFFD have not been assigned as of version 4.0."]
    }

    #Insert
    $::CharByCodeInsertionTarget insert insert [format "%c" $num]
}


proc IndicateIPACUp {} {
	$::CEM entryconfigure $::ToggleIPACIndex \
	    -label [_ "Remove IPA Consonant Chart"];
	set ::IPACIsDisplayedP 1;
}

proc IndicateIPACDown {} {
	$::CEM entryconfigure $::ToggleIPACIndex \
	    -label [_ "Display IPA Consonant Chart"];
	set ::IPACIsDisplayedP 0;
}

proc ToggleIPAC {} {
    global IPACIsDisplayedP;
    global m;

    if { $IPACIsDisplayedP == 0} {
	if {[winfo exists .ipaec]} {
	    wm deiconify .ipaec;
	} else { 
	    ipaentry::PopupIPAEntryC;
	}
	IndicateIPACUp;
    } else {
	wm iconify .ipaec;
	IndicateIPACDown;
    }
}

proc IndicateIPAVUp {} {
	$::CEM entryconfigure $::ToggleIPAVIndex \
	    -label [_ "Remove IPA Vowel Chart"];
	set ::IPAVIsDisplayedP 1;
}

proc IndicateIPAVDown {} {
	$::CEM entryconfigure $::ToggleIPAVIndex \
	    -label [_ "Display IPA Vowel Chart"];
	set ::IPAVIsDisplayedP 0;
}

proc ToggleIPAV {} {
    global IPAVIsDisplayedP;
    global m;

    if { $IPAVIsDisplayedP == 0} {
	if {[winfo exists .ipaev]} {
	    wm deiconify .ipaev;
	} else { 
	    ipaentry::PopupIPAEntryV;
	}
	$::CEM entryconfigure $::ToggleIPAVIndex -label [_ "Remove IPA Vowel Chart"];
	set IPAVIsDisplayedP 1;
    } else {
	wm iconify .ipaev;
	$::CEM entryconfigure $::ToggleIPAVIndex -label [_ "Display IPA Vowel Chart"];
	set IPAVIsDisplayedP 0;
    }
}

proc IndicateIPADUp {} {
	$::CEM entryconfigure $::ToggleIPADIndex \
	    -label [_ "Remove IPA Diacritic Chart"];
	set ::IPADIsDisplayedP 1;
}

proc IndicateIPADDown {} {
	$::CEM entryconfigure $::ToggleIPADIndex \
	    -label [_ "Display IPA Diacritic Chart"];
	set ::IPADIsDisplayedP 0;
}

proc ToggleIPAD {} {
    global IPADIsDisplayedP;
    global m;

    if { $IPADIsDisplayedP == 0} {
	if {[winfo exists .ipaed]} {
	    wm deiconify .ipaed;
	} else { 
	    ipaentry::PopupIPAEntryD;
	}
	IndicateIPADUp
    } else {
	wm iconify .ipaed;
	IndicateIPADDown;
    }
}

proc IndicateIPAAUp {} {
	$::CEM entryconfigure $::ToggleIPAAIndex \
	    -label [_ "Remove Accented Letter Chart"];
	set ::IPAAIsDisplayedP 1;
}

proc IndicateIPAADown {} {
	$::CEM entryconfigure $::ToggleIPAAIndex \
	    -label [_ "Display Accented Letter Chart"];
	set ::IPAAIsDisplayedP 0;
}

proc ToggleIPAA {} {
    global m;

    if { $::IPAAIsDisplayedP == 0} {
	if {[winfo exists .ipaea]} {
	    wm deiconify .ipaea;
	} else { 
	    ipaentry::PopupIPAEntryA;
	}
	IndicateIPAAUp;
    } else {
	wm iconify .ipaea;
	IndicateIPAADown;
    }
}




proc IndicateCharEntryByCodeUp {} {
	$::CEM entryconfigure $::ToggleCharEntryByCodeIndex \
	    -label [_ "Remove Widget for Entering Characters by Unicode Code"];
	set ::CharEntryByCodeIsDisplayedP 1;
}

proc IndicateCharEntryByCodeDown {} {
	$::CEM entryconfigure $::ToggleCharEntryByCodeIndex \
	    -label [_ "Display Widget for Entering Characters by Unicode Code"];
	set ::CharEntryByCodeIsDisplayedP 0;
}

proc ToggleCharEntryByCode {} {
    global CharEntryByCodeIsDisplayedP;
    global m;

    if { $CharEntryByCodeIsDisplayedP == 0} {
	if {[winfo exists .charent]} {
	    wm deiconify .charent;
	    raise .charent;
	} else { 
	    PopupCharEntryByCode;
	}
	IndicateCharEntryByCodeUp;
    } else {
	wm iconify .charent;
	IndicateCharEntryByCodeDown;
    }
}

proc SetDisplayConsonantChartColumnLabelsP {b} {
    global DisplayConsonantChartColumnLabelsP
    set DisplayConsonantChartColumnLabelsP [Boolean $b];
}

proc SetDisplayConsonantChartRowLabelsP {b} {
    global DisplayConsonantChartRowLabelsP
    set DisplayConsonantChartRowLabelsP [Boolean $b];
}

proc SetDisplayVowelChartColumnLabelsP {b} {
    global DisplayVowelChartColumnLabelsP
    set DisplayVowelChartColumnLabelsP [Boolean $b]
}

proc SetDisplayVowelChartRowLabelsP {b} {
    global DisplayVowelChartRowLabelsP
    set DisplayVowelChartRowLabelsP [Boolean $b]
}

proc ControlDisplayConsonantChartColumnLabels {} {
    if {$::DisplayConsonantChartColumnLabelsP} {
	ipaentry::PackConsonantColumnLabels;
    } else {
	ipaentry::UnpackConsonantColumnLabels;
    }
}

proc ControlDisplayConsonantChartRowLabels {} {
    if {$::DisplayConsonantChartRowLabelsP} {
	ipaentry::PackConsonantRowLabels;
    } else {
	ipaentry::UnpackConsonantRowLabels;
    }
}

proc ControlDisplayVowelChartColumnLabels {} {
    if {$::DisplayVowelChartColumnLabelsP} {
	ipaentry::PackVowelColumnLabels;
    } else {
	ipaentry::UnpackVowelColumnLabels;
    }
}

proc ControlDisplayVowelChartRowLabels {} {
    if {$::DisplayVowelChartRowLabelsP} {
	ipaentry::PackVowelRowLabels;
    } else {
	ipaentry::UnpackVowelRowLabels;
    }
}

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

#File     -> LineList	LoadCustomCharacterChart
#LineList -> CDEF	DefineCustomCharacterChart
#CDEF     -> Popup      PopupSpecialPalette

proc ReadCustomCharacterChartPopup {args} {
    if {[llength $args]} {
	set dl [LoadCustomCharacterChart [lindex $args 0]]
    } else {
	set dl [LoadCustomCharacterChart];
    }
    PopupSpecialPalette [DefineCustomCharacterChart $dl]
}

proc DefineCustomCharacterChartPopup {ll} {
    PopupSpecialPalette [DefineCustomCharacterChart $ll];
}

#Returns a linelist.
proc LoadCustomCharacterChart {args} {
    if {[llength $args]} {
	set fn [lindex $args 0]
    } else {
	set fn [tk_getOpenFile -title [_ "Load Custom Character Chart"]];
	if {[string equal $fn ""]} {
	    ShowMessage [_ "File selection cancelled."];
	    return ;
	}
    }
    if { [catch {open $fn "r"} fhd ] != 0} {
	ShowMessage [format [_ "Unable to open character chart definition file %s."] \
			 [MinimizeFileName $fn]];
	return ;
    }
    set LineCnt 0
    while { [gets $fhd line] > 0} {
	lappend Lines $line;
	incr LineCnt
    }
    close $fhd;
    if {$LineCnt < 1} {
	ShowMessage [_ "File %s is empty" $fn]
	return "";
    }
    ShowMessage [format [_ "Loaded custom character chart definition from %s."] [MinimizeFileName $fn]]
    return $Lines;
}


#This procedure takes a list of lines defining a custom
#character entry chart, which may have been read from a
#standalone file or may be an instant list in an
#init file, and generates an internal character chart
#definition, which it stores. It does not actualy
#create a display
proc DefineCustomCharacterChart {LineList {fn NONE}} {
    #The first line is special. It contains meta-information:
    #the title, the desired number of buttons per row,
    #and the proposed font family and size. Only the
    #title is obligatory.
    set line [lindex $LineList 0]
    set flds [split $line "|"]
    set FieldCnt [llength $flds];
    set Title [lindex $flds 0];
    #The remaining lines contain pairs of code sequences and glosses.
    set cd [list];
    set LineList [lrange $LineList 1 end]
    foreach line $LineList {
	set f [split $line "|"];
	set gloss [lindex $f 1];
	set c [string trim [lindex $f 0] \"];
	set cf [split $c];
	set str "\{\"";
	foreach n $cf {
	    append str [format "%s" $n]
	}
	append str "\""
	append str [format " \"%s\"\}" $gloss]
	lappend cd $str;
    }
    set info [list [join $cd]]
    if {$FieldCnt > 1} {
	lappend info [lindex $flds 1];	# Columns
    }
    if {$FieldCnt > 2} {
	lappend info [lindex $flds 2];	# Font family
    }
    if {$FieldCnt > 3} {
	lappend info [lindex $flds 3];	# Font size
    }
    if {![string equal $fn NONE]} {	# File name
	lappend info $fn;
    }
    set ::SpecialCharacterPalette($Title) $info;
    $::CEM add command -label $Title -command "PopupSpecialPalette $Title";
    incr ::CharacterEntryMenuItems;
    return $Title;
}

#Creates a popup chart from a stored definition.
set SccCnt 0;
proc PopupSpecialPalette {Title} {
    set name [format ".scc%d" $::SccCnt] 
    if {[info exists ::SpecialCharacterPalette($Title,WidgetName)]} {
	set w $::SpecialCharacterPalette($Title,WidgetName);
	if {[winfo exists $w]} {
	    wm deiconify $w;
	    raise $w;
	    return ;
	}
    }
    set cdefs [lindex $::SpecialCharacterPalette($Title) 0];
    set Items [llength $::SpecialCharacterPalette($Title)];
    if {$Items > 1} {
	set PerRow [lindex $::SpecialCharacterPalette($Title) 1];
    } else {
	set PerRow 5;
    }
    if {$Items > 2} {
	set FontFamily [lindex $::SpecialCharacterPalette($Title) 2];
    } else {
	set FontFamily $::FontInfo(CharacterEntryFont,family)
    }
    if {$Items > 3} {
	set FontSize [lindex $::SpecialCharacterPalette($Title) 3];
    } else {
	set FontSize $::FontInfo(CharacterEntryFont,size);
    }
    incr ::SccCnt;
    set xp 3;
    set yp 3;
    toplevel $name -borderwidth 4
    set ::SpecialCharacterPalette($Title,WidgetName) $name; 
    wm title $name $Title
    iwidgets::scrolledframe $name.sf -vscrollmode dynamic -hscrollmode dynamic \
	-height 180 -width 250
    set tf [$name.sf childsite]
    pack $name.sf -expand 1 -fill both
    BindKeys $name
    set msg [_ "Left click to insert the lower-case character.\nRight click to insert the upper-case character."]
    balloonhelp_for $name.sf $msg
    bind [$name.sf component vertsb] <<B3>> \
	"ScrollbarMoveBigIncrement [$name.sf component vertsb] 0.20 %x %y"
    set CdefCnt [llength $cdefs];
    set Rows [expr int(ceil(double($CdefCnt)/double($PerRow)))]
    set Total [expr $PerRow * $Rows]
    if {$CdefCnt == $Total} {
	incr Rows;
	set Total [expr $PerRow * $Rows]
    }
    set fontname [string trimleft $name .]Font
    font create $fontname -family $FontFamily -size $FontSize
    for {set k 0} {$k < $Total} {incr k} {
	set row [expr $k/$PerRow]
	set col [expr $k%$PerRow]
	if {$k < $CdefCnt} {
	    set csalt "";
	    set entry [lindex $cdefs $k];
	    set chstr [lindex $entry 0];
	    set gloss [lindex $entry 1];
	    set chstrParts [split $chstr ":"];
	    if {[llength $chstrParts] > 1} {
		set cs    [lindex $chstrParts 0];
		set csalt [lindex $chstrParts 1];
	    } else {
		set cs [lindex $chstr 0];
	    }
	    button $tf.r${row}c${col} -text $cs\
		-padx $xp -pady $yp -font $fontname\
		-command "\$::InsertionTarget insert insert $cs"
	    if {![string equal $csalt ""]} {
		bind $tf.r${row}c${col} <<B3>> "\$::InsertionTarget insert insert $csalt"
	    }
	    balloonhelpd_for $tf.r${row}c${col} $gloss;
	} else {
	    set ln $tf.r${row}c${col};
	    #Generate buttons with blank labels for empty padding slots
	    label $ln  -text "";
	}
    }
    set LastRow $row;
    set LastCol $col;
    set LastCell $tf.r${row}c${col}
    destroy $LastCell
    button $LastCell -image $::LeftArrowImage -command {BackDelete $::InsertionTarget}
    balloonhelpd_for $LastCell  [_ "Delete, so that you can correct mistakes while using\nthe mouse, without having to go back to the keyboard."]
    
    #Lay the buttons and labels out in a grid.
    for {set row 0} {$row <= $LastRow} {incr row} {
	set line [list];
	for {set col 0} {$col <= $LastCol} {incr col} {
	    set cell [format "%s.r%dc%d" $tf $row $col]
	    lappend line $cell
	}
	eval grid $line -sticky news;
    }
    return $name;
}


proc ExecuteRegexp {} {
    global OutputOnlyChangedLinesP;
    global InData;
    global Program;
    global program;
    global Locale;
    global ExecCmd;
    global InputDataFromWindowP;
    global RegexpResult;
    global PipeP;
    global TempOutputFile;
    global errorCode;
    global DoSubstitutionsP;
    global PreviousActualRegexp;
    global Features;
    global UserClassesEnabledP;

    if {$::TestingFeaturesP} {
	ShowMessage [_ "Execution is impossible until feature testing is complete."]
	return ;
    }
    ClearMessageWindow;
    $::OUT configure -state normal
    $::OUT delete 1.0 end;

    #Get the data from the window if in edit mode
    if {$InputDataFromWindowP} {
	set InData [$::IND get 1.0 end];
    }
    if {$InData == ""} {
	ShowMessage [_ "There is no test data on which to run the regular expression!"];
#	return;
    }
    #The next bit is a little complicated because we trigger regexp execution
    #on carriage return, resulting in the potential presence of more than one
    #line in the regexp window.
    #First we get the whole contents of the regexp window.
    set Regexp [$::REG get];
    #Clear the regexp window.
    $::REG delete 0 end;
    #Now we parse out just the one line we want, which is the last one,
    set Regexp [string range $Regexp [expr [string last "\n" $Regexp] + 1] end];
    #And put that single line back into the regexp window.
    $::REG insert 0 [string trimright $Regexp];

    if {$Regexp == ""} {
	ShowMessage [_ "There is no regular expression to execute."];
	return;
    }

    if {[CheckModeCompatibility] == 0} {
	return ;
    }

    set Subexp ""; # This simplifies keeping the history list.
    if {$DoSubstitutionsP} { 
	set Subexp [$::SUB get];
	if {$Subexp == ""} {
	    ShowMessage [_ "There is no substitution pattern to execute."];
	    return ;
	}
    }
    hist::AddToHistoryList $Regexp $Subexp $program;
    hist::AddToHistoryFile $Regexp $Subexp $program;
    if {[winfo exists .hl]} {hist::ConstructHistory}
    WriteJournal [format [_ "Regular expression as entered: %s"] $Regexp];
    if {$UserClassesEnabledP} {
	if {[FeaturesUnSetP $program $Locale] == 0} {
	    if {$Features(alttype,$program,$Locale) > 0} {
		set Regexp [InstantiateUserClasses $Regexp $Features(alttype,$program,$Locale)]
		if {[string length $Regexp] == 0} {
		    ShowMessage [_ "Regular Expression is null after user class instantiation."];
		    DisplayActualRegexp ""; # Clear actual regexp display.
		    return ;
		}
	    }
	}
    }
    WriteJournal [format [_ "Regular expression actually executed: %s"] $Regexp];
    if {$DoSubstitutionsP} {WriteJournal [format [_ "Substitution expression: %s"] $Subexp]}
    DisplayActualRegexp $Regexp;
    set PreviousActualRegexp $Regexp;
    WriteTestData $InData ;
    #Here is where we actually execute the regexp
    if {$DoSubstitutionsP} {
	set status [catch { $ExecCmd($program,sub) $Regexp $Subexp} RegexpResult];
	set Expressions [list $Regexp $Subexp];
    } else {
	set status [catch { $ExecCmd($program,match) $Regexp} RegexpResult];
	set Expressions [list $Regexp];
    }
    switch -exact -- $::ExecutionFlag {
	CommandInfo {
	    WriteExecutionInfo $Expressions $RegexpResult
	    set RegexpResult "";
	    return
	}
	CommandLine {
	    ShowMessage [lindex $RegexpResult 0];
	    set RegexpResult "";
	    return
	}
    }
    if { [expr ($status == 0) || [string equal $::errorCode NONE]]} {
	if {$DoSubstitutionsP} {
	    if {$OutputOnlyChangedLinesP} {
		if {[string equal $program sed]} {
		    set MatchCnt [CountLines $RegexpResult];
		} else {
		    set ResultList [GetChanges $InData $RegexpResult];
		    set MatchCnt [llength $ResultList];
		    set RegexpResult [join $ResultList "\n"];
		}
	    } else {
		set MatchCnt [CountChanges $InData $RegexpResult];
	    }
	} else {
	    set MatchCnt [CountLines $RegexpResult];
	}

	if {$DoSubstitutionsP} {
	    set action [_ "substitution"];
	} else {
	    set action [_ "regular expression"];
	}
	if {$MatchCnt > 1} {
	    set msg  [format [_ "Executed %1\$s using %2\$s - %3\$s matches"] \
			  $action $Program [DelimitNumber $MatchCnt]];

	} elseif {$MatchCnt == 1} {
	    set msg [format [_ "Executed %1\$s using %2\$s - 1 match"] $action $Program];
	} else {
	    set msg [format [_ "Executed %1\$s using %2\$s - 0 matches"] $action $Program];
	}
	ShowMessage $msg;
	resc::CacheResult $RegexpResult $program $Regexp $Subexp;
	if {[winfo exists .cacentry]} {
	    resc::UpdateCacheDisplay;
	}
        $::OUT insert end $RegexpResult;
	if {$PipeP} {
	    puts $RegexpResult;
	    flush stdout;
	}
	ShowDiffResult 1;
    } else {				# Command exited abnormally
	ShowMessage [format [_ "Executed regular expression using %s - 0 matches due to error exit"] $Program];
	puts stderr "Program exited abnormally";
	ExplicateErrorStatus;
    }
    $::OUT configure -state disabled
    if {$::AutoClearRegexpP} {
	ClearRegexp;
    }
}

proc WhichAgrep {} {
    set tf [file join $::TempDir tf]
    catch [list exec agrep 2> $tf]
    if {[catch {open $tf "r"} tfh] != 0} {
	ShowMessage [_ "WhichAgrep: unable to open file in $::TempDir"]
	set ::ProgramInfo(agrep,TreAgrepP) -1 
	return ;
    }
    gets $tfh msg
    close $tfh
    set FirstWord [lindex [split $msg] 0]
    if {[string equal $FirstWord "Usage:"]} {
	set ::ProgramInfo(agrep,TreAgrepP) 1
	ShowMessage [_ "Detected TRE Agrep"]
    } elseif {[string equal $FirstWord "usage:"]} {
	set ::ProgramInfo(agrep,TreAgrepP) 0 
	ShowMessage [_ "Detected Wu-Manber Agrep"]
    } else {
	set ::ProgramInfo(agrep,TreAgrepP) -1 
	ShowMessage [_ "Failed to detect a recognizable version of agrep."]
    }
}

option add  *pcpAgrep.*Background $::ColorSpecs(ProgramSpecificControls,Background) 100;
option add  *pcpAgrep.*Foreground $::ColorSpecs(ProgramSpecificControls,Foreground) 100;
option add  *pcpAgrep.*activeBackground $::ColorSpecs(ProgramSpecificControls,ActiveBackground) 100;
option add  *pcpAgrep.*activeForeground $::ColorSpecs(ProgramSpecificControls,ActiveForeground) 100;
option add  *pcpAgrep.*selectColor $::ColorSpecs(ProgramSpecificControls,Select) 100;
option add  *pcpAgrep.*Entry.Background $::ColorSpecs(ProgramSpecificControls,EntryBackground) 100;
option add  *pcpAgrep.*Entry.disabledBackground $::ColorSpecs(ProgramSpecificControls,DisabledEntryBackground) 100;
set agrepErrLim 0
set agrepDelWei 0
set agrepInsWei 0
set agrepSubWei 0

proc PopupAgrepControls {} { 
    set w .pcpAgrep
    if {[winfo exist .pcpAgrep]} {
	if {![winfo ismapped .pcpAgrep]} {
	    wm deiconify .pcpAgrep;
	    raise .pcpAgrep
	} else {
	    wm iconify .pcpAgrep;
	}
	return ;
    }
    toplevel $w -borderwidth 4 -relief raised
    wm title $w Agrep
    after idle {
	raise .pcpAgrep
	update idletasks
	set xmax [winfo screenwidth .pcpAgrep]
	set ymax [winfo screenheight .pcpAgrep]
	set x0 [expr int( rand() * double($xmax -[winfo reqwidth  .pcpAgrep]))];
	set y0 [expr int( rand() * double($ymax -[winfo reqheight .pcpAgrep]))];
	wm geometry .pcpAgrep "+$x0+$y0";
    }

    if {![info exist ::ProgramInfo(agrep,TreAgrepP)]} {
	WhichAgrep;
    }
    if {$::ProgramInfo(agrep,TreAgrepP)} {
	set which "TRE Agrep"
	set genmsg \
	    [_ "Set command-line options for agrep.\nNote that in TRE Agrep weights and maximum\ntotal cost can be set in-line for each group."]
    } elseif {$::ProgramInfo(agrep,TreAgrepP) == 0} {
	set which "Wu-Manber Agrep"
	set genmsg [_ "Set command-line options for agrep."]
    } else {
	ShowMessage [_ "Agrep is not available or is not in your path."]
	return ;
    }
    set title [format "%s\n%s" [_ "Agrep Settings"] $which]
    label $w.title -text $title  -font PopupTitleFont
    frame $w.main
    checkbutton $w.main.caseInsensitiveckb -text [_ "Case Insensitive?"] \
	-variable agrepCasIns -onvalue 1 -offvalue 0
    checkbutton $w.main.bestResultckb -text [_ "Near Misses?"] \
	-variable agrepBesRes -onvalue 1 -offvalue 0

    frame $w.main.app -relief ridge -border 2
    label $w.main.app.tit -text [_ "Approximate Matching"] -relief raised -border 1
    iwidgets::spinint $w.main.app.tcost \
	-labelpos e \
	-width 3 \
	-range {0 100} \
	-wrap 0 \
	-labeltext "Total Cost" \
	-textbackground $::ColorSpecs(ProgramSpecificControls,Select) \
	-increment {.pcpAgrep.main.app.tcost up} \
	-decrement {.pcpAgrep.main.app.tcost down} \
	-invalid {};# Prevents irritating flashing or ringing of bell
    iwidgets::spinint $w.main.app.icost \
	-labelpos e \
	-width 3 \
	-range {0 100} \
	-wrap 0 \
	-labeltext "Insertion Cost" \
	-textbackground $::ColorSpecs(ProgramSpecificControls,Select) \
	-increment {.pcpAgrep.main.app.icost up} \
	-decrement {.pcpAgrep.main.app.icost down} \
	-invalid {};
    iwidgets::spinint $w.main.app.dcost \
	-labelpos e \
	-width 3 \
	-range {0 100} \
	-wrap 0 \
	-labeltext "Deletion Cost" \
	-textbackground $::ColorSpecs(ProgramSpecificControls,Select) \
	-increment {.pcpAgrep.main.app.dcost up} \
	-decrement {.pcpAgrep.main.app.dcost down} \
	-invalid {};
    iwidgets::spinint $w.main.app.scost \
	-labelpos e \
	-width 3 \
	-range {0 100} \
	-wrap 0 \
	-labeltext "Substitution Cost" \
	-textbackground $::ColorSpecs(ProgramSpecificControls,Select) \
	-increment {.pcpAgrep.main.app.scost up} \
	-decrement {.pcpAgrep.main.app.scost down} \
	-invalid {};
    pack $w.main.app.tit -side top  -expand 0 -fill none -pady 5 -padx 4 -ipadx 4 -ipady 2
    pack $w.main.app.tcost -side top -expand 1 -fill y -anchor w -padx 4  -pady 5
    pack $w.main.app.icost -side top -expand 1 -fill y -anchor w -padx 4  -pady 5
    pack $w.main.app.dcost -side top -expand 1 -fill y -anchor w -padx 4  -pady 5
    pack $w.main.app.scost -side top -expand 1 -fill y -anchor w -padx 4  -pady 5
    $w.main.app.tcost clear
    $w.main.app.tcost insert 0 $::ProgramInfo(agrep,TotalCost); 
    $w.main.app.icost clear
    $w.main.app.icost insert 0 $::ProgramInfo(agrep,InsertionCost); 
    $w.main.app.dcost clear
    $w.main.app.dcost insert 0 $::ProgramInfo(agrep,DeletionCost); 
    $w.main.app.scost clear
    $w.main.app.scost insert 0 $::ProgramInfo(agrep,SubstitutionCost); 
    pack $w.main.app                      -side bottom -expand 1 -fill both \
	-padx 3 -pady 5
    pack $w.main.caseInsensitiveckb -side top    -expand 1 -fill y \
	-padx 3 -pady 3 -anchor w
    pack $w.main.bestResultckb      -side top    -expand 1 -fill y \
	-padx 3 -pady 3 -anchor w

    frame $w.cntls
    button $w.cntls.save -text [_ "Save"] -command SaveAgrepInfo
    set msg [_ "Press this button to dismiss the popup."]
    button $w.cntls.dis -text [_ "Dismiss"] -command [list destroy $w]
    pack $w.cntls.dis -side left -expand 0 -fill none -padx 4
    pack $w.cntls.save -side right -expand 0 -fill none -padx 4
    pack $w.title -side top -expand 1 -fill both -pady 4     -padx 10
    pack $w.main  -side top -expand 1 -fill both -pady 4     -padx 10
    pack $w.cntls -side top -expand 1 -fill both -pady {8 4} -padx 10

    balloonhelp_for $w $genmsg
    balloonhelp_for $w.title $genmsg
    balloonhelp_for $w.main $genmsg
    balloonhelp_for $w.cntls $genmsg
    set msg [_ "Press this button to make the changes you have made take effect."]
    balloonhelp_for $w.cntls.save $msg
    set msg [_ "Press this button to dismiss the popup."]
    balloonhelp_for $w.cntls.dis $msg
    set msg [_ "Match without regard to case?"]
    balloonhelp_for $w.main.caseInsensitiveckb $msg
    set msg [_ "How many error units should each deletion cost?"]
    balloonhelp_for $w.main.app.dcost $msg
    set msg [_ "How many error units should each insertion cost?"]
    balloonhelp_for $w.main.app.icost $msg
    set msg [_ "How many error units should each substitution cost?"]
    balloonhelp_for $w.main.app.scost $msg
    set msg [_ "In the absence of exact matches, produce the best results?"]
    balloonhelp_for $w.main.bestResultckb $msg
    set msg [_ "What is the maximum total error cost permitted?"]
    balloonhelp_for $w.main.app.tcost $msg
}

proc SaveAgrepInfo {} { 
    set ::ProgramInfo(agrep,TotalCost) [.pcpAgrep.main.app.tcost get]
    set ::ProgramInfo(agrep,InsertionCost) [.pcpAgrep.main.app.icost get]
    set ::ProgramInfo(agrep,DeletionCost) [.pcpAgrep.main.app.dcost get]
    set ::ProgramInfo(agrep,SubstitutionCost) [.pcpAgrep.main.app.scost get]
    if {$::agrepCasIns} {
	set ::ProgramInfo(agrep,CaseInsensitiveP) 1
    } else {
	set ::ProgramInfo(agrep,CaseInsensitiveP) 0
    }
    if {$::agrepBesRes} {
	set ::ProgramInfo(agrep,BestResults) 1
    } else {
	set ::ProgramInfo(agrep,BestResults) 0
    }
}

option add  *pcpCgrep.*Background $::ColorSpecs(ProgramSpecificControls,Background) 100;
option add  *pcpCgrep.*Foreground $::ColorSpecs(ProgramSpecificControls,Foreground) 100;
option add  *pcpCgrep.*activeBackground $::ColorSpecs(ProgramSpecificControls,ActiveBackground) 100;
option add  *pcpCgrep.*activeForeground $::ColorSpecs(ProgramSpecificControls,ActiveForeground) 100;
option add  *pcpCgrep.*selectColor $::ColorSpecs(ProgramSpecificControls,Select) 100;
option add  *pcpCgrep.*Entry.Background $::ColorSpecs(ProgramSpecificControls,EntryBackground) 100;
option add  *pcpCgrep.*Entry.disabledBackground $::ColorSpecs(ProgramSpecificControls,DisabledEntryBackground) 100;

proc PopupCgrepControls {} { 
    set w .pcpCgrep
    if {[winfo exist .pcpCgrep]} {
	if {![winfo ismapped .pcpCgrep]} {
	    wm deiconify .pcpCgrep;
	    raise .pcpCgrep
	} else {
	    wm iconify .pcpCgrep;
	}
	return ;
    }
    toplevel $w -borderwidth 4 -relief raised
    wm title $w Cgrep
    after idle {
	raise .pcpCgrep
	update idletasks
	set xmax [winfo screenwidth .pcpCgrep]
	set ymax [winfo screenheight .pcpCgrep]
	set x0 [expr int( rand() * double($xmax -[winfo reqwidth  .pcpCgrep]))];
	set y0 [expr int( rand() * double($ymax -[winfo reqheight .pcpCgrep]))];
	wm geometry .pcpCgrep "+$x0+$y0";
    }
    set genmsg [_ "Set command-line options for cgrep."]
    set title [_ "Cgrep Settings"]
    label $w.title -text $title  -font PopupTitleFont 
    frame $w.main
    checkbutton $w.main.cgrepCaseInsensitiveckb -text [_ "Case Insensitive"] \
	-variable cgrepCaseInsensitive -onvalue 1 -offvalue 0
    set ::cgrepCaseInsensitive $::ProgramInfo(cgrep,CaseInsensitiveP)
    checkbutton $w.main.cgrepComplementckb -text [_ "Complement"] \
	-variable cgrepComplement -onvalue 1 -offvalue 0
    set ::cgrepComplement $::ProgramInfo(cgrep,Complement)

    frame $w.main.app -relief ridge -border 2
    label $w.main.app.tit -text [_ "Approximate Matching"] -relief raised -border 1
    iwidgets::spinint $w.main.app.tcost \
	-labelpos e \
	-width 3 \
	-range {0 100} \
	-wrap 0 \
	-labeltext "Total Cost" \
	-textbackground $::ColorSpecs(ProgramSpecificControls,Select) \
	-increment {.pcpCgrep.main.app.tcost up} \
	-decrement {.pcpCgrep.main.app.tcost down} \
	-invalid {};# Prevents irritating flashing or ringing of bell
    iwidgets::spinint $w.main.app.icost \
	-labelpos e \
	-width 3 \
	-range {0 100} \
	-wrap 0 \
	-labeltext "Insertion Cost" \
	-textbackground $::ColorSpecs(ProgramSpecificControls,Select) \
	-increment {.pcpCgrep.main.app.icost up} \
	-decrement {.pcpCgrep.main.app.icost down} \
	-invalid {};
    iwidgets::spinint $w.main.app.dcost \
	-labelpos e \
	-width 3 \
	-range {0 100} \
	-wrap 0 \
	-labeltext "Deletion Cost" \
	-textbackground $::ColorSpecs(ProgramSpecificControls,Select) \
	-increment {.pcpCgrep.main.app.dcost up} \
	-decrement {.pcpCgrep.main.app.dcost down} \
	-invalid {};
    iwidgets::spinint $w.main.app.scost \
	-labelpos e \
	-width 3 \
	-range {0 100} \
	-wrap 0 \
	-labeltext "Substitution Cost" \
	-textbackground $::ColorSpecs(ProgramSpecificControls,Select) \
	-increment {.pcpCgrep.main.app.scost up} \
	-decrement {.pcpCgrep.main.app.scost down} \
	-invalid {};
    pack $w.main.app.tit -side top  -expand 0 -fill none -pady 5 -padx 4 -ipadx 4 -ipady 2
    pack $w.main.app.tcost -side top -expand 1 -fill y -anchor w -padx 4  -pady 5
    pack $w.main.app.icost -side top -expand 1 -fill y -anchor w -padx 4  -pady 5
    pack $w.main.app.dcost -side top -expand 1 -fill y -anchor w -padx 4  -pady 5
    pack $w.main.app.scost -side top -expand 1 -fill y -anchor w -padx 4  -pady 5
    $w.main.app.tcost clear
    $w.main.app.tcost insert 0 $::ProgramInfo(cgrep,TotalCost); 
    $w.main.app.icost clear
    $w.main.app.icost insert 0 $::ProgramInfo(cgrep,InsertionCost); 
    $w.main.app.dcost clear
    $w.main.app.dcost insert 0 $::ProgramInfo(cgrep,DeletionCost); 
    $w.main.app.scost clear
    $w.main.app.scost insert 0 $::ProgramInfo(cgrep,SubstitutionCost); 
    pack $w.main.app                      -side bottom -expand 1 -fill both \
	-padx 3 -pady 5
    pack $w.main.cgrepCaseInsensitiveckb -side top    -expand 1 -fill y \
	-padx 3 -pady 3 -anchor w
    pack $w.main.cgrepComplementckb      -side top    -expand 1 -fill y \
	-padx 3 -pady 3 -anchor w

    frame $w.cntls
    button $w.cntls.save -text [_ "Save"] -command SaveCgrepInfo
    set msg [_ "Press this button to dismiss the popup."]
    button $w.cntls.dis -text [_ "Dismiss"] -command [list destroy $w]
    pack $w.cntls.dis -side left -expand 0 -fill none -padx 4
    pack $w.cntls.save -side right -expand 0 -fill none -padx 4
    pack $w.title -side top -expand 1 -fill both -pady 4     -padx 10
    pack $w.main  -side top -expand 1 -fill both -pady 4     -padx 10
    pack $w.cntls -side top -expand 1 -fill both -pady {8 4} -padx 10
    balloonhelp_for $w $genmsg
    balloonhelp_for $w.title $genmsg
    balloonhelp_for $w.main $genmsg
    balloonhelp_for $w.main.app $genmsg
    balloonhelp_for $w.main.app.tcost $genmsg
    balloonhelp_for $w.main.app.icost $genmsg
    balloonhelp_for $w.main.app.dcost $genmsg
    balloonhelp_for $w.main.app.scost $genmsg
    balloonhelp_for $w.cntls $genmsg
    set msg [_ "Press this button to make the changes you have made take effect."]
    balloonhelp_for $w.cntls.save $msg
    set msg [_ "Match without regard to case?"]
    balloonhelp_for $w.main.cgrepCaseInsensitiveckb $msg;
    set msg [_ "Press this button to dismiss the popup."]
    balloonhelp_for $w.cntls.dis $msg
    set msg [_ "Emit only strings not matching the regular expression?"]
    balloonhelp_for $w.main.cgrepComplementckb $msg;
}

proc SaveCgrepInfo {} { 
    set ::ProgramInfo(cgrep,TotalCost) [.pcpCgrep.main.app.tcost get]
    set ::ProgramInfo(cgrep,InsertionCost) [.pcpCgrep.main.app.icost get]
    set ::ProgramInfo(cgrep,DeletionCost) [.pcpCgrep.main.app.dcost get]
    set ::ProgramInfo(cgrep,SubstitutionCost) [.pcpCgrep.main.app.scost get]
    if {$::cgrepCaseInsensitive} {
	set ::ProgramInfo(cgrep,CaseInsensitiveP) 1
    } else {
	set ::ProgramInfo(cgrep,CaseInsensitiveP) 0
    }
    if {$::cgrepComplement} {
	set ::ProgramInfo(cgrep,Complement) 1
    } else {
	set ::ProgramInfo(cgrep,Complement) 0
    }
}

option add  *pcpGlark.*Background $::ColorSpecs(ProgramSpecificControls,Background) 100;
option add  *pcpGlark.*Foreground $::ColorSpecs(ProgramSpecificControls,Foreground) 100;
option add  *pcpGlark.*activeBackground $::ColorSpecs(ProgramSpecificControls,ActiveBackground) 100;
option add  *pcpGlark.*activeForeground $::ColorSpecs(ProgramSpecificControls,ActiveForeground) 100;
option add  *pcpGlark.*selectColor $::ColorSpecs(ProgramSpecificControls,Select) 100;
option add  *pcpGlark.*Entry.Background $::ColorSpecs(ProgramSpecificControls,EntryBackground) 100;
option add  *pcpGlark.*Entry.disabledBackground $::ColorSpecs(ProgramSpecificControls,DisabledEntryBackground) 100;

proc PopupGlarkControls {} { 
    set w .pcpGlark
    if {[winfo exist .pcpGlark]} {
	if {![winfo ismapped .pcpGlark]} {
	    wm deiconify .pcpGlark;
	    raise .pcpGlark
	} else {
	    wm iconify .pcpGlark;
	}
	return ;
    }
    toplevel $w -borderwidth 4 -relief raised
    wm title $w Glark
    after idle {
	raise .pcpGlark
	update idletasks
	set xmax [winfo screenwidth .pcpGlark]
	set ymax [winfo screenheight .pcpGlark]
	set x0 [expr int( rand() * double($xmax -[winfo reqwidth  .pcpGlark]))];
	set y0 [expr int( rand() * double($ymax -[winfo reqheight .pcpGlark]))];
	wm geometry .pcpGlark "+$x0+$y0";
    }
    set genmsg [_ "Set command-line options for Glark."]
    set title [_ "Glark Settings"]
    label $w.title -text $title -font PopupTitleFont
    frame $w.main
    checkbutton $w.main.glarkCaseInsensitiveckb -text [_ "Case Insensitive"] \
	-variable glarkCaseInsensitive -onvalue 1 -offvalue 0
    set ::glarkCaseInsensitive $::ProgramInfo(glark,CaseInsensitiveP)

    checkbutton $w.main.glarkMatchOnlyckb -text [_ "Emit Only Matching Portion"] \
	-variable glarkMatchOnly -onvalue 1 -offvalue 0
    set ::glarkMatchOnly $::ProgramInfo(glark,EmitMatchOnly)

    checkbutton $w.main.glarkComplementckb -text [_ "Complement"] \
	-variable glarkComplement -onvalue 1 -offvalue 0
    set ::glarkComplement $::ProgramInfo(glark,Complement)

    checkbutton $w.main.glarkMatchEntireLineckb -text [_ "Match Entire Line"] \
	-variable glarkMatchEntireLine -onvalue 1 -offvalue 0
    set ::glarkMatchEntireLine $::ProgramInfo(glark,MatchEntireLine)

    grid $w.main.glarkCaseInsensitiveckb -row 1 -column 0 -sticky w -columnspan 3 -pady 3
    grid $w.main.glarkComplementckb -row 2 -column 0 -sticky w -columnspan 3 -pady 3
    grid $w.main.glarkMatchOnlyckb -row 3 -column 0 -sticky w -columnspan 3 -pady 3
    grid $w.main.glarkMatchEntireLineckb -row 4 -column 0 -sticky w -columnspan 3 -pady 3

    frame $w.cntls
    button $w.cntls.save -text [_ "Save"] -command SaveGlarkInfo
    button $w.cntls.dis -text [_ "Dismiss"] -command [list destroy $w]
    pack $w.cntls.dis -side left -expand 0 -fill none -padx 4
    pack $w.cntls.save -side right -expand 0 -fill none -padx 4
    pack $w.title -side top -expand 1 -fill both -padx 8 -pady 4
    pack $w.main  -side top -expand 1 -fill both -padx 8 -pady 4
    pack $w.cntls -side top -expand 1 -fill both -padx 8 -pady {8 4}
    balloonhelp_for $w $genmsg
    balloonhelp_for $w.title $genmsg
    balloonhelp_for $w.main $genmsg
    balloonhelp_for $w.cntls $genmsg
    set msg [_ "Press this button to make the changes you have made take effect."]
    balloonhelp_for $w.cntls.save $msg
    set msg [_ "Press this button to dismiss the popup."]
    balloonhelp_for $w.cntls.dis $msg
    set msg [_ "Emit only the portion of the string that\nactually matched, not the whole line."]
    balloonhelp_for $w.main.glarkMatchOnlyckb $msg;
    set msg [_ "Match without regard to case?"]
    balloonhelp_for $w.main.glarkCaseInsensitiveckb $msg;
    set msg [_ "Emit only strings not matching the regular expression?"]
    balloonhelp_for $w.main.glarkComplementckb $msg;
    set msg [_ "Emit only strings that match the entire line?"]
    balloonhelp_for $w.main.glarkMatchEntireLineckb $msg;
}

proc SaveGlarkInfo {} { 
    if {$::glarkCaseInsensitive} {
	set ::ProgramInfo(glark,CaseInsensitiveP) 1
    } else {
	set ::ProgramInfo(glark,CaseInsensitiveP) 0
    }
    if {$::glarkComplement} {
	set ::ProgramInfo(glark,Complement) 1
    } else {
	set ::ProgramInfo(glark,Complement) 0
    }
    if {$::glarkMatchOnly} {
	set ::ProgramInfo(glark,EmitMatchOnly) 1
    } else {
	set ::ProgramInfo(glark,EmitMatchOnly) 0
    }
    if {$::glarkMatchEntireLine} {
	set ::ProgramInfo(glark,MatchEntireLine 1
    } else {
	set ::ProgramInfo(glark,MatchEntireLine) 0
    }
    TestFeatures;
}

option add  *pcpGrep.*Background $::ColorSpecs(ProgramSpecificControls,Background) 100;
option add  *pcpGrep.*Foreground $::ColorSpecs(ProgramSpecificControls,Foreground) 100;
option add  *pcpGrep.*activeBackground $::ColorSpecs(ProgramSpecificControls,ActiveBackground) 100;
option add  *pcpGrep.*activeForeground $::ColorSpecs(ProgramSpecificControls,ActiveForeground) 100;
option add  *pcpGrep.*selectColor $::ColorSpecs(ProgramSpecificControls,Select) 100;
option add  *pcpGrep.*Entry.Background $::ColorSpecs(ProgramSpecificControls,EntryBackground) 100;
option add  *pcpGrep.*Entry.disabledBackground $::ColorSpecs(ProgramSpecificControls,DisabledEntryBackground) 100;

proc PopupGrepControls {} { 
    set w .pcpGrep
    if {[winfo exist .pcpGrep]} {
	if {![winfo ismapped .pcpGrep]} {
	    wm deiconify .pcpGrep;
	    raise .pcpGrep
	} else {
	    wm iconify .pcpGrep;
	}
	return ;
    }
    toplevel $w -borderwidth 4 -relief raised
    wm title $w Grep
    after idle {
	raise .pcpGrep
	update idletasks
	set xmax [winfo screenwidth .pcpGrep]
	set ymax [winfo screenheight .pcpGrep]
	set x0 [expr int( rand() * double($xmax -[winfo reqwidth  .pcpGrep]))];
	set y0 [expr int( rand() * double($ymax -[winfo reqheight .pcpGrep]))];
	wm geometry .pcpGrep "+$x0+$y0";
    }
    set genmsg [_ "Set command-line options for grep."]
    set title [_ "Grep Settings"]
    label $w.title -text $title  -font PopupTitleFont 
    frame $w.main
    radiobutton $w.main.grepBasic -text [_ "Basic"] \
	-variable grepNotation -value Basic
    radiobutton $w.main.grepExtended -text [_ "Extended"] \
	-variable grepNotation -value Extended
    radiobutton $w.main.grepPerl -text [_ "Perl"] \
	-variable grepNotation -value Perl
    $w.main.grepExtended select;

    checkbutton $w.main.grepCaseInsensitiveckb -text [_ "Case Insensitive"] \
	-variable grepCaseInsensitive -onvalue 1 -offvalue 0
    set ::grepCaseInsensitive $::ProgramInfo(grep,CaseInsensitiveP)

    checkbutton $w.main.grepMatchOnlyckb -text [_ "Emit Only Matching Portion"] \
	-variable grepMatchOnly -onvalue 1 -offvalue 0
    set ::grepMatchOnly $::ProgramInfo(grep,EmitMatchOnly)

    checkbutton $w.main.grepComplementckb -text [_ "Complement"] \
	-variable grepComplement -onvalue 1 -offvalue 0
    set ::grepComplement $::ProgramInfo(grep,Complement)

    grid $w.main.grepBasic 	   -row 0 -column 0 -sticky w -pady 3 -padx 2
    grid $w.main.grepExtended	   -row 0 -column 1 -sticky w -pady 3 -padx 2
    grid $w.main.grepPerl	   -row 0 -column 2 -sticky w -pady 3 -padx 2
    grid $w.main.grepCaseInsensitiveckb -row 1 -column 0 -sticky w -columnspan 3 -pady 3
    grid $w.main.grepComplementckb -row 2 -column 0 -sticky w -columnspan 3 -pady 3
    grid $w.main.grepMatchOnlyckb -row 3 -column 0 -sticky w -columnspan 3 -pady 3

    frame $w.cntls
    button $w.cntls.save -text [_ "Save"] -command SaveGrepInfo
    button $w.cntls.dis -text [_ "Dismiss"] -command [list destroy $w]
    pack $w.cntls.dis -side left -expand 0 -fill none
    pack $w.cntls.save -side right -expand 0 -fill none
    pack $w.title -side top -expand 1 -fill both -padx 8 -pady 4
    pack $w.main  -side top -expand 1 -fill both -padx 8 -pady 4
    pack $w.cntls -side top -expand 1 -fill both -padx 8 -pady {8 4}
    balloonhelp_for $w $genmsg
    balloonhelp_for $w.title $genmsg
    balloonhelp_for $w.main $genmsg
    balloonhelp_for $w.cntls $genmsg
    set msg [_ "Press this button to make the changes you have made take effect."]
    balloonhelp_for $w.cntls.save $msg
    set msg [_ "Press this button to dismiss the popup."]
    balloonhelp_for $w.cntls.dis $msg
    set msg [_ "Use basic regular expression notation."]
    balloonhelp_for $w.main.grepBasic $msg;
    set msg [_ "Use extended regular expression notation."]
    balloonhelp_for $w.main.grepExtended $msg;
    set msg [_ "Use PERL 5 regular expression notation."]
    balloonhelp_for $w.main.grepPerl $msg;
    set msg [_ "Emit only the portion of the string that\nactually matched, not the whole line."]
    balloonhelp_for $w.main.grepMatchOnlyckb $msg;
    set msg [_ "Match without regard to case?"]
    balloonhelp_for $w.main.grepCaseInsensitiveckb $msg;
    set msg [_ "Emit only strings not matching the regular expression?"]
    balloonhelp_for $w.main.grepComplementckb $msg;
}

proc SaveGrepInfo {} { 
    if {$::grepCaseInsensitive} {
	set ::ProgramInfo(grep,CaseInsensitiveP) 1
    } else {
	set ::ProgramInfo(grep,CaseInsensitiveP) 0
    }
    if {$::grepComplement} {
	set ::ProgramInfo(grep,Complement) 1
    } else {
	set ::ProgramInfo(grep,Complement) 0
    }
    if {$::grepMatchOnly} {
	set ::ProgramInfo(grep,EmitMatchOnly) 1
    } else {
	set ::ProgramInfo(grep,EmitMatchOnly) 0
    }
    set ::ProgramInfo(grep,Notation) $::grepNotation;
    TestFeatures;
}

option add  *pcpGawk.*Background $::ColorSpecs(ProgramSpecificControls,Background) 100;
option add  *pcpGawk.*Foreground $::ColorSpecs(ProgramSpecificControls,Foreground) 100;
option add  *pcpGawk.*activeBackground $::ColorSpecs(ProgramSpecificControls,ActiveBackground) 100;
option add  *pcpGawk.*activeForeground $::ColorSpecs(ProgramSpecificControls,ActiveForeground) 100;
option add  *pcpGawk.*selectColor $::ColorSpecs(ProgramSpecificControls,Select) 100;
option add  *pcpGawk.*Entry.Background $::ColorSpecs(ProgramSpecificControls,EntryBackground) 100;
option add  *pcpGawk.*Entry.disabledBackground $::ColorSpecs(ProgramSpecificControls,DisabledEntryBackground) 100;

proc PopupGawkControls {} { 
    set w .pcpGawk
    if {[winfo exist .pcpGawk]} {
	if {![winfo ismapped .pcpGawk]} {
	    wm deiconify .pcpGawk;
	    raise .pcpGawk
	} else {
	    wm iconify .pcpGawk;
	}
	return ;
    }
    toplevel $w -borderwidth 4 -relief raised
    wm title $w Gawk
    after idle {
	raise .pcpGawk
	update idletasks
	set xmax [winfo screenwidth .pcpGawk]
	set ymax [winfo screenheight .pcpGawk]
	set x0 [expr int( rand() * double($xmax -[winfo reqwidth  .pcpGawk]))];
	set y0 [expr int( rand() * double($ymax -[winfo reqheight .pcpGawk]))];
	wm geometry .pcpGawk "+$x0+$y0";
    }
    set genmsg [_ "Set command-line options for gawk."]
    set title [_ "Gawk Settings"]
    label $w.title -text $title  -font PopupTitleFont 
    frame $w.main
    radiobutton $w.main.gawkGNU -text [_ "GNU"] \
	-variable gawkNotation -value GNU
    radiobutton $w.main.gawkPosix -text [_ "Posix"] \
	-variable gawkNotation -value Posix
    radiobutton $w.main.gawkTraditional -text [_ "Traditional"] \
	-variable gawkNotation -value Traditional
    $w.main.gawkGNU select;

    checkbutton $w.main.gawkCaseInsensitiveckb -text [_ "Case Insensitive"] \
	-variable gawkCaseInsensitive -onvalue 1 -offvalue 0
    checkbutton $w.main.gawkIntervalExpressionsckb -text [_ "Accept Interval Expressions"] \
	-variable gawkIntervalExpressions -onvalue 1 -offvalue 0
    set ::gawkCaseInsensitive $::ProgramInfo(gawk,CaseInsensitiveP)
    set ::gawkIntervalExpressions $::ProgramInfo(gawk,IntervalExpressions)
    grid $w.main.gawkGNU 	   		-row 0 -column 0 -sticky w -pady 3 -padx 2
    grid $w.main.gawkPosix	   		-row 0 -column 1 -sticky w -pady 3 -padx 2
    grid $w.main.gawkTraditional   		-row 0 -column 2 -sticky w -pady 3 -padx 2
    grid $w.main.gawkCaseInsensitiveckb		-row 1 -column 0 -sticky w -columnspan 3 -pady 3
    grid $w.main.gawkIntervalExpressionsckb	-row 2 -column 0 -sticky w -columnspan 3 -pady 3

    frame $w.cntls
    button $w.cntls.save -text [_ "Save"] -command SaveGawkInfo
    button $w.cntls.dis -text [_ "Dismiss"] -command [list destroy $w]
    pack $w.cntls.dis -side left -expand 0 -fill none
    pack $w.cntls.save -side right -expand 0 -fill none
    pack $w.title -side top -expand 1 -fill both -pady 4     -padx 8
    pack $w.main  -side top -expand 1 -fill both -pady 4     -padx 8
    pack $w.cntls -side top -expand 1 -fill both -pady {8 4} -padx 8
    balloonhelp_for $w $genmsg
    balloonhelp_for $w.title $genmsg
    balloonhelp_for $w.main $genmsg
    balloonhelp_for $w.cntls $genmsg
    set msg [_ "Press this button to make the changes you have made take effect."]
    balloonhelp_for $w.cntls.save $msg
    set msg [_ "Press this button to dismiss the popup."]
    balloonhelp_for $w.cntls.dis $msg
    set msg [_ "Use GNU extended regular expression notation."]
    balloonhelp_for $w.main.gawkGNU $msg;
    set msg [_ "Use POSIX regular expression notation."]
    balloonhelp_for $w.main.gawkPosix $msg;
    set msg [_ "Use traditional awk regular expression notation."]
    balloonhelp_for $w.main.gawkTraditional $msg;
    set msg [_ "Accept interval expressions."]
    balloonhelp_for $w.main.gawkIntervalExpressionsckb $msg;
    set msg [_ "Match without regard to case?"]
    balloonhelp_for $w.main.gawkCaseInsensitiveckb $msg;
}

proc SaveGawkInfo {} { 
    if {$::gawkCaseInsensitive} {
	set ::ProgramInfo(gawk,CaseInsensitiveP) 1
    } else {
	set ::ProgramInfo(gawk,CaseInsensitiveP) 0
    }
    if {$::gawkIntervalExpressions} {
	set ::ProgramInfo(gawk,IntervalExpressions) 1
    } else {
	set ::ProgramInfo(gawk,IntervalExpressions) 0
    }
    set ::ProgramInfo(gawk,Notation) $::gawkNotation;
    TestFeatures;
}

option add  *pcpEgrep.*Background $::ColorSpecs(ProgramSpecificControls,Background) 100;
option add  *pcpEgrep.*Foreground $::ColorSpecs(ProgramSpecificControls,Foreground) 100;
option add  *pcpEgrep.*activeBackground $::ColorSpecs(ProgramSpecificControls,ActiveBackground) 100;
option add  *pcpEgrep.*activeForeground $::ColorSpecs(ProgramSpecificControls,ActiveForeground) 100;
option add  *pcpEgrep.*selectColor $::ColorSpecs(ProgramSpecificControls,Select) 100;
option add  *pcpEgrep.*Entry.Background $::ColorSpecs(ProgramSpecificControls,EntryBackground) 100;
option add  *pcpEgrep.*Entry.disabledBackground $::ColorSpecs(ProgramSpecificControls,DisabledEntryBackground) 100;

proc PopupEgrepControls {} { 
    set w .pcpEgrep
    if {[winfo exist .pcpEgrep]} {
	if {![winfo ismapped .pcpEgrep]} {
	    wm deiconify .pcpEgrep;
	    raise .pcpEgrep
	} else {
	    wm iconify .pcpEgrep;
	}
	return ;
    }
    toplevel $w -borderwidth 4 -relief raised
    wm title $w Egrep
    after idle {
	raise .pcpEgrep
	update idletasks
	set xmax [winfo screenwidth .pcpEgrep]
	set ymax [winfo screenheight .pcpEgrep]
	set x0 [expr int( rand() * double($xmax -[winfo reqwidth  .pcpEgrep]))];
	set y0 [expr int( rand() * double($ymax -[winfo reqheight .pcpEgrep]))];
	wm geometry .pcpEgrep "+$x0+$y0";
    }
    set genmsg [_ "Set command-line options for egrep."]
    set title [_ "Egrep Settings"]
    label $w.title -text $title  -font PopupTitleFont 
    frame $w.main
    checkbutton $w.main.egrepCaseInsensitiveckb -text [_ "Case Insensitive"] \
	-variable egrepCaseInsensitive -onvalue 1 -offvalue 0
    set ::egrepCaseInsensitive $::ProgramInfo(egrep,CaseInsensitiveP)
    checkbutton $w.main.egrepMatchOnlyckb -text [_ "Emit Only Match"] \
	-variable egrepMatchOnly -onvalue 1 -offvalue 0
    set ::egrepMatchOnly $::ProgramInfo(egrep,EmitMatchOnly)
    checkbutton $w.main.egrepComplementckb -text [_ "Complement"] \
	-variable egrepComplement -onvalue 1 -offvalue 0
    set ::egrepComplement $::ProgramInfo(egrep,Complement)

    grid $w.main.egrepCaseInsensitiveckb -row 0 -column 0 -sticky w -pady 2
    grid $w.main.egrepComplementckb -row 1 -column 0 -sticky w -pady 2
    grid $w.main.egrepMatchOnlyckb -row 2 -column 0 -sticky w -pady 2

    frame $w.cntls
    button $w.cntls.save -text [_ "Save"] -command SaveEgrepInfo
    set msg [_ "Press this button to dismiss the popup."]
    button $w.cntls.dis -text [_ "Dismiss"] -command [list destroy $w]
    pack $w.cntls.dis -side left -expand 0 -fill none -padx 4
    pack $w.cntls.save -side right -expand 0 -fill none -padx 4
    pack $w.title -side top -expand 1 -fill both -pady 4     -padx 10
    pack $w.main  -side top -expand 1 -fill both -pady 4     -padx 10
    pack $w.cntls -side top -expand 1 -fill both -pady {8 4} -padx 10
    balloonhelp_for $w $genmsg
    balloonhelp_for $w.title $genmsg
    balloonhelp_for $w.main $genmsg
    balloonhelp_for $w.cntls $genmsg
    set msg [_ "Press this button to make the changes you have made take effect."]
    balloonhelp_for $w.cntls.save $msg
    set msg [_ "Match without regard to case?"]
    balloonhelp_for $w.main.egrepCaseInsensitiveckb $msg;
    set msg [_ "Press this button to dismiss the popup."]
    balloonhelp_for $w.cntls.dis $msg
    set msg [_ "Emit only the portion of the string that\nactually matched, not the whole line."]
    balloonhelp_for $w.main.egrepMatchOnlyckb $msg;
    set msg [_ "Emit only strings not matching the regular expression?"]
    balloonhelp_for $w.main.egrepComplementckb $msg;
}

proc SaveEgrepInfo {} { 
    if {$::egrepCaseInsensitive} {
	set ::ProgramInfo(egrep,CaseInsensitiveP) 1
    } else {
	set ::ProgramInfo(egrep,CaseInsensitiveP) 0
    }
    if {$::egrepComplement} {
	set ::ProgramInfo(egrep,Complement) 1
    } else {
	set ::ProgramInfo(egrep,Complement) 0
    }
    if {$::egrepMatchOnly} {
	set ::ProgramInfo(egrep,EmitMatchOnly) 1
    } else {
	set ::ProgramInfo(egrep,EmitMatchOnly) 0
    }
}

option add  *pcpEmacs.*Background $::ColorSpecs(ProgramSpecificControls,Background) 100;
option add  *pcpEmacs.*Foreground $::ColorSpecs(ProgramSpecificControls,Foreground) 100;
option add  *pcpEmacs.*activeBackground $::ColorSpecs(ProgramSpecificControls,ActiveBackground) 100;
option add  *pcpEmacs.*activeForeground $::ColorSpecs(ProgramSpecificControls,ActiveForeground) 100;
option add  *pcpEmacs.*selectColor $::ColorSpecs(ProgramSpecificControls,Select) 100;
option add  *pcpEmacs.*Entry.Background $::ColorSpecs(ProgramSpecificControls,EntryBackground) 100;
option add  *pcpEmacs.*Entry.disabledBackground $::ColorSpecs(ProgramSpecificControls,DisabledEntryBackground) 100;

proc PopupEmacsControls {} { 
    set w .pcpEmacs
    if {[winfo exist .pcpEmacs]} {
	if {![winfo ismapped .pcpEmacs]} {
	    wm deiconify .pcpEmacs;
	    raise .pcpEmacs
	} else {
	    wm iconify .pcpEmacs;
	}
	return ;
    }
    toplevel $w -borderwidth 4 -relief raised
    wm title $w Emacs
    after idle {
	raise .pcpEmacs
	update idletasks
	set xmax [winfo screenwidth .pcpEmacs]
	set ymax [winfo screenheight .pcpEmacs]
	set x0 [expr int( rand() * double($xmax -[winfo reqwidth  .pcpEmacs]))];
	set y0 [expr int( rand() * double($ymax -[winfo reqheight .pcpEmacs]))];
	wm geometry .pcpEmacs "+$x0+$y0";
    }
    set genmsg [_ "Set command-line options for emacs."]
    set title [_ "Emacs Settings"]
    label $w.title -text $title  -font PopupTitleFont 
    frame $w.main
    checkbutton $w.main.emacsFoldCaseMatchPckb -text [_ "Fold Case Match"] \
	-variable emacsFoldCaseMatchP -onvalue 1 -offvalue 0
    set ::emacsFoldCaseMatchP $::ProgramInfo(emacs,FoldCaseMatchP)
    checkbutton $w.main.emacsFoldCaseReplacePckb -text [_ "Fold Case Replace"] \
	-variable emacsFoldCaseReplaceP -onvalue 1 -offvalue 0
    set ::emacsFoldCaseReplaceP $::ProgramInfo(emacs,FoldCaseReplaceP)

    grid $w.main.emacsFoldCaseMatchPckb -row 0 -column 0 -sticky w -pady 2
    grid $w.main.emacsFoldCaseReplacePckb -row 1 -column 0 -sticky w -pady 2

    frame $w.cntls
    button $w.cntls.save -text [_ "Save"] -command SaveEmacsInfo
    button $w.cntls.dis -text [_ "Dismiss"] -command [list destroy $w]
    pack $w.cntls.dis -side left -expand 0 -fill none
    pack $w.cntls.save -side right -expand 0 -fill none
    pack $w.title  -side top -expand 1 -fill both -pady 4 -padx 8
    pack $w.main  -side top -expand 1 -fill both -pady 4 -padx 8
    pack $w.cntls -side top -expand 1 -fill both -pady {8 4} -padx 8
    balloonhelp_for $w $genmsg
    balloonhelp_for $w.title $genmsg
    balloonhelp_for $w.main $genmsg
    balloonhelp_for $w.cntls $genmsg
    set msg [_ "Press this button to make the changes you have made take effect."]
    balloonhelp_for $w.cntls.save $msg
    set msg [_ "Press this button to dismiss the popup."]
    balloonhelp_for $w.cntls.dis $msg
    set msg [_ "Case insensitive match?"]
    balloonhelp_for $w.main.emacsFoldCaseMatchPckb $msg;
    set msg [_ "Case insensitive substitution?"]
    balloonhelp_for $w.main.emacsFoldCaseReplacePckb $msg;
}

proc SaveEmacsInfo {} { 
    if {$::emacsFoldCaseMatchP} {
	set ::ProgramInfo(emacs,FoldCaseMatchP) 1
    } else {
	set ::ProgramInfo(emacs,FoldCaseMatchP) 0
    }
    if {$::emacsFoldCaseReplaceP} {
	set ::ProgramInfo(emacs,FoldCaseReplaceP) 1
    } else {
	set ::ProgramInfo(emacs,FoldCaseReplaceP) 0
    }
}

option add  *pcpFgrep.*Background $::ColorSpecs(ProgramSpecificControls,Background) 100;
option add  *pcpFgrep.*Foreground $::ColorSpecs(ProgramSpecificControls,Foreground) 100;
option add  *pcpFgrep.*activeBackground $::ColorSpecs(ProgramSpecificControls,ActiveBackground) 100;
option add  *pcpFgrep.*activeForeground $::ColorSpecs(ProgramSpecificControls,ActiveForeground) 100;
option add  *pcpFgrep.*selectColor $::ColorSpecs(ProgramSpecificControls,Select) 100;
option add  *pcpFgrep.*Entry.Background $::ColorSpecs(ProgramSpecificControls,EntryBackground) 100;
option add  *pcpFgrep.*Entry.disabledBackground $::ColorSpecs(ProgramSpecificControls,DisabledEntryBackground) 100;

proc PopupFgrepControls {} { 
    set w .pcpFgrep
    if {[winfo exist .pcpFgrep]} {
	if {![winfo ismapped .pcpFgrep]} {
	    wm deiconify .pcpFgrep;
	    raise .pcpFgrep
	} else {
	    wm iconify .pcpFgrep;
	}
	return ;
    }
    toplevel $w -borderwidth 4 -relief raised
    wm title $w Fgrep
    after idle {
	raise .pcpFgrep
	update idletasks
	set xmax [winfo screenwidth .pcpFgrep]
	set ymax [winfo screenheight .pcpFgrep]
	set x0 [expr int( rand() * double($xmax -[winfo reqwidth  .pcpFgrep]))];
	set y0 [expr int( rand() * double($ymax -[winfo reqheight .pcpFgrep]))];
	wm geometry .pcpFgrep "+$x0+$y0";
    }
    set genmsg [_ "Set command-line options for fgrep."]
    set title [_ "Fgrep Settings"]
    label $w.title -text $title  -font PopupTitleFont 
    frame $w.main
    checkbutton $w.main.fgrepCaseInsensitiveckb -text [_ "Case Insensitive"] \
	-variable fgrepCaseInsensitive -onvalue 1 -offvalue 0
    set ::fgrepCaseInsensitive $::ProgramInfo(fgrep,CaseInsensitiveP)
    checkbutton $w.main.fgrepMatchOnlyckb -text [_ "Emit Only Match"] \
	-variable fgrepMatchOnly -onvalue 1 -offvalue 0
    set ::fgrepMatchOnly $::ProgramInfo(fgrep,EmitMatchOnly)
    checkbutton $w.main.fgrepComplementckb -text [_ "Complement"] \
	-variable fgrepComplement -onvalue 1 -offvalue 0
    set ::fgrepComplement $::ProgramInfo(fgrep,Complement)

    grid $w.main.fgrepCaseInsensitiveckb -row 0 -column 0 -sticky w -pady 2
    grid $w.main.fgrepComplementckb -row 1 -column 0 -sticky w -pady 2
    grid $w.main.fgrepMatchOnlyckb -row 2 -column 0 -sticky w -pady 2

    frame $w.cntls
    button $w.cntls.save -text [_ "Save"] -command SaveFgrepInfo
    button $w.cntls.dis -text [_ "Dismiss"] -command [list destroy $w]
    pack $w.cntls.dis -side left -expand 0 -fill none
    pack $w.cntls.save -side right -expand 0 -fill none
    pack $w.title -side top -expand 1 -fill both -pady 4     -padx 8
    pack $w.main  -side top -expand 1 -fill both -pady 4     -padx 8
    pack $w.cntls -side top -expand 1 -fill both -pady {8 4} -padx 8
    balloonhelp_for $w $genmsg
    balloonhelp_for $w.title $genmsg
    balloonhelp_for $w.main $genmsg
    balloonhelp_for $w.cntls $genmsg
    set msg [_ "Press this button to make the changes you have made take effect."]
    balloonhelp_for $w.cntls.save $msg
    set msg [_ "Match without regard to case?"]
    balloonhelp_for $w.main.fgrepCaseInsensitiveckb $msg;
    set msg [_ "Press this button to dismiss the popup."]
    balloonhelp_for $w.cntls.dis $msg
    set msg [_ "Emit only the portion of the string that\nactually matched, not the whole line."]
    balloonhelp_for $w.main.fgrepMatchOnlyckb $msg;
    set msg [_ "Emit only strings not matching the regular expression?"]
    balloonhelp_for $w.main.fgrepComplementckb $msg;
}

proc SaveFgrepInfo {} { 
    if {$::fgrepCaseInsensitive} {
	set ::ProgramInfo(fgrep,CaseInsensitiveP) 1
    } else {
	set ::ProgramInfo(fgrep,CaseInsensitiveP) 0
    }
    if {$::fgrepComplement} {
	set ::ProgramInfo(fgrep,Complement) 1
    } else {
	set ::ProgramInfo(fgrep,Complement) 0
    }
    if {$::fgrepMatchOnly} {
	set ::ProgramInfo(fgrep,EmitMatchOnly) 1
    } else {
	set ::ProgramInfo(fgrep,EmitMatchOnly) 0
    }
}

option add  *pcpJava.*Background $::ColorSpecs(ProgramSpecificControls,Background) 100;
option add  *pcpJava.*Foreground $::ColorSpecs(ProgramSpecificControls,Foreground) 100;
option add  *pcpJava.*activeBackground $::ColorSpecs(ProgramSpecificControls,ActiveBackground) 100;
option add  *pcpJava.*activeForeground $::ColorSpecs(ProgramSpecificControls,ActiveForeground) 100;
option add  *pcpJava.*selectColor $::ColorSpecs(ProgramSpecificControls,Select) 100;
option add  *pcpJava.*Entry.Background $::ColorSpecs(ProgramSpecificControls,EntryBackground) 100;
option add  *pcpJava.*Entry.disabledBackground $::ColorSpecs(ProgramSpecificControls,DisabledEntryBackground) 100;

proc PopupJavaControls {} { 
    set w .pcpJava
    if {[winfo exist .pcpJava]} {
	if {![winfo ismapped .pcpJava]} {
	    wm deiconify .pcpJava;
	    raise .pcpJava
	} else {
	    wm iconify .pcpJava;
	}
	return ;
    }
    toplevel $w -borderwidth 4 -relief raised
    wm title $w Java
    after idle {
	raise .pcpJava
	update idletasks
	set xmax [winfo screenwidth .pcpJava]
	set ymax [winfo screenheight .pcpJava]
	set x0 [expr int( rand() * double($xmax -[winfo reqwidth  .pcpJava]))];
	set y0 [expr int( rand() * double($ymax -[winfo reqheight .pcpJava]))];
	wm geometry .pcpJava "+$x0+$y0";
    }
    set genmsg [_ "Set command-line options for java."]
    set title [_ "Java Settings"]
    label $w.title -text $title  -font PopupTitleFont 
    frame $w.main
    checkbutton $w.main.javaCanonEQckb -text \
	[_ "Use Canonical Equivalence?"] \
	-variable javaCanonEQ -onvalue 1 -offvalue 0
    checkbutton $w.main.javaCaseInsensitiveckb -text \
	[_ "Match ASCII Without Regard to Case?"] \
	-variable javaCaseInsensitive -onvalue 1 -offvalue 0
    checkbutton $w.main.javaUnicodeCaseckb -text \
	[_ "Match Unicode Without Regard to Case?"] \
	-variable javaUnicodeCase -onvalue 1 -offvalue 0
    set ::javaCanonEQ $::ProgramInfo(java,CanonEQ)
    set ::javaCaseInsensitive $::ProgramInfo(java,CaseInsensitiveP)
    set ::javaUnicodeCase $::ProgramInfo(java,UnicodeCase)

    grid $w.main.javaCanonEQckb -row 0 -column 0 -sticky w -pady 3
    grid $w.main.javaCaseInsensitiveckb -row 1 -column 0 -sticky w -pady 3
    grid $w.main.javaUnicodeCaseckb -row 2 -column 0 -sticky w -pady 3

    frame $w.cntls
    button $w.cntls.save -text [_ "Save"] -command SaveJavaInfo
    button $w.cntls.dis -text [_ "Dismiss"] -command [list destroy $w]
    pack $w.cntls.dis -side left -expand 0 -fill none -padx 4
    pack $w.cntls.save -side right -expand 0 -fill none -padx 4
    pack $w.title -side top -expand 1 -fill both -padx 8 -pady 4
    pack $w.main  -side top -expand 1 -fill both -padx 8 -pady 4
    pack $w.cntls -side top -expand 1 -fill both -padx 8 -pady {8 4}
    balloonhelp_for $w $genmsg
    balloonhelp_for $w.title $genmsg
    balloonhelp_for $w.main $genmsg
    balloonhelp_for $w.cntls $genmsg
    set msg [_ "Press this button to make the changes you have made take effect."]
    balloonhelp_for $w.cntls.save $msg
    set msg [_ "Press this button to dismiss the popup."]
    balloonhelp_for $w.cntls.dis $msg
    set msg [_ "Set the Pattern.Canon_EQ regexp compilation flag?"]
    balloonhelp_for $w.main.javaCanonEQckb $msg;
    set msg [_ "Match ASCII characters without regard to case?"]
    balloonhelp_for $w.main.javaCaseInsensitiveckb $msg;
    set msg [_ "Match all Unicode characters without regard to case?"]
    balloonhelp_for $w.main.javaUnicodeCaseckb $msg;
}

proc SaveJavaInfo {} { 
    if {$::javaCanonEQ} {
	set ::ProgramInfo(java,CanonEQ) 1
    } else {
	set ::ProgramInfo(java,CanonEQ) 0
    }
    if {$::javaCaseInsensitive} {
	set ::ProgramInfo(java,CaseInsensitiveP) 1
    } else {
	set ::ProgramInfo(java,CaseInsensitiveP) 0
    }
    if {$::javaUnicodeCase} {
	set ::ProgramInfo(java,UnicodeCase) 1
    } else {
	set ::ProgramInfo(java,UnicodeCase) 0
    }
    set ::UpdateJavaByteCodeP 1;
}

option add  *pcpJgrep.*Background $::ColorSpecs(ProgramSpecificControls,Background) 100;
option add  *pcpJgrep.*Foreground $::ColorSpecs(ProgramSpecificControls,Foreground) 100;
option add  *pcpJgrep.*activeBackground $::ColorSpecs(ProgramSpecificControls,ActiveBackground) 100;
option add  *pcpJgrep.*activeForeground $::ColorSpecs(ProgramSpecificControls,ActiveForeground) 100;
option add  *pcpJgrep.*selectColor $::ColorSpecs(ProgramSpecificControls,Select) 100;
option add  *pcpJgrep.*Entry.Background $::ColorSpecs(ProgramSpecificControls,EntryBackground) 100;
option add  *pcpJgrep.*Entry.disabledBackground $::ColorSpecs(ProgramSpecificControls,DisabledEntryBackground) 100;

proc PopupJgrepControls {} { 
    set w .pcpJgrep
    if {[winfo exist .pcpJgrep]} {
	if {![winfo ismapped .pcpJgrep]} {
	    wm deiconify .pcpJgrep;
	    raise .pcpJgrep
	} else {
	    wm iconify .pcpJgrep;
	}
	return ;
    }
    toplevel $w -borderwidth 4 -relief raised
    wm title $w Jgrep
    after idle {
	raise .pcpJgrep
	update idletasks
	set xmax [winfo screenwidth .pcpJgrep]
	set ymax [winfo screenheight .pcpJgrep]
	set x0 [expr int( rand() * double($xmax -[winfo reqwidth  .pcpJgrep]))];
	set y0 [expr int( rand() * double($ymax -[winfo reqheight .pcpJgrep]))];
	wm geometry .pcpJgrep "+$x0+$y0";
    }
    set genmsg [_ "Set command-line options for jgrep."]
    set title [_ "Jgrep Settings"]
    label $w.title -text $title  -font PopupTitleFont 
    frame $w.main
    checkbutton $w.main.jgrepCaseInsensitiveckb -text [_ "Case Insensitive"] \
	-variable jgrepCaseInsensitive -onvalue 1 -offvalue 0
    set ::jgrepCaseInsensitive $::ProgramInfo(jgrep,CaseInsensitiveP)

    grid $w.main.jgrepCaseInsensitiveckb -row 0 -column 0 -sticky w

    frame $w.cntls
    button $w.cntls.save -text [_ "Save"] -command SaveJgrepInfo
    set msg [_ "Press this button to dismiss the popup."]
    button $w.cntls.dis -text [_ "Dismiss"] -command [list destroy $w]
    pack $w.cntls.dis -side left -expand 0 -fill none
    pack $w.cntls.save -side right -expand 0 -fill none
    pack $w.title $w.main $w.cntls -side top -expand 1 -fill both -pady 4 -padx 15 -ipadx 5
    balloonhelp_for $w $genmsg
    balloonhelp_for $w.title $genmsg
    balloonhelp_for $w.main $genmsg
    balloonhelp_for $w.cntls $genmsg
    set msg [_ "Press this button to make the changes you have made take effect."]
    balloonhelp_for $w.cntls.save $msg
    set msg [_ "Press this button to dismiss the popup."]
    balloonhelp_for $w.cntls.dis $msg
    set msg [_ "Match without regard to case?"]
    balloonhelp_for $w.main.jgrepCaseInsensitiveckb $msg;
}

proc SaveJgrepInfo {} { 
    if {$::jgrepCaseInsensitive} {
	set ::ProgramInfo(jgrep,CaseInsensitiveP) 1
    } else {
	set ::ProgramInfo(jgrep,CaseInsensitiveP) 0
    }
}


option add  *pcpNrgrep.*Background $::ColorSpecs(ProgramSpecificControls,Background) 100;
option add  *pcpNrgrep.*Foreground $::ColorSpecs(ProgramSpecificControls,Foreground) 100;
option add  *pcpNrgrep.*activeBackground $::ColorSpecs(ProgramSpecificControls,ActiveBackground) 100;
option add  *pcpNrgrep.*activeForeground $::ColorSpecs(ProgramSpecificControls,ActiveForeground) 100;
option add  *pcpNrgrep.*selectColor $::ColorSpecs(ProgramSpecificControls,Select) 100;
option add  *pcpNrgrep.*Entry.Background $::ColorSpecs(ProgramSpecificControls,EntryBackground) 100;
option add  *pcpNrgrep.*Entry.disabledBackground $::ColorSpecs(ProgramSpecificControls,DisabledEntryBackground) 100;

proc PopupNrgrepControls {} { 
    set w .pcpNrgrep
    if {[winfo exist .pcpNrgrep]} {
	if {![winfo ismapped .pcpNrgrep]} {
	    wm deiconify .pcpNrgrep;
	    raise .pcpNrgrep
	} else {
	    wm iconify .pcpNrgrep;
	}
	return ;
    }
    toplevel $w -borderwidth 4 -relief raised
    wm title $w Nrgrep
    after idle {
	raise .pcpNrgrep
	update idletasks
	set xmax [winfo screenwidth .pcpNrgrep]
	set ymax [winfo screenheight .pcpNrgrep]
	set x0 [expr int( rand() * double($xmax -[winfo reqwidth  .pcpNrgrep]))];
	set y0 [expr int( rand() * double($ymax -[winfo reqheight .pcpNrgrep]))];
	wm geometry .pcpNrgrep "+$x0+$y0";
    }
    set genmsg [_ "Set command-line options for nrgrep."]
    label $w.title -text [_ "Nrgrep Settings"] -relief groove -border 1 -font PopupTitleFont
    frame $w.main
    checkbutton $w.main.nrgrepCaseInsensitiveckb -text [_ "Case Insensitive"] \
	-variable nrgrepCaseInsensitiveP -onvalue 1 -offvalue 0
    set ::nrgrepCaseInsensitiveP $::ProgramInfo(nrgrep,CaseInsensitiveP)
    checkbutton $w.main.nrgrepComplementckb -text [_ "Complement"] \
	-variable nrgrepComplementP -onvalue 1 -offvalue 0
    set ::nrgrepComplementP $::ProgramInfo(nrgrep,ComplementP)

    frame $w.main.app -relief ridge -border 2
    label $w.main.app.tit -text [_ "Approximate Matching"] -relief raised -border 1
    iwidgets::spinint $w.main.app.cost \
	-labelpos e \
	-width 3 \
	-range {0 100} \
	-wrap 0 \
	-labeltext Cost \
	-textbackground $::ColorSpecs(ProgramSpecificControls,Select) \
	-increment IncrementCost -decrement DecrementCost \
	-invalid {};# Prevents irritating flashing or ringing of bell
    checkbutton $w.main.app.nrgrepInsertionckb -text [_ "Insertions"] \
	-variable nrgrepInsertionsP -onvalue 1 -offvalue 0
    set ::nrgrepInsertionsP $::ProgramInfo(nrgrep,InsertionsP)
    checkbutton $w.main.app.nrgrepDeletionckb -text [_ "Deletions"] \
	-variable nrgrepDeletionsP -onvalue 1 -offvalue 0
    set ::nrgrepDeletionsP $::ProgramInfo(nrgrep,DeletionsP)
    checkbutton $w.main.app.nrgrepSubstitutionckb -text [_ "Substitutions"] \
	-variable nrgrepSubstitutionsP -onvalue 1 -offvalue 0
    set ::nrgrepSubstitutionsP $::ProgramInfo(nrgrep,SubstitutionsP)
    checkbutton $w.main.app.nrgrepTranspositionckb -text [_ "Transpositions"] \
	-variable nrgrepTranspositionsP -onvalue 1 -offvalue 0
    set ::nrgrepTranspositionsP $::ProgramInfo(nrgrep,TranspositionsP)
    pack $w.main.app.tit -side top  -expand 0 -fill none -pady 5 -padx 4 -ipadx 4 -ipady 2
    pack $w.main.app.cost -side top -expand 1 -fill y -anchor w -padx 4  -pady 5
    pack \
	$w.main.app.nrgrepInsertionckb \
	$w.main.app.nrgrepDeletionckb \
	$w.main.app.nrgrepSubstitutionckb \
	$w.main.app.nrgrepTranspositionckb \
	-side top -expand 1 -fill y -anchor w -padx 4  -pady 2
    $w.main.app.cost insert 0 $::ProgramInfo(nrgrep,TotalCost); 

    pack $w.main.app                      -side bottom -expand 1 -fill both \
	-padx 3 -pady 5
    pack $w.main.nrgrepCaseInsensitiveckb -side top    -expand 1 -fill y \
	-padx 3 -pady 3 -anchor w
    pack $w.main.nrgrepComplementckb      -side top    -expand 1 -fill y \
	-padx 3 -pady 3 -anchor w

    frame $w.cntls;
    button $w.cntls.save -text [_ "Save"] -command SaveNrgrepInfo
    set msg [_ "Press this button to dismiss the popup."]
    button $w.cntls.dis -text [_ "Dismiss"] -command [list destroy $w]
    pack $w.cntls.dis -side left -expand 0 -fill none -padx 5
    pack $w.cntls.save -side right -expand 0 -fill none -padx 5

    pack $w.title -side top -expand 1 -fill both -pady {8 4} -padx 35 -ipadx 5 -ipady 3
    pack $w.main  -side top -expand 1 -fill both -pady 4     -padx 20
    pack $w.cntls -side top -expand 1 -fill both -pady {4 8} -padx 20
    #balloonhelp_for $w $genmsg
    balloonhelp_for $w.title $genmsg
    balloonhelp_for $w.main $genmsg
    balloonhelp_for $w.cntls $genmsg
    set msg [_ "Press this button to make the changes you have made take effect."]
    balloonhelp_for $w.cntls.save $msg
    set msg [_ "Match without regard to case?"]
    balloonhelp_for $w.main.nrgrepCaseInsensitiveckb $msg;
    set msg [_ "Press this button to dismiss the popup."]
    balloonhelp_for $w.cntls.dis $msg
    set msg [_ "Emit only strings not matching the regular expression?"]
    balloonhelp_for $w.main.nrgrepComplementckb $msg;
}

proc IncrementCost {} {
    .pcpNrgrep.main.app.cost up
}

proc DecrementCost {} {
    .pcpNrgrep.main.app.cost down
}

proc SaveNrgrepInfo {} { 
    set ::ProgramInfo(nrgrep,TotalCost) [.pcpNrgrep.main.app.cost get]
    if {$::nrgrepCaseInsensitiveP} {
	set ::ProgramInfo(nrgrep,CaseInsensitiveP) 1
    } else {
	set ::ProgramInfo(nrgrep,CaseInsensitiveP) 0
    }
    if {$::nrgrepComplementP} {
	set ::ProgramInfo(nrgrep,ComplementP) 1
    } else {
	set ::ProgramInfo(nrgrep,ComplementP) 0
    }
    if {$::nrgrepInsertionsP} {
	set ::ProgramInfo(nrgrep,InsertionsP) 1
    } else {
	set ::ProgramInfo(nrgrep,InsertionsP) 0
    }
    if {$::nrgrepDeletionsP} {
	set ::ProgramInfo(nrgrep,DeletionsP) 1
    } else {
	set ::ProgramInfo(nrgrep,DeletionsP) 0
    }
    if {$::nrgrepSubstitutionsP} {
	set ::ProgramInfo(nrgrep,SubstitutionsP) 1
    } else {
	set ::ProgramInfo(nrgrep,SubstitutionsP) 0
    }
    if {$::nrgrepTranspositionsP} {
	set ::ProgramInfo(nrgrep,TranspositionsP) 1
    } else {
	set ::ProgramInfo(nrgrep,TranspositionsP) 0
    }
}

option add  *pcpPerl.*Background $::ColorSpecs(ProgramSpecificControls,Background) 100;
option add  *pcpPerl.*Foreground $::ColorSpecs(ProgramSpecificControls,Foreground) 100;
option add  *pcpPerl.*activeBackground $::ColorSpecs(ProgramSpecificControls,ActiveBackground) 100;
option add  *pcpPerl.*activeForeground $::ColorSpecs(ProgramSpecificControls,ActiveForeground) 100;
option add  *pcpPerl.*selectColor $::ColorSpecs(ProgramSpecificControls,Select) 100;
option add  *pcpPerl.*Entry.Background $::ColorSpecs(ProgramSpecificControls,EntryBackground) 100;
option add  *pcpPerl.*Entry.disabledBackground $::ColorSpecs(ProgramSpecificControls,DisabledEntryBackground) 100;

proc PopupPerlControls {} { 
    set w .pcpPerl
    if {[winfo exist .pcpPerl]} {
	if {![winfo ismapped .pcpPerl]} {
	    wm deiconify .pcpPerl;
	    raise .pcpPerl
	} else {
	    wm iconify .pcpPerl;
	}
	return ;
    }
    toplevel $w -borderwidth 4 -relief raised
    wm title $w Perl
    after idle {
	raise .pcpPerl
	update idletasks
	set xmax [winfo screenwidth .pcpPerl]
	set ymax [winfo screenheight .pcpPerl]
	set x0 [expr int( rand() * double($xmax -[winfo reqwidth  .pcpPerl]))];
	set y0 [expr int( rand() * double($ymax -[winfo reqheight .pcpPerl]))];
	wm geometry .pcpPerl "+$x0+$y0";
    }
    set genmsg [_ "Set options for perl."]
    set title [_ "Perl Settings"]
    label $w.title -text $title  -font PopupTitleFont 
    frame $w.main
    checkbutton $w.main.perlUnicodeLocaleDependentPckb \
	-text [_ "Make Unicode Support\nLocale Dependent?"] \
	-variable perlUnicodeLocaleDependentP -onvalue 1 -offvalue 0
    set ::perlUnicodeLocaleDependentP $::ProgramInfo(perl,UnicodeLocaleDependentP)

    grid $w.main.perlUnicodeLocaleDependentPckb -row 0 -column 0 -sticky w

    frame $w.cntls
    button $w.cntls.save -text [_ "Save"] -command SavePerlInfo
    button $w.cntls.dis -text [_ "Dismiss"] -command [list destroy $w]
    pack $w.cntls.dis -side left -expand 0 -fill none
    pack $w.cntls.save -side right -expand 0 -fill none
    pack $w.title $w.main $w.cntls -side top -expand 1 -fill both -pady 4 -padx 10 -ipadx 5
    balloonhelp_for $w $genmsg
    balloonhelp_for $w.title $genmsg
    balloonhelp_for $w.main $genmsg
    balloonhelp_for $w.cntls $genmsg
    set msg [_ "Press this button to make the changes you have made take effect."]
    balloonhelp_for $w.cntls.save $msg
    set msg [_ "Press this button to dismiss the popup."]
    balloonhelp_for $w.cntls.dis $msg
    set msg [_ "Make Unicode support locale dependent?"]
    balloonhelp_for $w.main.perlUnicodeLocaleDependentPckb $msg;
}

proc SavePerlInfo {} { 
    if {$::perlUnicodeLocaleDependentP} {
	set ::ProgramInfo(perl,UnicodeLocaleDependentP) 1
    } else {
	set ::ProgramInfo(perl,UnicodeLocaleDependentP) 0
    }
}

proc PerlUnicodeDepUpdate {n e o} {
    TestFeatures;
    LabelMenus;
}

option add  *pcpPython.*Background $::ColorSpecs(ProgramSpecificControls,Background) 100;
option add  *pcpPython.*Foreground $::ColorSpecs(ProgramSpecificControls,Foreground) 100;
option add  *pcpPython.*activeBackground $::ColorSpecs(ProgramSpecificControls,ActiveBackground) 100;
option add  *pcpPython.*activeForeground $::ColorSpecs(ProgramSpecificControls,ActiveForeground) 100;
option add  *pcpPython.*selectColor $::ColorSpecs(ProgramSpecificControls,Select) 100;
option add  *pcpPython.*Entry.Background $::ColorSpecs(ProgramSpecificControls,EntryBackground) 100;
option add  *pcpPython.*Entry.disabledBackground $::ColorSpecs(ProgramSpecificControls,DisabledEntryBackground) 100;

proc PopupPythonControls {} { 
    set w .pcpPython
    if {[winfo exist .pcpPython]} {
	if {![winfo ismapped .pcpPython]} {
	    wm deiconify .pcpPython;
	    raise .pcpPython
	} else {
	    wm iconify .pcpPython;
	}
	return ;
    }
    toplevel $w -borderwidth 4 -relief raised
    wm title $w Python
    after idle {
	raise .pcpPython
	update idletasks
	set xmax [winfo screenwidth .pcpPython]
	set ymax [winfo screenheight .pcpPython]
	set x0 [expr int( rand() * double($xmax -[winfo reqwidth  .pcpPython]))];
	set y0 [expr int( rand() * double($ymax -[winfo reqheight .pcpPython]))];
	wm geometry .pcpPython "+$x0+$y0";
    }
    set genmsg [_ "Set options for python."]
    set title [_ "Python Settings"]
    label $w.title -text $title  -font PopupTitleFont 
    frame $w.main
    checkbutton $w.main.pythonRawStringPckb -text [_ "Pass Expressions as\nRaw Strings?"] \
	-variable pythonRawStringP -onvalue 1 -offvalue 0
    set ::pythonRawStringP $::ProgramInfo(python,RawStringP)

    grid $w.main.pythonRawStringPckb -row 0 -column 0 -sticky w

    frame $w.cntls
    button $w.cntls.save -text [_ "Save"] -command SavePythonInfo
    button $w.cntls.dis -text [_ "Dismiss"] -command [list destroy $w]
    pack $w.cntls.dis -side left -expand 0 -fill none
    pack $w.cntls.save -side right -expand 0 -fill none
    pack $w.title -side top -expand 1 -fill both -padx 8 -pady 4
    pack $w.main  -side top -expand 1 -fill both -padx 8 -pady 4
    pack $w.cntls -side top -expand 1 -fill both -padx 8 -pady {8 4}
    balloonhelp_for $w $genmsg
    balloonhelp_for $w.title $genmsg
    balloonhelp_for $w.main $genmsg
    balloonhelp_for $w.cntls $genmsg
    set msg [_ "Press this button to make the changes you have made take effect."]
    balloonhelp_for $w.cntls.save $msg
    set msg [_ "Press this button to dismiss the popup."]
    balloonhelp_for $w.cntls.dis $msg
    set msg [_ "Pass expressions as raw strings?"]
    balloonhelp_for $w.main.pythonRawStringPckb $msg;
}

proc SavePythonInfo {} { 
    if {$::pythonRawStringP} {
	set ::ProgramInfo(python,RawStringP) 1
    } else {
	set ::ProgramInfo(python,RawStringP) 0
    }
}

option add  *pcpSed.*Background $::ColorSpecs(ProgramSpecificControls,Background) 100;
option add  *pcpSed.*Foreground $::ColorSpecs(ProgramSpecificControls,Foreground) 100;
option add  *pcpSed.*activeBackground $::ColorSpecs(ProgramSpecificControls,ActiveBackground) 100;
option add  *pcpSed.*activeForeground $::ColorSpecs(ProgramSpecificControls,ActiveForeground) 100;
option add  *pcpSed.*selectColor $::ColorSpecs(ProgramSpecificControls,Select) 100;
option add  *pcpSed.*Entry.Background $::ColorSpecs(ProgramSpecificControls,EntryBackground) 100;
option add  *pcpSed.*Entry.disabledBackground $::ColorSpecs(ProgramSpecificControls,DisabledEntryBackground) 100;

proc PopupSedControls {} { 
    set w .pcpSed
    if {[winfo exist .pcpSed]} {
	if {![winfo ismapped .pcpSed]} {
	    wm deiconify .pcpSed;
	    raise .pcpSed
	} else {
	    wm iconify .pcpSed;
	}
	return ;
    }
    toplevel $w -borderwidth 4 -relief raised
    wm title $w Sed
    after idle {
	raise .pcpSed
	update idletasks
	set xmax [winfo screenwidth .pcpSed]
	set ymax [winfo screenheight .pcpSed]
	set x0 [expr int( rand() * double($xmax -[winfo reqwidth  .pcpSed]))];
	set y0 [expr int( rand() * double($ymax -[winfo reqheight .pcpSed]))];
	wm geometry .pcpSed "+$x0+$y0";
    }
    set genmsg [_ "Set command-line options for sed."]
    set title [_ "Sed Settings"]
    label $w.title -text $title  -font PopupTitleFont 
    frame $w.main
    checkbutton $w.main.sedExtendedRegexpckb -text \
	[_ "Use Extended Regular\nExpression Notation?"] \
	-variable sedExtendedRegexp -onvalue 1 -offvalue 0
    set ::sedExtendedRegexp $::ProgramInfo(sed,ExtendedRegexp)

    grid $w.main.sedExtendedRegexpckb -row 0 -column 0 -sticky w

    frame $w.cntls
    button $w.cntls.save -text [_ "Save"] -command SaveSedInfo
    button $w.cntls.dis -text [_ "Dismiss"] -command [list destroy $w]
    pack $w.cntls.dis -side left -expand 0 -fill none
    pack $w.cntls.save -side right -expand 0 -fill none
    pack $w.title -side top -expand 1 -fill both -padx 8 -pady 4
    pack $w.main  -side top -expand 1 -fill both -padx 8 -pady 4
    pack $w.cntls -side top -expand 1 -fill both -padx 8 -pady {8 4}
    balloonhelp_for $w $genmsg
    balloonhelp_for $w.title $genmsg
    balloonhelp_for $w.main $genmsg
    balloonhelp_for $w.cntls $genmsg
    set msg [_ "Press this button to make the changes you have made take effect."]
    balloonhelp_for $w.cntls.save $msg
    set msg [_ "Press this button to dismiss the popup."]
    balloonhelp_for $w.cntls.dis $msg
    set msg [_ "Use extended regular expression notation?"]
    balloonhelp_for $w.main.sedExtendedRegexpckb $msg;
}

proc SaveSedInfo {} { 
    if {$::sedExtendedRegexp} {
	set ::ProgramInfo(sed,ExtendedRegexp) 1
    } else {
	set ::ProgramInfo(sed,ExtendedRegexp) 0
    }
    TestFeatures;
}


option add  *pcpTcl.*Background $::ColorSpecs(ProgramSpecificControls,Background) 100;
option add  *pcpTcl.*Foreground $::ColorSpecs(ProgramSpecificControls,Foreground) 100;
option add  *pcpTcl.*activeBackground $::ColorSpecs(ProgramSpecificControls,ActiveBackground) 100;
option add  *pcpTcl.*activeForeground $::ColorSpecs(ProgramSpecificControls,ActiveForeground) 100;
option add  *pcpTcl.*selectColor $::ColorSpecs(ProgramSpecificControls,Select) 100;
option add  *pcpTcl.*Entry.Background $::ColorSpecs(ProgramSpecificControls,EntryBackground) 100;
option add  *pcpTcl.*Entry.disabledBackground $::ColorSpecs(ProgramSpecificControls,DisabledEntryBackground) 100;

proc PopupTclControls {} { 
    set w .pcpTcl
    if {[winfo exist .pcpTcl]} {
	if {![winfo ismapped .pcpTcl]} {
	    wm deiconify .pcpTcl;
	    raise .pcpTcl
	} else {
	    wm iconify .pcpTcl;
	}
	return ;
    }
    toplevel $w -borderwidth 4 -relief raised
    wm title $w Tcl
    after idle {
	raise .pcpTcl
	update idletasks
	set xmax [winfo screenwidth .pcpTcl]
	set ymax [winfo screenheight .pcpTcl]
	set x0 [expr int( rand() * double($xmax -[winfo reqwidth  .pcpTcl]))];
	set y0 [expr int( rand() * double($ymax -[winfo reqheight .pcpTcl]))];
	wm geometry .pcpTcl "+$x0+$y0";
    }
    set genmsg [_ "Set command-line options for tcl."]
    set title [_ "Tcl Settings"]
    label $w.title -text $title  -font PopupTitleFont 
    frame $w.main
    checkbutton $w.main.tclCaseInsensitiveckb -text [_ "Case Insensitive"] \
	-variable tclCaseInsensitive -onvalue 1 -offvalue 0
    set ::tclCaseInsensitive $::ProgramInfo(tcl,CaseInsensitiveP)
    checkbutton $w.main.tclExpandedckb -text [_ "Verbose"] \
	-variable tclExpanded -onvalue 1 -offvalue 0
    set ::tclExpanded $::ProgramInfo(tcl,ExpandedP)
    grid $w.main.tclCaseInsensitiveckb -row 0 -column 0 -sticky w
    grid $w.main.tclExpandedckb -row 1 -column 0 -sticky w

    frame $w.cntls
    button $w.cntls.save -text [_ "Save"] -command SaveTclInfo
    set msg [_ "Press this button to dismiss the popup."]
    button $w.cntls.dis -text [_ "Dismiss"] -command [list destroy $w]
    pack $w.cntls.dis -side left -expand 0 -fill none
    pack $w.cntls.save -side right -expand 0 -fill none
    pack $w.title $w.main $w.cntls -side top -expand 1 -fill both -pady 4 -padx 15 -ipadx 5
    balloonhelp_for $w $genmsg
    balloonhelp_for $w.title $genmsg
    balloonhelp_for $w.main $genmsg
    balloonhelp_for $w.cntls $genmsg
    set msg [_ "Press this button to make the changes you have made take effect."]
    balloonhelp_for $w.cntls.save $msg
    set msg [_ "Press this button to dismiss the popup."]
    balloonhelp_for $w.cntls.dis $msg
    set msg [_ "Match without regard to case?"]
    balloonhelp_for $w.main.tclCaseInsensitiveckb $msg;
    set msg [_ "Ignore whitespace and comments within regular expression?"]
    balloonhelp_for $w.main.tclExpandedckb $msg;
}

proc SaveTclInfo {} { 
    if {$::tclCaseInsensitive} {
	set ::ProgramInfo(tcl,CaseInsensitiveP) 1
    } else {
	set ::ProgramInfo(tcl,CaseInsensitiveP) 0
    }
    if {$::tclExpanded} {
	set ::ProgramInfo(tcl,ExpandedP) 1
    } else {
	set ::ProgramInfo(tcl,ExpandedP) 0
    }
}

option add  *pcpTr.*Background $::ColorSpecs(ProgramSpecificControls,Background) 100;
option add  *pcpTr.*Foreground $::ColorSpecs(ProgramSpecificControls,Foreground) 100;
option add  *pcpTr.*activeBackground $::ColorSpecs(ProgramSpecificControls,ActiveBackground) 100;
option add  *pcpTr.*activeForeground $::ColorSpecs(ProgramSpecificControls,ActiveForeground) 100;
option add  *pcpTr.*selectColor $::ColorSpecs(ProgramSpecificControls,Select) 100;
option add  *pcpTr.*Entry.Background $::ColorSpecs(ProgramSpecificControls,EntryBackground) 100;
option add  *pcpTr.*Entry.disabledBackground $::ColorSpecs(ProgramSpecificControls,DisabledEntryBackground) 100;

proc PopupTrControls {} { 
    set w .pcpTr
    if {[winfo exist .pcpTr]} {
	if {![winfo ismapped .pcpTr]} {
	    wm deiconify .pcpTr;
	    raise .pcpTr
	} else {
	    wm iconify .pcpTr;
	}
	return ;
    }
    toplevel $w -borderwidth 4 -relief raised
    wm title $w Tr
    after idle {
	raise .pcpTr
	update idletasks
	set xmax [winfo screenwidth .pcpTr]
	set ymax [winfo screenheight .pcpTr]
	set x0 [expr int( rand() * double($xmax -[winfo reqwidth  .pcpTr]))];
	set y0 [expr int( rand() * double($ymax -[winfo reqheight .pcpTr]))];
	wm geometry .pcpTr "+$x0+$y0";
    }
    set genmsg [_ "Set command-line options for Tr."]
    set title [_ "Tr Settings"]
    label $w.title -text $title  -font PopupTitleFont 
    frame $w.main
    checkbutton $w.main.trComplementckb -text [_ "Complement Set One?"] \
	-variable trComplement -onvalue 1 -offvalue 0
    set ::trComplement $::ProgramInfo(tr,Complement)

    checkbutton $w.main.trSqueezeckb -text [_ "Squeeze Repeats?"] \
	-variable trSqueeze -onvalue 1 -offvalue 0
    set ::trSqueeze $::ProgramInfo(tr,Squeeze)

    checkbutton $w.main.trTruncateckb -text [_ "Truncate Set One to Length\nof Set Two?"] \
	-variable trTruncate -onvalue 1 -offvalue 0
    set ::trTruncate $::ProgramInfo(tr,Truncate)

    grid $w.main.trComplementckb -row 0 -column 0 -sticky w -pady 3
    grid $w.main.trSqueezeckb    -row 1 -column 0 -sticky w -pady 3
    grid $w.main.trTruncateckb   -row 2 -column 0 -sticky w -pady 3

    frame $w.cntls
    button $w.cntls.save -text [_ "Save"] -command SaveTrInfo
    button $w.cntls.dis -text [_ "Dismiss"] -command [list destroy $w]
    pack $w.cntls.dis -side left -expand 0 -fill none
    pack $w.cntls.save -side right -expand 0 -fill none
    pack $w.title -side top -expand 1 -fill both -padx 8 -pady 4
    pack $w.main  -side top -expand 1 -fill both -padx 8 -pady 4
    pack $w.cntls -side top -expand 1 -fill both -padx 8 -pady {8 4}
    balloonhelp_for $w $genmsg
    balloonhelp_for $w.title $genmsg
    balloonhelp_for $w.main $genmsg
    balloonhelp_for $w.cntls $genmsg
    set msg [_ "Press this button to make the changes you have made take effect."]
    balloonhelp_for $w.cntls.save $msg
    set msg [_ "Press this button to dismiss the popup."]
    balloonhelp_for $w.cntls.dis $msg
    set msg [_ "Map the characters not in set one rather than \
 	those in set one?"]
    balloonhelp_for $w.main.trComplementckb $msg;
    set msg [_ "Replace sequences of more than one of the same character in\n\
 	set one with a single token."];
    balloonhelp_for $w.main.trSqueezeckb $msg;
    set msg [_ "Truncate the length of set one to the length of set two."];
    balloonhelp_for $w.main.trTruncateckb $msg;
}

proc SaveTrInfo {} { 
    if {$::TrComplement} {
	set ::ProgramInfo(Tr,Complement) 1
    } else {
	set ::ProgramInfo(Tr,Complement) 0
    }
    if {$::TrSqueeze} {
	set ::ProgramInfo(Tr,Squeeze) 1
    } else {
	set ::ProgramInfo(Tr,Squeeze) 0
    }
    if {$::TrTruncate} {
	set ::ProgramInfo(Tr,Truncate) 1
    } else {
	set ::ProgramInfo(Tr,Truncate) 0
    }
}

proc PopupCurrentProgramControls {{InteractiveP 1}} {
    set FunctionName Popup${::Program}Controls;
    if {[info commands $FunctionName] != ""} {
	eval $FunctionName
    } else {
	if {$InteractiveP} {
	    ShowMessage [_ "The current program, $::Program, has no settable parameters."]
	}
    }
}

proc UpdateProgramControlPanel {} {
    set PreviousPanel .${::PreviousProgram}cp
    if {[winfo exists $PreviousPanel]} {
	destroy $PreviousPanel;
	PopupCurrentProgramControls 0;
    }
}

#Here are the procedures that execute the individual programs.

proc ExecuteMatchAgrep {args} {
    global TestFile;
    set re [lindex $args 0]

#    set cl [list agrep -N]
    set cl [list agrep]

    if {$::ProgramInfo(agrep,CaseInsensitiveP)} {
	lappend cl -i
    }
    if {$::ProgramInfo(agrep,BestResults)} {
	lappend cl -B
	lappend cl -y
    }
    if {$::ProgramInfo(agrep,TotalCost) > 0} {
	lappend cl -A$::ProgramInfo(agrep,TotalCost)
	lappend cl -D$::ProgramInfo(agrep,DeletionCost)
	lappend cl -I$::ProgramInfo(agrep,InsertionCost)
	lappend cl -S$::ProgramInfo(agrep,SubstitutionCost)
    }

    if {[llength $args] > 1} {
	set extras [split [lindex $args 1]]
	foreach x $extras {
	    lappend cl $x;
	}
    }
    lappend cl $re;
    lappend cl $TestFile;
    if {[string match $::ExecutionFlag Normal] == 0} {return [list [join $cl]]}
    set cl [linsert $cl 0 "tk_exec"]
    return [eval $cl]
}

proc ExecuteMatchAwk {re} {
    global TestFile;
    global CommandFile;

    if {[catch {open $CommandFile "w"} CommandHandle ] != 0} {
	ShowMessage [format [_ "Unable to open file %s."] $CommandFile];
	error "";
    }
    set cmd "\$0 ~ /$re/ {print \$0}"
    puts $CommandHandle $cmd;
    close $CommandHandle; 

    set cl [list awk]
    lappend cl "-f"
    lappend cl $CommandFile
    lappend cl "<"
    lappend cl $TestFile
    if {[string match $::ExecutionFlag Normal] == 0} {return [list [join $cl] $cmd]}
    set cl [linsert $cl 0 "tk_exec"]
    return [eval $cl]
}

proc ExecuteSubAwk {re sub} {
    global TestFile;
    global CommandFile;

    if {[catch {open $CommandFile "w"} CommandHandle ] != 0} {
	ShowMessage [format [_ "Unable to open file %s."] $CommandFile];
	error "";
    }
    set cmd [format "\{print gensub(/%s/,\"%s\",1)\}" $re $sub];
    puts $CommandHandle $cmd;
    close $CommandHandle;

    set cl [list awk]
    lappend cl "-f"
    lappend cl $CommandFile
    lappend cl "<"
    lappend cl $TestFile
    if {[string match $::ExecutionFlag Normal] == 0} {return [list [join $cl] $cmd]}
    set cl [linsert $cl 0 "tk_exec"]
    return [eval $cl]
}

proc ExecuteMatchBash {re} {
    global ShellItemLimit;
    global TestFile;
    global TempGlobDir;

    #Read test data back in, storing in array, one line at a time;
    if {[catch {open $TestFile "r"} TempDataHandle ] != 0} {
	ShowMessage [format [_ "Unable to read test data back in from %s."] $TestFile];
	error "ExecuteMatchBash";
    }
    set LineCount 0
    while { [gets $TempDataHandle line] > 0} {
	incr LineCount;
	set TestLines($LineCount) $line
    }
    close $TempDataHandle;

    if {$LineCount >= $ShellItemLimit} {
	ShowMessage [format [_ "%1\$d items exceeds limit of %2\$d  for shells."] $LineCount $ShellItemLimit]
	#Delay so that user will get a chance to read above message.
	after 1000;
	error [format "ExecuteMatchBash: %s" [_ "item limit exceeded"]];
    } 

    #Clean out this directory if it already exists. 
    file delete -force $TempGlobDir;
    file mkdir $TempGlobDir;
    for {set i 1} {$i <= $LineCount} {incr i} {
	set NewFile [file join $TempGlobDir $TestLines($i)];
	if {[catch {open  $NewFile "w"} TempDataHandle] != 0} { 
	    WriteJournal [format [_ "Unable to open file %s."] $NewFile];
	    continue ;
	} else {
	    puts $TempDataHandle "x";
	    close $TempDataHandle;
	}
    }
    set cl [list bash]
    lappend cl "-c"
    regsub -all ";" $re "\\;" qre
    lappend cl "cd $TempGlobDir;ls $qre"
    if {[string match $::ExecutionFlag Normal] == 0} {return [list [join $cl]]}
    set cl [linsert $cl 0 "tk_exec"]
    return [eval $cl]
}

proc ExecuteMatchCgrep {args} {
    global TestFile;
    set re [lindex $args 0]
    set cl [list cgrep]
    lappend cl -E; #Change this when the fgrep/grep/egrep options are set up.
    if {$::ProgramInfo(cgrep,CaseInsensitiveP)} {
	lappend cl -i
    }
    if {$::ProgramInfo(cgrep,Complement)} {
	lappend cl -v
    }
    lappend cl -A
    lappend cl $::ProgramInfo(cgrep,TotalCost);
    lappend cl +C
    lappend cl $::ProgramInfo(cgrep,InsertionCost);
    lappend cl -C
    lappend cl $::ProgramInfo(cgrep,DeletionCost);
    lappend cl +-C
    lappend cl $::ProgramInfo(cgrep,SubstitutionCost);
    if {[llength $args] > 1} {
	set extras [split [lindex $args 1]]
	foreach x $extras {
	    lappend cl $x;
	}
    }
    lappend cl -e
    lappend cl $re
    lappend cl "<"
    lappend cl $TestFile
    if {[string match $::ExecutionFlag Normal] == 0} {return [list [join $cl]]}
    set cl [linsert $cl 0 "tk_exec"]
    return [eval $cl];
}

proc ExecuteMatchEd {re} {
    global TestFile;
    global CommandFile;

    if {[catch {open $CommandFile "w"} CommandHandle ] != 0} {
	ShowMessage [format [_ "Unable to open file %s."] $CommandFile];
	error "";
    }
    set cmd "g/$re/";
    puts $CommandHandle $cmd; 
    close $CommandHandle;

    set cl [list ed]
    lappend cl "-s"
    lappend cl $TestFile
    lappend cl "<"
    lappend cl $CommandFile
    if {[string match $::ExecutionFlag Normal] == 0} {return [list [join $cl]]}
    set cl [linsert $cl 0 "tk_exec"]
    return [eval $cl]
}

proc ExecuteSubEd {re sub} {
    global TestFile;
    global CommandFile;

    if {[catch {open $CommandFile "w"} CommandHandle ] != 0} {
	ShowMessage [format [_ "Unable to open file %s."] $CommandFile];
	error "";
    }
    set cmd "1,\$s/$re/$sub/g\n1,\$p";
    puts $CommandHandle $cmd;
    close $CommandHandle;

    set cl [list ed]
    lappend cl "-s"
    lappend cl $TestFile
    lappend cl "<"
    lappend cl $CommandFile
    if {[string match $::ExecutionFlag Normal] == 0} {return [list [join $cl] $cmd]}
    set cl [linsert $cl 0 "tk_exec"]
    return [eval $cl]
}

proc ExecuteMatchEgrep {re} {
    global TestFile;
    set cl [list egrep]

    if {$::ProgramInfo(egrep,CaseInsensitiveP)} {
	lappend cl -i
    }
    if {$::ProgramInfo(egrep,EmitMatchOnly)} {
	lappend cl -o
    }
    if {$::ProgramInfo(egrep,Complement)} {
	lappend cl -v
    }
    lappend cl $re
    lappend cl "<"
    lappend cl $TestFile
    if {[string match $::ExecutionFlag Normal] == 0} {return [list [join $cl]]}
    set cl [linsert $cl 0 "tk_exec"]
    return [eval $cl];
}

proc ExecuteMatchGlark {re} {
    global TestFile;
    set cl [list glark]
    lappend cl -h;			# Suppress listing of names of matching files
    lappend cl -q;			# Suppress warnings
    lappend cl -U;			# Suppress highlighting
    lappend cl -N;			# Suppress linenumbers
    if {$::ProgramInfo(glark,CaseInsensitiveP)} {
	lappend cl -i
    }
    if {$::ProgramInfo(glark,EmitMatchOnly)} {
	lappend cl -y;			# Output only the matching region, not the entire line
    }
    if {$::ProgramInfo(glark,Complement)} {
	lappend cl -v;			# Output only the lines that do not match.
    }
    if {$::ProgramInfo(glark,MatchEntireLine)} {
	lappend cl -x;			# Output only the lines that match the entire line.
    }

    lappend cl $re
    lappend cl "<"
    lappend cl $TestFile
    if {[string match $::ExecutionFlag Normal] == 0} {return [list [join $cl]]}
    set cl [linsert $cl 0 "tk_exec"]
    return [eval $cl];
}

proc ExecuteMatchGrep {re} {
    global TestFile;
    set cl [list grep]

    set Which $::ProgramInfo(grep,Notation);
    switch -exact -- $Which {
	Basic  {lappend cl "-G"}
	Extended {lappend cl "-E"}
	Perl {lappend cl "-P"}
    }
    if {$::ProgramInfo(grep,CaseInsensitiveP)} {
	lappend cl -i
    }
    if {$::ProgramInfo(grep,EmitMatchOnly)} {
	lappend cl -o
    }
    if {$::ProgramInfo(grep,Complement)} {
	lappend cl -v
    }
    lappend cl $re
    lappend cl "<"
    lappend cl $TestFile
    if {[string match $::ExecutionFlag Normal] == 0} {return [list [join $cl]]}
    set cl [linsert $cl 0 "tk_exec"]
    return [eval $cl];
}


proc ExecuteMatchEmacs {re} {
    global TestFile;
    global CommandFile;
    global EmacsOutputFile;
    global EmacsWrapper;

    if {[catch {open $CommandFile "w"} CommandHandle ] != 0} {
	ShowMessage [format [_ "Unable to open file %s."] $CommandFile];
	error "";
    }
    set cmd [format "(defun append-to-buffer-with-nl (buffer start end)\n\"Append to specified buffer the text between start and end.\"\n\t(let ((oldbuf (current-buffer)))\n\t(save-current-buffer\n\t\t(set-buffer (get-buffer-create buffer))\n\t\t(insert-buffer-substring oldbuf start end)\n\t\t(insert \"\\n\"))))\n(defun print-regexp-matches (pattern)\n\t\"Print the lines matching a regexp\"\n(set-variable 'case-fold-search nil)\n\t(goto-char (point-min))\n\t(while (re-search-forward pattern nil t 1)\n\t\t(append-to-buffer-with-nl \"output\" (line-beginning-position) (line-end-position)))\n(set-buffer (get-buffer-create \"output\"))\n(write-file \"%s\"))\n(print-regexp-matches \"%s\")\n" $EmacsOutputFile $re];
    puts $CommandHandle $cmd;
    close $CommandHandle;

    set cl [list bash]
    lappend cl $EmacsWrapper
    if {[string match $::ExecutionFlag Normal] == 0} {return [list [join $cl] $cmd]}
    set cl [linsert $cl 0 "tk_exec"]
    return [eval $cl]
}

proc ExecuteSubEmacs {re sub} {
    global TestFile;
    global CommandFile;
    global EmacsOutputFile;
    global EmacsWrapper;

    if {[catch {open $CommandFile "w"} CommandHandle ] != 0} {
	ShowMessage [format [_ "Unable to open file %s."] $CommandFile];
	error "";
    }
    if {$::ProgramInfo(emacs,FoldCaseMatchP)} {
	set MatchCaseFlag "t";
    } else {
	set MatchCaseFlag "nil";
    }
    if {$::ProgramInfo(emacs,FoldCaseReplaceP)} {
	set ReplaceCaseFlag "t";
    } else {
	set ReplaceCaseFlag "nil";
    }
    set cmd [format \
		 "(set-variable 'case-fold-search %s)\n(goto-char (point-min))\n(while (re-search-forward \"%s\" nil t)\n\t(replace-match \"%s\" %s nil))\n(write-file \"%s\")\n" \
		 $MatchCaseFlag $re $sub $ReplaceCaseFlag $EmacsOutputFile];
    puts $CommandHandle $cmd;
    close $CommandHandle;
    set cl [list bash]; #This is correct. We need a shell.
    lappend cl $EmacsWrapper
    if {[string match $::ExecutionFlag Normal] == 0} {return [list [join $cl] $cmd]}
    set cl [linsert $cl 0 "tk_exec"]
    return [eval $cl]
}

proc ExecuteMatchEuphoria {re} {
    global TestFile;
    global CommandFile;

    if {[catch {open $CommandFile "w"} CommandHandle ] != 0} {
	ShowMessage [format [_ "Unable to open file %s."] $CommandFile];
	error "";
    }
    set cmd "include wildcard.e\nobject line\nwhile 1 do\n\tline = gets(0)\n\tif atom(line) then\n\t\texit\n\tend if\n\tline = line\[1..length(line)-1\]\n\tif wildcard_match(\"$re\",line) then\n\t\tputs(1,line)\n\t\tputs(1,'\\n')\n\tend if\nend while\n";
    puts $CommandHandle $cmd
    close $CommandHandle;

    set cl [list exu]
    lappend cl $CommandFile
    lappend cl "<"
    lappend cl $TestFile
    if {[string match $::ExecutionFlag Normal] == 0} {return [list [join $cl] $cmd]}
    set cl [linsert $cl 0 "tk_exec"]
    return [eval $cl]
}

proc ExecuteMatchFgrep {re} {
    global TestFile;
    set cl [list fgrep]

    if {$::ProgramInfo(fgrep,CaseInsensitiveP)} {
	lappend cl -i
    }
    if {$::ProgramInfo(fgrep,EmitMatchOnly)} {
	lappend cl -o
    }
    if {$::ProgramInfo(fgrep,Complement)} {
	lappend cl -v
    }
    lappend cl $re
    lappend cl "<"
    lappend cl $TestFile
    if {[string match $::ExecutionFlag Normal] == 0} {return [list [join $cl]]}
    set cl [linsert $cl 0 "tk_exec"]
    return [eval $cl];
}

proc ExecuteMatchFish {re} {
    global ShellItemLimit;
    global TempGlobDir;
    global TestFile;
    global CommandFile;

    #Read test data back in, storing in array, one line at a time;
    if {[catch {open $TestFile "r"} TempDataHandle ] != 0} {
	ShowMessage [format [_ "Unable to read test data back in from %s."] $TestFile];
	error "ExecuteMatchFish";
    }
    set LineCount 0;
    while { [gets $TempDataHandle line] > 0} {
	incr LineCount
	set TestLines($LineCount) $line
    }
    close $TempDataHandle;

    if {$LineCount > $ShellItemLimit} {
	ShowMessage [format [_ "%1\$d items exceeds limit of %2\$d  for shells."] $LineCount $ShellItemLimit];
	puts [format "%d items exceeds limit of %d  for shells." $LineCount $ShellItemLimit]
	#Delay so that user will get a chance to read above message. 
	after 5000;
	error [format "ExecuteMatchFish: %s" [_ "item limit exceeded"]];
    } 

    #Clean out this directory if it already exists. Then create files.
    file delete -force $TempGlobDir;
    file mkdir $TempGlobDir;
    for {set i 1} {$i <= $LineCount} {incr i} {
	set NewFile [file join $TempGlobDir $TestLines($i)];
	if {[catch {open  $NewFile "w"} TempDataHandle] != 0} { 
	    WriteJournal [format [_ "Unable to open file %s."] $NewFile];
	    continue ;
	} else {
	    puts $TempDataHandle "x";
	    close $TempDataHandle;
	}
    }

    if {[catch {open $CommandFile "w"} CommandHandle ] != 0} {
	ShowMessage [format [_ "Unable to open file %s."] $CommandFile];
	error "";
    }
    set cmd "cd $TempGlobDir\nls -1 $re"
    puts $CommandHandle $cmd
    close $CommandHandle;

    set cl [list fish < $CommandFile]
    if {[string match $::ExecutionFlag Normal] == 0} {return [list [join $cl]]}
    set cl [linsert $cl 0 "tk_exec"]
    return  [eval $cl]
}

proc ExecuteMatchFrink {re} {
    global TestFile;
    global CommandFile;

    if {[catch {open $CommandFile "w"} CommandHandle ] != 0} {
	ShowMessage [format [_ "Unable to open file %s."] $CommandFile];
	error "";
    }
    set cmd "for line = lines\[\"file:$TestFile\",\"UTF-8\"\]\n\tif (line =~ %r/$re/)\n\t\tprintln\[line\]\n"
    puts $CommandHandle $cmd
    close $CommandHandle;

    set cl [list java]
    lappend cl -cp
    lappend cl frink.jar
    lappend cl frink.parser.Frink
 #   lappend cl --nounits
    lappend cl $CommandFile
    if {[string match $::ExecutionFlag Normal] == 0} {return [list [join $cl] $cmd]}
    set cl [linsert $cl 0 "tk_exec"]
    return [eval $cl]
}

proc ExecuteSubFrink {re se} {
    global TestFile;
    global CommandFile;

    if {[catch {open $CommandFile "w"} CommandHandle ] != 0} {
	ShowMessage [format [_ "Unable to open file %s."] $CommandFile];
	error "";
    }
    set cmd "for line = lines\[\"file:$TestFile\",\"UTF-8\"\]\n{\n\tline =~ %s/$re/$se/g\n\tprintln\[line\]\n}\n"
    puts $CommandHandle $cmd
    close $CommandHandle;

    set cl [list java]
    lappend cl -cp
    lappend cl frink.jar
    lappend cl frink.parser.Frink
#    lappend cl --nounits
    lappend cl $CommandFile
    if {[string match $::ExecutionFlag Normal] == 0} {return [list [join $cl] $cmd]}
    set cl [linsert $cl 0 "tk_exec"]
    return [eval $cl]
}


proc ExecuteMatchGawk {re} {
    global TestFile;
    global CommandFile;
    if {[catch {open $CommandFile "w"} CommandHandle ] != 0} {
	ShowMessage [format [_ "Unable to open file %s."] $CommandFile];
	error "";
    }
    set cmd "\$0 ~ /$re/ {print \$0}";
    puts $CommandHandle $cmd;
    close $CommandHandle; 
    set cl [list gawk]
    set Which $::ProgramInfo(gawk,Notation);
    switch -exact -- $Which {
	Traditional  {lappend cl "--traditional"}
	Posix {lappend cl "--posix"}
    }
    if {$::ProgramInfo(gawk,CaseInsensitiveP)} {
	lappend cl -v
	lappend cl IGNORECASE=1
    }
    if {$::ProgramInfo(gawk,IntervalExpressions)} {
	lappend cl --re-interval
    }
    lappend cl "-f"
    lappend cl "$CommandFile"
    lappend cl "<"
    lappend cl $TestFile
    if {[string match $::ExecutionFlag Normal] == 0} {return [list [join $cl] $cmd]}
    set cl [linsert $cl 0 "tk_exec"]
    return  [eval $cl];

}

proc ExecuteSubGawk {re sub} {
    global TestFile;
    global CommandFile;

    if {[catch {open $CommandFile "w"} CommandHandle ] != 0} {
	ShowMessage [format [_ "Unable to open file %s."] $CommandFile];
	error "";
    }
    set cmd [format "\{print gensub(/%s/,\"%s\",1)\}" $re $sub];
    puts $CommandHandle $cmd;
    close $CommandHandle; 

    set cl [list gawk]
    set Which $::ProgramInfo(gawk,Notation);
    switch -exact -- $Which {
	Traditional  {lappend cl "--traditional"}
	Posix {lappend cl "--posix"}
    }
    if {$::ProgramInfo(gawk,IntervalExpressions)} {
	lappend cl "--re-interval"
    }
    if {$::ProgramInfo(gawk,CaseInsensitiveP)} {
	lappend cl -v
	lappend cl IGNORECASE=1
    }
    lappend cl "-f"
    lappend cl "$CommandFile"
    lappend cl "<"
    lappend cl $TestFile
    if {[string match $::ExecutionFlag Normal] == 0} {return [list [join $cl] $cmd]}
    set cl [linsert $cl 0 "tk_exec"]
    return  [eval $cl];
}

proc ExecuteMatchGuile {re} {
    global TestFile;
    global CommandFile;

    if {[catch {open $CommandFile "w"} CommandHandle ] != 0} {
	ShowMessage [format [_ "Unable to open file %s."] $CommandFile];
	error "";
    }
    set cmd "(use-modules (ice-9 rdelim))\n(define line \#f)\n(define re\n\t  (catch 'regular-expression-syntax\n\t\t(lambda () (make-regexp \"$re\"))\n\t\t(lambda (key . args)\n\t\t\t(begin\n\t\t\t\t(write-line \"regular expression syntax error\" (current-error-port))\n\t\t\t\t(quit 2)))))\n(while (begin (set! line (read-line)) (not (eof-object? line)))\n\t(if (regexp-exec re line)\n\t\t(write-line line)))\n";
    puts $CommandHandle $cmd;
    close $CommandHandle;
    set cl [list guile];
    lappend cl -s
    lappend cl $CommandFile
    lappend cl "<"
    lappend cl $TestFile;

    if {[string match $::ExecutionFlag Normal] == 0} {return [list [join $cl] $cmd]}
    set cl [linsert $cl 0 "tk_exec"]
    return  [eval $cl];
}

proc ExecuteSubGuile {re se} {
    global TestFile;
    global CommandFile;

    if {[catch {open $CommandFile "w"} CommandHandle ] != 0} {
	ShowMessage [format [_ "Unable to open file %s."] $CommandFile];
	error "";
    }
    set cmd "(use-modules (ice-9 rdelim) (ice-9 regex))\n(define line \#f)\n(while (begin (set! line (read-line)) (not (eof-object? line)))\n\t(write-line\n\t (catch 'regular-expression-syntax\n\t\t(lambda () (regexp-substitute/global \#f \"$re\" line $se))\n\t\t\t(lambda (key . args)\n\t\t\t\t (begin\n\t\t\t\t\t(write-line \"regular expression syntax error\" (current-error-port))\n\t\t\t\t\t\t(quit 2))))))";
    puts $CommandHandle $cmd; 
    close $CommandHandle;
    set cl [list guile];
    lappend cl -s
    lappend cl $CommandFile
    lappend cl "<"
    lappend cl $TestFile;

    if {[string match $::ExecutionFlag Normal] == 0} {return [list [join $cl] $cmd]}
    set cl [linsert $cl 0 "tk_exec"]
    return  [eval $cl];
}

proc ExecuteMatchIcon {re} {
    global TestFile;
    global CommandFile;

    if {[catch {open $CommandFile "w"} CommandHandle ] != 0} {
	ShowMessage [format [_ "Unable to open file %s."] $CommandFile];
	error "";
    }
    set cmd "link regexp\nprocedure main()\n\tlocal line, rep\n\tif (rep:=RePat(\"$re\")) then {\n\t\twhile (line := read()) do\n\t\t\tif ReFind(rep,line) then write(line)\n\t\treturn 0\n\t}\n\treturn 1\nend\n";
    puts $CommandHandle $cmd;
    close $CommandHandle; 

    set cl [list icon]
    lappend cl $CommandFile
    lappend cl "<"
    lappend cl $TestFile
    if {[string match $::ExecutionFlag Normal] == 0} {return [list [join $cl] $cmd]}
    set cl [linsert $cl 0 "tk_exec"]
    return [eval $cl]
}

proc ExecuteMatchJava {re} {
    global TestFile;
    global TempDir;
    global FeatureTestLogHandle;
    global TestingFeaturesP;
    set FLAGS 0;
    if {$::ProgramInfo(java,CanonEQ)} {
	append FLAGS {|Pattern.CANON_EQ}
    }
    if {$::ProgramInfo(java,CaseInsensitiveP)} {
	append FLAGS {|Pattern.CASE_INSENSITIVE}
    } elseif {$::ProgramInfo(java,UnicodeCase)} {
	append FLAGS {|Pattern.CASE_INSENSITIVE|Pattern.UNICODE_CASE}
    }

    set cmd \
	"import java.io.*;\nimport java.util.regex.*;\npublic class $::JavaMatchClassName {\n\tpublic static void main(String\[\] args) {\n\t\tString thisLine;\n\t\tString regexp = args\[0\];\n\t\ttry {\n\t\t\tPattern p = Pattern.compile(regexp,$FLAGS);\n\t\t\tMatcher m;\n\t\t\ttry {\n\t\t\t\tBufferedReader in = new BufferedReader(new InputStreamReader(System.in));\n\t\t\t\twhile ( (thisLine = in.readLine()) != null) {\n\t\t\t\t\tm = p.matcher(thisLine);\n\t\t\t\t\tif(m.matches()) System.out.println(thisLine);\n\t\t\t\t}\n\t\t\t}\n\t\t\tcatch (IOException e) {\n\t\t\t\tSystem.err.println(\"Error: \" + e);\n\t\t\t\tSystem.exit(2);\n\t\t\t}\n\t\t\tSystem.exit(0);\n\t\t}\n\t\tcatch (PatternSyntaxException e) {\n\t\t\tSystem.err.println(\"Error: \" + e);\n\t\t\tSystem.exit(1);\n\t\t}\n\t}\n}\n";
    if { ([file exists $::JavaMatchClassFile] == 0) || ($::UpdateJavaByteCodeP)} {
	if {[catch {open $::JavaMatchFile "w"} JavaHandle ] != 0} {
	    ShowMessage [format [_ "Unable to open file %s."] $::JavaMatchFile];
	    error [format [_ "Unable to open %s"] $::JavaMatchFile];
	}
	puts $JavaHandle $cmd;
	close $JavaHandle;
	# Byte compile the java source
	if { [catch {tk_exec javac $::JavaMatchFile}] != 0} {
	    if {$TestingFeaturesP} {
		if {$FeatureTestLogHandle != ""} {
		    puts $FeatureTestLogHandle [format "\t%s" [_ "Java compilation failed."]];
		}
	    } else {
		ShowMessage [_ "Java compilation failed."];
	    }
	    error [_ "Java compilation failed."];
	}
	set ::UpdateJavaByteCodeP 0;
    }
    set cl [list java]
    lappend cl "-classpath"
    lappend cl $TempDir
    lappend cl $::JavaMatchClassName
    lappend cl "$re"
    lappend cl "<"
    lappend cl $TestFile
    if {[string match $::ExecutionFlag Normal] == 0} {return [list [join $cl] $cmd]}
    set cl [linsert $cl 0 "tk_exec"]
    return [eval $cl]
}

proc ExecuteSubJava {re sub} {
    global TestFile;
    global TempDir;
    global FeatureTestLogHandle;
    global TestingFeaturesP;

    set FLAGS 0;
    if {$::ProgramInfo(java,CanonEQ)} {
	append FLAGS {|Pattern.CANON_EQ}
    }
    if {$::ProgramInfo(java,CaseInsensitiveP)} {
	append FLAGS {|Pattern.CASE_INSENSITIVE}
    } elseif {$::ProgramInfo(java,UnicodeCase)} {
	append FLAGS {|Pattern.CASE_INSENSITIVE|Pattern.UNICODE_CASE}
    }

    set cmd \
	"import java.io.*;\nimport java.util.regex.*;\npublic class $::JavaSubClassName {\n\tpublic static void main(String\[\] args) {\n\t\tString thisLine;\n\t\tString regexp = args\[0\];\n\t\tString sub = args\[1\];\n\t\ttry {\n\t\t\tPattern p = Pattern.compile(regexp,$FLAGS);\n\t\t\tMatcher m;\n\t\t\ttry {\n\t\t\t\tBufferedReader in = new BufferedReader(new InputStreamReader(System.in));\n\t\t\t\twhile ( (thisLine = in.readLine()) != null) {\n\t\t\t\t\tm = p.matcher(thisLine);\n\t\t\t\t\tSystem.out.println(m.replaceAll(sub));\n\t\t\t\t}\n\t\t\t}\n\t\t\tcatch (IOException e) {\n\t\t\t\tSystem.err.println(\"Error: \" + e);\n\t\t\t\tSystem.exit(2);\n\t\t\t}\n\t\t\tSystem.exit(0);\n\t\t}\n\t\tcatch (PatternSyntaxException e) {\n\t\t\tSystem.err.println(\"Error: \" + e);\n\t\t\tSystem.exit(1);\n\t\t}\n\t}\n}\n";

    if { ([file exists $::JavaSubClassFile] == 0) || ($::UpdateJavaByteCodeP)} {
	if {[catch {open $::JavaSubFile "w"} JavaHandle ] != 0} {
	    error [format [_ "Unable to open %s"] $::JavaSubFile];
	}
	puts $JavaHandle $cmd;
	close $JavaHandle;
	# Byte compile the java source
	if { [catch {tk_exec javac $::JavaSubFile}] != 0} {
	    if {$TestingFeaturesP} {
		if {$FeatureTestLogHandle != ""} {
		    puts $FeatureTestLogHandle [format "\t%s" [_ "Java compilation failed."]];
		}
	    } else {
		ShowMessage [_ "Java compilation failed."];
	    }
	    error [_ "Java compilation failed."];
	}
	set ::UpdateJavaByteCodeP 0;
    }
    set cl [list java]
    lappend cl "-classpath"
    lappend cl $TempDir
    lappend cl $::JavaSubClassName
    lappend cl "$re"
    lappend cl "$sub"
    lappend cl "<"
    lappend cl $TestFile
    if {[string match $::ExecutionFlag Normal] == 0} {return [list [join $cl] $cmd]}
    set cl [linsert $cl 0 "tk_exec"]
    return [eval $cl]
}

proc ExecuteMatchJavascript {re} {
    global TestFile;
    global CommandFile;

    if {[catch {open $CommandFile "w"} CommandHandle ] != 0} {
	ShowMessage [format [_ "Unable to open file %s."] $CommandFile];
	error "";
    }
    set cmd "var re = new RegExp (\"$re\");\nwhile (!System.stdin.eof()){\n\tline=System.stdin.readln();\n\tif(re.test (line)){\n\t\tSystem.stdout.write(line);\n\t\tSystem.stdout.write(\"\\n\");\n\t}\n}\nSystem.exit(0);";
    puts $CommandHandle $cmd;
    close $CommandHandle;
    set cl [list js]
    lappend cl $CommandFile
    lappend cl "<"
    lappend cl $TestFile
    if {[string match $::ExecutionFlag Normal] == 0} {return [list [join $cl] $cmd]}
    set cl [linsert $cl 0 "tk_exec"]
    return [eval $cl]
}

proc ExecuteSubJavascript {re sub} {
    global TestFile;
    global CommandFile;

    if { [catch {open $CommandFile "w"} CommandHandle] != 0} {
	ShowMessage [format [_ "Unable to open file %s."] $CommandFile];
	error "";
    }
    set cmd "while (!System.stdin.eof()){\n\tvar line=System.stdin.readln();\n\tSystem.stdout.write(line.replace(\/$re\/,\"$sub\"));\n\t\tSystem.stdout.write(\"\\n\");\n\t}\nSystem.exit(0);";
    puts $CommandHandle $cmd;
    close $CommandHandle;
    set cl [list js]
    lappend cl $CommandFile
    lappend cl "<"
    lappend cl $TestFile
    if {[string match $::ExecutionFlag Normal] == 0} {return [list [join $cl] $cmd]}
    set cl [linsert $cl 0 "tk_exec"]
    return [eval $cl]
}

proc ExecuteMatchJgrep {re} {
    global TestFile;
    set cl [list jgrep]

    if {$::ProgramInfo(jgrep,CaseInsensitiveP)} {
	lappend cl -i
    }
    lappend cl $re
    lappend cl $TestFile
    if {[string match $::ExecutionFlag Normal] == 0} {return [list [join $cl]]}
    set cl [linsert $cl 0 "tk_exec"]
    #Jgrep insists on generating a line with the filename before the
    #results so we strip the first line.
    set rval [eval $cl];
    return [string range $rval [expr [string first "\n" $rval] + 1] end]
}

proc ExecuteMatchJudoscript {re} {
    global TestFile;
    global CommandFile;

    if {[catch {open $CommandFile "w"} CommandHandle ] != 0} {
	ShowMessage [format [_ "Unable to open file %s."] $CommandFile];
	error "";
    }
    set cmd "while (line=readLine()) != eof {\n\tif (line.matches(\'$re\')) println line;\n}\n";
    puts $CommandHandle $cmd;
    close $CommandHandle;
    set cl [list java]
    lappend cl -jar
    lappend cl judo.jar
    lappend cl "-q"
    lappend cl $CommandFile
    lappend cl "<"
    lappend cl $TestFile
    if {[string match $::ExecutionFlag Normal] == 0} {return [list [join $cl] $cmd]}
    set cl [linsert $cl 0 "tk_exec"]
    return [eval $cl]
}

proc ExecuteSubJudoscript {re sub} {
    global TestFile;
    global CommandFile;

    if { [catch {open $CommandFile "w"} CommandHandle] != 0} {
	ShowMessage [format [_ "Unable to open file %s."] $CommandFile];
	error "";
    }
    set cmd "while (line=readLine()) != eof {\n\tprintln line.replaceAll(\'$re\',\'$sub\');\n}\n";
    puts $CommandHandle $cmd;
    close $CommandHandle;
    set cl [list java]
    lappend cl -jar
    lappend cl judo.jar
    lappend cl "-q"
    lappend cl $CommandFile
    lappend cl "<"
    lappend cl $TestFile
    if {[string match $::ExecutionFlag Normal] == 0} {return [list [join $cl]]}
    set cl [linsert $cl 0 "tk_exec"]
    return [eval $cl]
}

proc ExecuteMatchKsh {re} {
    global ShellItemLimit;
    global TestFile;
    global TempGlobDir;

    #Read test data back in, storing in array, one line at a time;
    if {[catch {open $TestFile "r"} TempDataHandle ] != 0} {
	ShowMessage [format [_ "Unable to read test data back in from %s."] $TestFile];
	error "ExecuteMatchKsh";
    }
    set LineCount 0
    while { [gets $TempDataHandle line] > 0} {
	incr LineCount;
	set TestLines($LineCount) $line
    }
    close $TempDataHandle;

    if {$LineCount >= $ShellItemLimit} {
	ShowMessage [format [_ "%1\$d items exceeds limit of %2\$d  for shells."] $LineCount $ShellItemLimit]
	#Delay so that user will get a chance to read above message.
	after 1000;
	error [format "ExecuteMatchKsh: %s" [_ "item limit exceeded"]];
    } 

    #Clean out this directory if it already exists. 
    file delete -force $TempGlobDir;
    file mkdir $TempGlobDir;
    for {set i 1} {$i <= $LineCount} {incr i} {
	set NewFile [file join $TempGlobDir $TestLines($i)];
	if {[catch {open  $NewFile "w"} TempDataHandle] != 0} { 
	    WriteJournal [format [_ "Unable to open file %s."] $NewFile];
	    continue ;
	} else {
	    puts $TempDataHandle "x";
	    close $TempDataHandle;
	}
    }
    set cl [list ksh]
    lappend cl "-c"
    regsub -all ";" $re "\\;" qre
    lappend cl "cd $TempGlobDir;ls $qre"
    if {[string match $::ExecutionFlag Normal] == 0} {return [list [join $cl]]}
    set cl [linsert $cl 0 "tk_exec"]
    return [eval $cl]
}

proc ExecuteMatchLua {re} {
    global TestFile;
    global CommandFile;

    if {[catch {open $CommandFile "w"} CommandHandle ] != 0} {
	ShowMessage [format [_ "Unable to open file %s."] $CommandFile];
	error "";
    }
    set cmd "while true do\n\tlocal dline = io.read(\"*line\")\n\tif dline == nil then break end\n\ti = string.find(dline,\"$re\")\n\tif i ~= nil then print(dline) end\nend\n";
    puts $CommandHandle $cmd;
    close $CommandHandle;
    set cl [list lua]
    lappend cl $CommandFile
    lappend cl "<"
    lappend cl $TestFile
    if {[string match $::ExecutionFlag Normal] == 0} {return [list [join $cl] $cmd]}
    set cl [linsert $cl 0 "tk_exec"]
    return [eval $cl]
}

proc ExecuteSubLua {re sub} {
    global TestFile;
    global CommandFile;

    if {[catch {open $CommandFile "w"} CommandHandle ] != 0} {
	ShowMessage [format [_ "Unable to open file %s."] $CommandFile];
	error "";
    }
    set cmd "while true do\n\tlocal dline = io.read(\"*line\")\n\tif dline == nil then break end\n\tresult, cnt = string.gsub(dline,\"$re\",\"$sub\");\n\tprint(result)\n\tend\n";
    puts $CommandHandle $cmd;
    close $CommandHandle; 
    set cl [list lua]
    lappend cl $CommandFile
    lappend cl "<"
    lappend cl $TestFile
    if {[string match $::ExecutionFlag Normal] == 0} {return [list [join $cl] $cmd]}
    set cl [linsert $cl 0 "tk_exec"]
    return [eval $cl]
}

proc ExecuteMatchMawk {re} {
    global TestFile;
    global CommandFile;

    if {[catch {open $CommandFile "w"} CommandHandle ] != 0} {
	ShowMessage [format [_ "Unable to open file %s."] $CommandFile];
	error "";
    }
    set cmd "\$0 ~ /$re/ {print \$0}"
    puts $CommandHandle $cmd;
    close $CommandHandle; 
    set cl [list mawk]
    lappend cl "-f"
    lappend cl $CommandFile
    lappend cl "<"
    lappend cl $TestFile
    if {[string match $::ExecutionFlag Normal] == 0} {return [list [join $cl] $cmd]}
    set cl [linsert $cl 0 "tk_exec"]
    return [eval $cl]
}

proc ExecuteSubMawk {re sub} {
    global TestFile;
    global CommandFile;

    if {[catch {open $CommandFile "w"} CommandHandle ] != 0} {
	ShowMessage [format [_ "Unable to open file %s."] $CommandFile];
	error "";
    }
    set cmd [format "\{gsub(/%s/,\"%s\");print\}" $re $sub];
    puts $CommandHandle $cmd;
    close $CommandHandle; 
    set cl [list mawk]
    lappend cl "-f"
    lappend cl $CommandFile
    lappend cl "<"
    lappend cl $TestFile
    if {[string match $::ExecutionFlag Normal] == 0} {return [list [join $cl] $cmd]}
    set cl [linsert $cl 0 "tk_exec"]
    return [eval $cl]
}

proc ExecuteMatchNawk {re} {
    global TestFile;
    global CommandFile;

    if {[catch {open $CommandFile "w"} CommandHandle ] != 0} {
	ShowMessage [format [_ "Unable to open file %s."] $CommandFile];
	error "";
    }
    set cmd "\$0 ~ /$re/ {print \$0}"
    puts $CommandHandle $cmd;
    close $CommandHandle; 
    set cl [list nawk]
    lappend cl "-f"
    lappend cl $CommandFile
    lappend cl "<"
    lappend cl $TestFile
    if {[string match $::ExecutionFlag Normal] == 0} {return [list [join $cl] $cmd]}
    set cl [linsert $cl 0 "tk_exec"]
    return [eval $cl]
}

proc ExecuteSubNawk {re sub} {
    global TestFile;
    global CommandFile;

    if {[catch {open $CommandFile "w"} CommandHandle ] != 0} {
	ShowMessage [format [_ "Unable to open file %s."] $CommandFile];
	error "";
    }
    set cmd [format "\{gsub(/%s/,\"%s\");print\}" $re $sub];
    puts $CommandHandle 
    close $CommandHandle; 
    set cl [list nawk]
    lappend cl "-f"
    lappend cl $CommandFile
    lappend cl "<"
    lappend cl $TestFile
    if {[string match $::ExecutionFlag Normal] == 0} {return [list [join $cl] $cmd]}
    set cl [linsert $cl 0 "tk_exec"]
    return [eval $cl]
}

proc ExecuteMatchNrgrep {re} {
    global TestFile;
    set cl [list nrgrep]

    if {$::ProgramInfo(nrgrep,CaseInsensitiveP)} {
	lappend cl -i
    }
    if {$::ProgramInfo(nrgrep,ComplementP)} {
	lappend cl -v
    }
    if {$::ProgramInfo(nrgrep,TotalCost) > 0} {
	set cs $::ProgramInfo(nrgrep,TotalCost)
	set OptSet 0;
	if {$::ProgramInfo(nrgrep,InsertionsP)} {
	    append cs i
	    set OptSet 1;
	}
	if {$::ProgramInfo(nrgrep,DeletionsP)} {
	    append cs d
	    set OptSet 1;
	}
	if {$::ProgramInfo(nrgrep,SubstitutionsP)} {
	    append cs s
	    set OptSet 1;
	}
	if {$::ProgramInfo(nrgrep,TranspositionsP)} {
	    append cs t
	    set OptSet 1;
	}
	if {$OptSet} {
	    lappend cl "-k"
	    lappend cl $cs
	}
    }
    lappend cl $re
    lappend cl $TestFile
    if {[string match $::ExecutionFlag Normal] == 0} {return [list [join $cl]]}
    set cl [linsert $cl 0 "tk_exec"]
    return [eval $cl];
}

proc ExecuteMatchPerl {re} {
    global TestFile;
    global CommandFile;

    if {$::ProgramInfo(perl,UnicodeLocaleDependentP)} {
	set flags "-C";
    } else {
	set flags "-CSD";
    }
    if {[catch {open $CommandFile "w"} CommandHandle ] != 0} {
	ShowMessage [format [_ "Unable to open file %s."] $CommandFile];
	error "";
    }
    set cmd "use utf8;\nuse charnames \":full\";\nwhile (\$line = <STDIN>){\n\t\$copy=\$line;\n\tchomp(\$copy);\n\tif(\$copy  =~ /$re/) {\n\t\tprint \$line\n\t}\n}";
    puts $CommandHandle $cmd;
    close $CommandHandle;
    set cl [list perl]
    lappend cl $flags
    lappend cl $CommandFile
    lappend cl "<"
    lappend cl $TestFile
    if {[string match $::ExecutionFlag Normal] == 0} {return [list [join $cl] $cmd]}
    set cl [linsert $cl 0 "tk_exec"]
    return [eval $cl]
}

proc ExecuteSubPerl {re sub} {
    global TestFile;
    global CommandFile;

    if {$::ProgramInfo(perl,UnicodeLocaleDependentP)} {
	set flags "-C";
    } else {
	set flags "-CSD";
    }
    if {[catch {open $CommandFile "w"} CommandHandle ] != 0} {
	ShowMessage [format [_ "Unable to open file %s."] $CommandFile];
	error "";
    }
    set cmd "use utf8;\nuse charnames \":full\";\nwhile (\$line = <STDIN>){\n\t\$copy=\$line;\n\tchomp(\$copy);\n\t\$_=\$copy;\n\ts/$re/$sub/;\n\tprint \$_ ;\nprint \"\\n\"\n}\n";
    puts $CommandHandle $cmd;
    close $CommandHandle;
    set cl [list perl]
    lappend cl $flags
    lappend cl $CommandFile
    lappend cl "<"
    lappend cl $TestFile
    if {[string match $::ExecutionFlag Normal] == 0} {return [list [join $cl] $cmd]}
    set cl [linsert $cl 0 "tk_exec"]
    return [eval $cl]
}

proc ExecuteMatchPhp {re} {
    global TestFile;
    global CommandFile;
    global PHPPCRE;
    global PHPMB;

    set Prelude "";
    if {$PHPPCRE} {
	set PHPfunc "preg_match";
    } else {
	if {$PHPMB} {
	    set PHPfunc "mb_ereg";
	    set Prelude "mb_regex_encoding('UTF-8');";
	} else {
	    set PHPfunc "ereg";
	}
    }
    if {[catch {open $CommandFile "w"} CommandHandle ] != 0} {
	ShowMessage [format [_ "Unable to open file %s."] $CommandFile];
	error "";
    }
    set cmd [format "<?php %s\n\$fd = fopen(\"%s\",\"r\");\nwhile(!feof(\$fd)){\n\t\$line = trim(fgets(\$fd,256));\n\tif (%s('%s', \$line)){\n\t\tprintf('%%s\n',\$line);\n\t}\n}\nfclose(\$fd);?>" $Prelude $TestFile $PHPfunc $re];
    puts $CommandHandle $cmd;
    close $CommandHandle;
    set cl [list php]
    lappend cl "-f"
    lappend cl $CommandFile
    if {[string match $::ExecutionFlag Normal] == 0} {return [list [join $cl] $cmd]}
    set cl [linsert $cl 0 "tk_exec"]
    return [eval $cl]
}

proc ExecuteSubPhp {re sub} {
    global TestFile;
    global CommandFile;
    global PHPPCRE;
    global PHPMB;

    if {$PHPPCRE} {
	set PHPfunc "preg_replace";
    } else {
	if {$PHPMB} {
	    set PHPfunc "mb_ereg_replace";
	    set Prelude "mb_regex_encoding('UTF-8');";
	} else {
	    set PHPfunc "ereg_replace";
	    set Prelude "";
	}
    }

    if {[catch {open $CommandFile "w"} CommandHandle ] != 0} {
	ShowMessage [format [_ "Unable to open file %s."] $CommandFile];
	error "";
    }
    set cmd [format "<?php %s\n\$fd = fopen(\"%s\",\"r\");\nwhile(!feof(\$fd)){\n\t\$line = trim(fgets(\$fd,256));\n\t\tprintf('%%s\n',%s('%s','%s',\$line));\n}\nfclose(\$fd);?>" $Prelude $TestFile $PHPfunc $re $sub];
    puts $CommandHandle 
    close $CommandHandle;
    set cl [list php]
    lappend cl "-f"
    lappend cl $CommandFile
    if {[string match $::ExecutionFlag Normal] == 0} {return [list [join $cl] $cmd]}
    set cl [linsert $cl 0 "tk_exec"]
    return [eval $cl]
}

proc ExecuteMatchPike {re} {
    global TestFile;
    global CommandFile;

    if {[catch {open $CommandFile "w"} CommandHandle ] != 0} {
	ShowMessage [format [_ "Unable to open file %s."] $CommandFile];
	error "";
    }
    set cmd "\#charset UTF-8\nint main()\n{\n\tstring iline;\n\tstring line;\n\tRegexp.PCRE.Plain myre;\n\tmyre = Regexp.PCRE.Plain(\"$re\");\n\twhile ( (iline = Stdio.stdin.gets()) != 0 ){\n\t\tline = utf8_to_string(iline);\n\t\tif (myre->match(line)) write(\"%s\\n\",string_to_utf8(line));\n\t}\n\treturn 0;\n}\n";
    puts $CommandHandle $cmd;
    close $CommandHandle; 
    set cl [list pike]
    lappend cl $CommandFile
    lappend cl "<"
    lappend cl $TestFile
    if {[string match $::ExecutionFlag Normal] == 0} {return [list [join $cl] $cmd]}
    set cl [linsert $cl 0 "tk_exec"]
    return [eval $cl]
}

proc ExecuteSubPike {re sub} {
    global TestFile;
    global CommandFile;

    if {[catch {open $CommandFile "w"} CommandHandle ] != 0} {
	ShowMessage [format [_ "Unable to open file %s."] $CommandFile];
	error "";
    }
    set cmd "\#charset UTF-8\nint main()\n{\n\tstring iline;\n\tstring line;\n\tRegexp.PCRE.Plain myre;\n\tmyre = Regexp.PCRE.Plain(\"$re\");\n\twhile ( (iline = Stdio.stdin.gets()) != 0 ){\n\t\tline = utf8_to_string(iline);\n\t\twrite(\"%s\\n\",string_to_utf8(myre->replace(line,\"$sub\")));\n\t}\n\treturn 0;\n}\n";
    puts $CommandHandle $cmd;
    close $CommandHandle; 
    set cl [list pike]
    lappend cl $CommandFile
    lappend cl "<"
    lappend cl $TestFile
    if {[string match $::ExecutionFlag Normal] == 0} {return [list [join $cl] $cmd]}
    set cl [linsert $cl 0 "tk_exec"]
    return [eval $cl]
}

proc ExecuteMatchPython {re} {
    global CommandFile;
    global TestFile;

    if {$::ProgramInfo(python,RawStringP)} {
	set Prefix "ur";
    } else {
	set Prefix "u";
    }
    if {[catch {open $CommandFile "w"} CommandHandle ] != 0} {
	ShowMessage [format [_ "Unable to open file %s."] $CommandFile];
	error "";
    }
    set cmd [format "# -*- coding: UTF-8 -*-\nimport sys\nimport codecs\nfrom re import *\n(utf8_encode, utf8_decode, utf8_reader, utf8_writer) = codecs.lookup('utf-8')\noutfile = utf8_writer(sys.stdout)\ninfile=utf8_reader(open('%s','r'))\nr = compile(%s'%s')\nwhile (1):\n\ttry:\n\t\tline = infile.readline()\n\t\tif line == \"\":\n\t\t\tbreak\n\t\ttline=line.rstrip(\"\\n\")\n\t\tmo=r.match(tline)\n\t\tif mo:\n\t\t\toutfile.write(line)\n\texcept IOError:\n\t\tsys.exit(0)\n\texcept ValueError:\n\t\tsys.stderr.write(\"Invalid UTF-8 encountered.\")\n\t\tsys.exit(1)\n" $TestFile $Prefix $re]
    puts $CommandHandle $cmd;
    close $CommandHandle;
    set cl [list python]
    lappend cl $CommandFile
    if {[string match $::ExecutionFlag Normal] == 0} {return [list [join $cl] $cmd]}
    set cl [linsert $cl 0 "tk_exec"]
    return [eval $cl]
}

proc ExecuteSubPython {re sub} {
    global CommandFile;
    global TestFile;
    if {$::ProgramInfo(python,RawStringP)} {
	set Prefix "ur";
    } else {
	set Prefix "u";
    }
    if {[catch {open $CommandFile "w"} CommandHandle ] != 0} {
	ShowMessage [format [_ "Unable to open file %s."] $CommandFile];
	error "";
    }
    set cmd [format "# -*- coding: UTF-8 -*-\nimport sys\nimport codecs\nfrom re import *\n(utf8_encode, utf8_decode, utf8_reader, utf8_writer) = codecs.lookup('utf-8')\noutfile = utf8_writer(sys.stdout)\ninfile=utf8_reader(open('%s','r'))\nr = compile(%s'%s')\nwhile (1):\n\ttry:\n\t\tline = infile.readline().rstrip(\"\\n\")\n\t\tif line == \"\":\n\t\t\tbreak\n\t\toutfile.write(r.sub(%s'%s',line))\n\t\toutfile.write('\\n')\n\texcept IOError:\n\t\tsys.exit(0)\n\texcept ValueError:\n\t\tsys.stderr.write(\"Invalid UTF-8 encountered.\")\n\t\tsys.exit(1)\n" $TestFile $Prefix $re $Prefix $sub]
    puts $CommandHandle $cmd;
    close $CommandHandle;
    set cl [list python]
    lappend cl $CommandFile
    if {[string match $::ExecutionFlag Normal] == 0} {return [list [join $cl] $cmd]}
    set cl [linsert $cl 0 "tk_exec"]
    return [eval $cl]
}

# This procedure is a bit unusual in that we redirect stderr into a temp file
# from within Rc and then check whether this file is empty. The reason for this
# is that if Rc is given a command like: "ls (?e)foo" (as in the test for the ?e flag)
# it parses this as equivalent to: "ls ?e foo". Since there is no file named "?e"
# it generates a message to that effect on stderr. It then procedes to list "foo"
# on stdout. Inspection of stdout will therefore make it look like the test succeeded.
# One would think that we would detect the error because writing on stderr would cause
# the catch (in ExecuteRegexp) to return a non-zero status, but Rc seems to suppress
# undiverted output to stderr when executed non-interactively. I don't find anything
# to this effect in the manual, but my tests seem to show that this is what it is
# doing. I have therefore used the kludge described above as a way to find out whether
# Rc detected an error.
proc ExecuteMatchRc {re} {
    global ShellItemLimit;
    global TestFile;
    global TempGlobDir;
    global CommandFile;

    #Read test data back in, storing in array, one line at a time;
    if {[catch {open $TestFile "r"} TempDataHandle ] != 0} {
	ShowMessage [format [_ "Unable to read test data back in from %s."] $TestFile];
	error "ExecuteMatchRc";
    }
    set LineCount 0
    while { [gets $TempDataHandle line] > 0} {
	incr LineCount;
	set TestLines($LineCount) $line
    }
    close $TempDataHandle;

    if {$LineCount >= $ShellItemLimit} {
	ShowMessage [format [_ "%1\$d items exceeds limit of %2\$d  for shells."] $LineCount $ShellItemLimit]
	#Delay so that user will get a chance to read above message.
	after 1000;
	error [format "ExecuteMatchRc: %s" [_ "item limit exceeded"]];
    } 

    #Clean out this directory if it already exists. 
    file delete -force $TempGlobDir;
    file mkdir $TempGlobDir;
    for {set i 1} {$i <= $LineCount} {incr i} {
	set NewFile [file join $TempGlobDir $TestLines($i)];
	if {[catch {open  $NewFile "w"} TempDataHandle] != 0} { 
	    WriteJournal [format [_ "Unable to open file %s."] $NewFile];
	    continue ;
	} else {
	    puts $TempDataHandle "x";
	    close $TempDataHandle;
	}
    }
    if {[catch {open $CommandFile "w"} CommandHandle ] != 0} {
	ShowMessage [format [_ "Unable to open file %s."] $CommandFile];
	error "";
    }
    set TempErrorLog [file join $::TempDir "rcerror.log"]
    file delete -force $TempErrorLog
    set cmd "cd $TempGlobDir;ls $re >\[2\] $TempErrorLog"
    puts $CommandHandle $cmd;
    close $CommandHandle;

    set cl [list rc]
    lappend cl "-s"
    lappend cl "<"
    lappend cl $CommandFile
    if {[string match $::ExecutionFlag Normal] == 0} {return [list [join $cl]]}
    set cl [linsert $cl 0 "tk_exec"]
    set rval [eval $cl]
    if {[file exists $TempErrorLog]} {
	if {[file size $TempErrorLog]} {
	    error ""
	}
    }
    return $rval
}

proc ExecuteMatchRebol {re} {
    global TestFile;
    global CommandFile;

    if {[catch {open $CommandFile "w"} CommandHandle ] != 0} {
	ShowMessage [format [_ "Unable to open file %s."] $CommandFile];
	error "";
    }
    set cmd "REBOL \[\n\tTitle: \"Script created by redet.\"\n\]\ndigit: charset \[\#\"0\" - \#\"9\"\]\nlower: charset \[\#\"a\" - \#\"z\"\]\nupper: charset \[\#\"A\" - \#\"Z\"\]\nalpha: union lower upper\nalnum: union alpha digit\nhexlet: charset \"AaBbCcDdEeFf\"\nxdigit: union digit hexlet\nwhile \[line: input\] \[\n\tif parse/all line \[$re\] \[\n\t\tprint line\n\t]\n\]\nquit\n";
    puts $CommandHandle $cmd;
    close $CommandHandle;
    set cl [list rebol]
    lappend cl -q
    lappend cl -w
    lappend cl $CommandFile
    lappend cl "<"
    lappend cl $TestFile
    if {[string match $::ExecutionFlag Normal] == 0} {return [list [join $cl] $cmd]}
    set cl [linsert $cl 0 "tk_exec"]
    return [eval $cl]
}

proc ExecuteMatchRuby {re} {
    global TestFile;
    global CommandFile;

    if {[catch {open $CommandFile "w"} CommandHandle ] != 0} {
	ShowMessage [format [_ "Unable to open file %s."] $CommandFile];
	error "";
    }
    set cmd "while line = STDIN.gets\n\tif  /$re/ =~ line then\n\t\tprint line\n\tend\nend\n";
    puts $CommandHandle $cmd;
    close $CommandHandle; 
    set cl [list ruby]
    lappend cl $CommandFile
    lappend cl "<"
    lappend cl $TestFile
    if {[string match $::ExecutionFlag Normal] == 0} {return [list [join $cl] $cmd]}
    set cl [linsert $cl 0 "tk_exec"]
    return [eval $cl]
}

proc ExecuteSubRuby {re sub} {
    global TestFile;
    global CommandFile;

    if {[catch {open $CommandFile "w"} CommandHandle ] != 0} {
	ShowMessage [format [_ "Unable to open file %s."] $CommandFile];
	error "";
    }
    set cmd [format "while line = STDIN.gets.chomp\n\tprint (line.gsub(/%s/,%%q%s%s%s),\"\\n\")\nend\n" $re $::LeftRubyStringDelimiter $sub $::RightRubyStringDelimiter];
    puts $CommandHandle $cmd;
    close $CommandHandle; 
    set cl [list ruby]
    lappend cl $CommandFile
    lappend cl "<"
    lappend cl $TestFile
    if {[string match $::ExecutionFlag Normal] == 0} {return [list [join $cl] $cmd]}
    set cl [linsert $cl 0 "tk_exec"]
    return [eval $cl]
}

proc ExecuteMatchSed {re} {
    global TestFile;
    global CommandFile;
    if {[catch {open $CommandFile "w"} CommandHandle ] != 0} {
	ShowMessage [format [_ "Unable to open file %s."] $CommandFile];
	error "";
    }
    set cmd "/$re/p"
    puts $CommandHandle $cmd;
    close $CommandHandle;

    #The -n flag is necessary since autoprinting results in double output.
    set cl [list sed -n]
    if {$::ProgramInfo(sed,ExtendedRegexp)} {
	lappend cl "-r"
    }
    lappend cl "-f"
    lappend cl "$CommandFile"
    lappend cl "<"
    lappend cl $TestFile
    if {[string match $::ExecutionFlag Normal] == 0} {return [list [join $cl] $cmd]}
    set cl [linsert $cl 0 "tk_exec"]
    return [eval $cl]
}

proc ExecuteSubSed {re sub} {
    global TestFile;
    global CommandFile;

    if {[catch {open $CommandFile "w"} CommandHandle ] != 0} {
	ShowMessage [format [_ "Unable to open file %s."] $CommandFile];
	error "";
    }
    set cl [list sed]
    if {$::OutputOnlyChangedLinesP} {
	set cmd "s/$re/$sub/gp"
	puts $CommandHandle $cmd;
	lappend cl "-n"
    } else {
	set cmd "s/$re/$sub/g"
	puts $CommandHandle $cmd;
    }
    close $CommandHandle;
    if {$::ProgramInfo(sed,ExtendedRegexp)} {
	lappend cl "-r"
    }
    lappend cl "-f"
    lappend cl "$CommandFile"
    lappend cl "<"
    lappend cl $TestFile
    if {[string match $::ExecutionFlag Normal] == 0} {return [list [join $cl] $cmd]}
    set cl [linsert $cl 0 "tk_exec"]
    return [eval $cl]
}

proc ExecuteMatchSleep {re} {
    global TestFile;
    global CommandFile;

    if {[catch {open $CommandFile "w"} CommandHandle ] != 0} {
	ShowMessage [format [_ "Unable to open file %s."] $CommandFile];
	error "";
    }
    set cmd "\$fh = getConsole();\nwhile (!-eof \$fh) {\n\t\$line = readln(\$fh);\n\tif (\$line ismatch \'$re\') {println (\$line)}\n}\nreturn 0;\n";
    puts $CommandHandle $cmd;
    close $CommandHandle;
    set cl [list java]
    lappend cl "-jar"
    lappend cl sleep.jar
    lappend cl $CommandFile
    lappend cl "<"
    lappend cl $TestFile
    if {[string match $::ExecutionFlag Normal] == 0} {return [list [join $cl] $cmd]}
    set cl [linsert $cl 0 "tk_exec"]
    return [eval $cl]
}

proc ExecuteSubSleep {re sub} {
    global TestFile;
    global CommandFile;

    if {[catch {open $CommandFile "w"} CommandHandle ] != 0} {
	ShowMessage [format [_ "Unable to open file %s."] $CommandFile];
	error "";
    }
    set cmd "\$fh = getConsole();\nwhile (!-eof \$fh) {\n\t\$line = readln(\$fh);\n\tprintln(replace(\$line,\'$re\',\'$sub\'));\n}\n";
    puts $CommandHandle $cmd;
    close $CommandHandle;

    set cl [list java]
    lappend cl "-jar"
    lappend cl sleep.jar
    lappend cl $CommandFile
    lappend cl "<"
    lappend cl $TestFile
    if {[string match $::ExecutionFlag Normal] == 0} {return [list [join $cl] $cmd]}
    set cl [linsert $cl 0 "tk_exec"]
    set res [eval $cl]
    if {[string equal [string range $res end-2 end] "EOF"]} {
	set res [string range $res 0 end-3];
    }
    return $res 
}

proc ExecuteMatchSleepWildcard {re} {
    global TestFile;
    global CommandFile;

    if {[catch {open $CommandFile "w"} CommandHandle ] != 0} {
	ShowMessage [format [_ "Unable to open file %s."] $CommandFile];
	error "";
    }
    set cmd "\$fh = getConsole();\nwhile (!-eof \$fh) {\n\t\$line = readln(\$fh);\n\tif (\'$re\' iswm \$line) {println (\$line)}\n}\nreturn 0;\n";
    puts $CommandHandle $cmd;
    close $CommandHandle;

    set cl [list java]
    lappend cl "-jar"
    lappend cl sleep.jar
    lappend cl $CommandFile
    lappend cl "<"
    lappend cl $TestFile
    if {[string match $::ExecutionFlag Normal] == 0} {return [list [join $cl] $cmd]}
    set cl [linsert $cl 0 "tk_exec"]
    return [eval $cl]
}

proc ExecuteMatchTcl {re} {
    global TestFile;

    set Result "";
    set MatchCnt 0;

    if {[string match $::ExecutionFlag Normal] == 0} {return [list "Executed internally by tcl."] }

    #Read test data back in, storing in list, one line at a time;
    if {[catch {open $TestFile "r"} TempDataHandle ] != 0} {
	ShowMessage [format [_ "Unable to open %s."] $TempDataFile];
	error [_ "ExecuteMatchTcl: cannot open data file"];
    }
    set LineCount 0
    while { [gets $TempDataHandle line] > 0} {
	set line [string trimright $line "\n"];
	incr LineCount;
	lappend TestLines $line;
    }
    close $TempDataHandle;

    #Now run regexp against each line;

    if {$::ProgramInfo(tcl,CaseInsensitiveP)} {
	if {$::ProgramInfo(tcl,ExpandedP)} {
	    for {set i  0} {$i < $LineCount} {incr i} {
		if {[regexp -nocase -expanded -- $re [lindex $TestLines $i]] == 1}  {
		    append Result [lindex $TestLines $i];
		    append Result "\n";
		    incr MatchCnt;
		}
	    }
	} else {
	    for {set i  0} {$i < $LineCount} {incr i} {
		if {[regexp -nocase -- $re [lindex $TestLines $i]] == 1}  {
		    append Result [lindex $TestLines $i];
		    append Result "\n";
		    incr MatchCnt;
		}
	    }
	}
    } else {
	if {$::ProgramInfo(tcl,ExpandedP)} {
	    for {set i  0} {$i < $LineCount} {incr i} {
		if {[regexp -expanded -- $re [lindex $TestLines $i]] == 1}  {
		    append Result [lindex $TestLines $i];
		    append Result "\n";
		    incr MatchCnt;
		}
	    }
	} else {
	    for {set i 0} {$i < $LineCount} {incr i} {
		if {[regexp -- $re [lindex $TestLines $i]] == 1}  {
		    append Result [lindex $TestLines $i];
		    append Result "\n";
		    incr MatchCnt;
		}
	    }
	}
    }
 

    #If there are no matches, we throw an exception here so as to match
    #the result of executing a child process as we do for the other programs.
    #The exception will be caught by catch() in ExecuteMatchRegexp().
    if {[string equal $Result ""]} {
	error "";
    }
    return [string trimright $Result "\n"];
}

proc ExecuteSubTcl {re sub} {
    global TestFile;

    set Result "";
    set MatchCnt 0;

    if {[string match $::ExecutionFlag Normal] == 0} {return [list "Executed internally by tcl."] }

    #Read test data back in, storing in list, one line at a time;
    if {[catch {open $TestFile "r"} TempDataHandle ] != 0} {
	ShowMessage [format [_ "Unable to open %s."] $TempDataFile];
	error [_ "ExecuteSubTcl: cannot open data file"];
    }
    set LineCount 0
    while { [gets $TempDataHandle line] > 0} {
	set line [string trimright $line "\n"];
	incr LineCount;
	lappend TestLines $line;
    }
    close $TempDataHandle;

    #Now run regexp against each line;

    if {$::ProgramInfo(tcl,CaseInsensitiveP)} {
	if {$::ProgramInfo(tcl,ExpandedP)} {
	    for {set i  0} {$i < $LineCount} {incr i} {
		set str [lindex $TestLines $i];
		regsub -nocase -expanded -all -- $re $str $sub subres;
		append Result $subres
		append Result "\n";
		if {[string equal $subres $str] !=0} {incr MatchCnt}
	    }
	} else {
	    for {set i  0} {$i < $LineCount} {incr i} {
		set str [lindex $TestLines $i];
		regsub -nocase -all -- $re $str $sub subres;
		append Result $subres
		append Result "\n";
		if {[string equal $subres $str] !=0} {incr MatchCnt}
	    }
	}
    } else {
	if {$::ProgramInfo(tcl,ExpandedP)} {
	    for {set i  0} {$i < $LineCount} {incr i} {
		set str [lindex $TestLines $i];
		regsub -expanded -all -- $re $str $sub subres;
		append Result $subres
		append Result "\n";
		if {[string equal $subres $str] !=0} {incr MatchCnt}
	    }
	} else {
	    for {set i  0} {$i < $LineCount} {incr i} {
		set str [lindex $TestLines $i];
		regsub -all -- $re $str $sub subres;
		append Result $subres
		append Result "\n";
		if {[string equal $subres $str] !=0} {incr MatchCnt}
	    }
	}
    }
    #If there are no matches, we throw an exception here so as to match
    #the result of executing a child process as we do for the other programs.
    #The exception will be caught by catch() in ExecuteMatchRegexp().
    if {[string equal $Result ""]} {
	error "";
    }
    return [string trimright $Result "\n"];
}

proc ExecuteMatchTclGlob {re} {
    global TestFile;

    set Result "";
    set MatchCnt 0;

    if {[string match $::ExecutionFlag Normal] == 0} {return [list "Executed internally by tcl."] }

    #Read test data back in, storing in list, one line at a time;
    if {[catch {open $TestFile "r"} TempDataHandle ] != 0} {
	ShowMessage [format [_ "Unable to open %s."] $TempDataFile];
	error "";
    }
    set LineCount 0
    while { [gets $TempDataHandle line] > 0} {
	set line [string trimright $line "\n"];
	incr LineCount;
	lappend TestLines $line;
    }
    close $TempDataHandle;

    #Now run regexp against each line;
    for {set i  0} {$i < $LineCount} {incr i} {
	if {[string match $re [lindex $TestLines $i]] == 1}  {
	    append Result [lindex $TestLines $i];
	    append Result "\n";
	    incr MatchCnt;
	}
    }

    #If there are no matches, we throw an exception here so as to match
    #the result of executing a child process as we do for the other programs.
    #The exception will be caught by catch() in ExecuteRegexp().
    if {[string equal $Result ""]} {
	error "";
    }
    return [string trimright $Result "\n"];
}

proc ExecuteMatchTcsh {re} {
    global ShellItemLimit;
    global TempGlobDir;
    global TestFile;

    #Read test data back in, storing in array, one line at a time;
    if {[catch {open $TestFile "r"} TempDataHandle ] != 0} {
	ShowMessage [format [_ "Unable to read test data back in from %s."] $TestFile];
	error "ExecuteMatchTcsh";
    }
    set LineCount 0;
    while { [gets $TempDataHandle line] > 0} {
	incr LineCount
	set TestLines($LineCount) $line
    }
    close $TempDataHandle;

    if {$LineCount > $ShellItemLimit} {
	ShowMessage [format [_ "%1\$d items exceeds limit of %2\$d  for shells."] $LineCount $ShellItemLimit];
	puts [format "%d items exceeds limit of %d  for shells." $LineCount $ShellItemLimit]
	#Delay so that user will get a chance to read above message. 
	after 5000;
	error [format "ExecuteMatchTcsh: %s" [_ "item limit exceeded"]];
    } 

    #Clean out this directory if it already exists. 
    file delete -force $TempGlobDir;
    file mkdir $TempGlobDir;
    for {set i 1} {$i <= $LineCount} {incr i} {
	set NewFile [file join $TempGlobDir $TestLines($i)];
	if {[catch {open  $NewFile "w"} TempDataHandle] != 0} { 
	    WriteJournal [format [_ "Unable to open file %s."] $NewFile];
	    continue ;
	} else {
	    puts $TempDataHandle "x";
	    close $TempDataHandle;
	}
	#I don't know why the following doesn't work, but it doesn't.
#	file copy -force "/dev/null" $NewFile;
    }
    set cl [list tcsh]
    lappend cl "-c"
    regsub -all ";" $re "\\;" qre
    lappend cl "cd $TempGlobDir;ls $qre"
    if {[string match $::ExecutionFlag Normal] == 0} {return [list [join $cl]]}
    set cl [linsert $cl 0 "tk_exec"]
    return [eval $cl]
}

proc ExecuteSubTr {re sub} {
    global TestFile;
    set cl [list tr]
    if {$::ProgramInfo(tr,Complement)} {
	lappend cl "-c"
    }
    if {$::ProgramInfo(tr,Squeeze)} {
	lappend cl "-s"
    }
    if {$::ProgramInfo(tr,Truncate)} {
	lappend cl "-t"
    }
    lappend cl $re;
    lappend cl $sub;
    lappend cl "<"
    lappend cl $TestFile
    if {[string match $::ExecutionFlag Normal] == 0} {return [list [join $cl]]}
    set cl [linsert $cl 0 "tk_exec"]
    return [eval $cl]
}

#End of the procedures that execute the individual programs.

# Write out the shell script that actually executes emacs.
# This is necessary because emacs writes to a file and we need to get the result
# from stdin.
proc CreateEmacsWrapper {} {
    global EmacsWrapper
    global TestFile;
    global CommandFile;
    global EmacsOutputFile;

    if {[catch {open $EmacsWrapper "w"} EmacsDataHandle ] != 0} {
	ShowMessage [format [_ "Unable to write Emacs wrapper file %s."] $EmacsWrapper];
    }
    puts $EmacsDataHandle [format "emacs -batch -insert %s -l %s -kill >& /dev/null\nemstat=\$?\ncat %s\nexit \$emstat" $TestFile $CommandFile $EmacsOutputFile];
    close $EmacsDataHandle;
}


#Copy a regular expression from the clipboard
#and insert it into the regular expression window

proc LoadRegularExpressionFromClipboard {} {
    set sel "";
    if {[catch {set sel [selection get -selection CLIPBOARD -type UTF8_STRING]}]} {
	ShowMessage [_ "The clipboard is empty."];
	return;
    } else {
	$::REG insert insert $sel;
	ShowMessage [_ "Clipboard contents copied to regular expression window."];
    }
}

#Read a regular expression from a file
#and insert it into the regular expression window

proc LoadRegularExpressionFromFile {} {
    set ReFile [tk_getOpenFile];
    if {$ReFile != ""} {
	if {[catch {open $ReFile "r"} ReHandle ] != 0} {
	    ShowMessage [format [_ "Unable to open regular expression file %s."] [MinimizeFileName $ReFile]];
	    return ;
	}
	if { [gets $ReHandle line] > 0} {
	    $::REG insert insert $line;
	}
	close $ReHandle;
    }
}

proc ClearRegexp {} {
    $::REG  delete 0 end;
    $::SUB delete 0 end;
}

proc ClearInput {} {
    $::IND configure -state normal
    $::IND delete 1.0 end;
    $::IND configure -state disabled
}

proc EditTestInputData {} {
    global InputDataFromWindowP

    $::IND configure -state normal
    set InputDataFromWindowP 1;
    focus -force $::IND;
}


#Copy test data from the clipboard.
proc LoadTestDataFromClipboard {} {
    global InputDataFromWindowP;
    set sel "";

    if {[catch {set sel [selection get -selection CLIPBOARD -type UTF8_STRING]}]} {
	ShowMessage [_ "The clipboard is empty."];
	return;
    }
    $::IND configure -state normal
    $::IND insert insert $sel;
    set InputDataFromWindowP 1;
    $::IND configure -state disabled
    ShowMessage [_ "Loaded test data from clipboard."];
}

proc LoadTestInputData {args} {		# Optional filename argument
    global InData; 
    global InputDataFromWindowP;
    global PipeP;

    if {$PipeP} {
	set new [read stdin];
	set InDataFile [_ "pipe to stdin"];
    } else {
	if {[llength $args] > 0} {
	    set InDataFile [lindex $args 0];
	} else {
	    set InDataFile [tk_getOpenFile];
	}
	if {$InDataFile != ""} {
	    if {[catch {open $InDataFile "r"} InDataHandle ] != 0} {
		ShowMessage [format [_ "Unable to open test input data file %s."] [MinimizeFileName $InDataFile]];
		return;
	    }
	    set new [read $InDataHandle];
	    close $InDataHandle;
	} else {
	    ShowMessage [_ "No file name specified for test data."];
	    return;
	}
    }
    if {$new == ""} {
	ShowMessage [format [_ "Unable to read test input data from file %s."] \
			 [MinimizeFileName $InDataFile]];
	return;
    }
    $::IND configure -state normal
    $::IND insert insert $new;
    set InputDataFromWindowP 1;
    $::IND configure -state disabled
    ShowMessage [format [_ "Loaded test data from %s."] [MinimizeFileName $InDataFile]]
}

proc SaveTestInputData {} {
    global InData;
    global InputDataFromWindowP

    if {$InputDataFromWindowP} {
	set InData [$::IND get 1.0 end];
    }
    if {$InData == ""} {
	ShowMessage [_ "There is no test data to save."];
	return;
    }
    set InputSaveFile [tk_getSaveFile -initialfile [_ "SavedTestData"]];
    if {$InputSaveFile != ""} {
	if {[catch {open $InputSaveFile "w+"} InputSaveHandle ] != 0} {
	    ShowMessage [format [_ "Unable to open file %s to save test data."] [MinimizeFileName $InputSaveFile]];
	    return ;
        }
	puts $InputSaveHandle $InData;
	close $InputSaveHandle;
	ShowMessage [format [_ "Test data saved in %s."] [MinimizeFileName $InputSaveFile]];
    }
}

proc ClearOutput {} {
    $::OUT configure -state normal
    $::OUT delete 1.0 end;
    LockOutput;
}

proc EditOutput {} {
    global OutputFromWindowP;
    $::OUT configure -state normal
    set OutputFromWindowP 1;
    focus -force $::OUT;
}

proc LockOutput {} {
    global OutputFromWindowP;
    $::OUT configure -state disabled;
    set OutputFromWindowP 0;
}

proc ClearOutputComparisonData {} {
    $::COM configure -state normal
    $::COM delete 1.0 end;
    $::COM configure -state disabled
}

proc EditOutputComparisonData {} {
    global ComparisonDataFromWindowP

    $::COM configure -state normal
    set ComparisonDataFromWindowP 1;
    focus -force $::COM;
}

proc LoadOutputComparisonData {} {
    global ComparisonDataFromWindowP;

    set ComparisonDataFile [tk_getOpenFile];
    if {$ComparisonDataFile != ""} {
	if {[catch {open $ComparisonDataFile "r"} ComparisonDataHandle ] != 0} {
	    ShowMessage [format [_ "Unable to open comparison data file %s."] \
			     [MinimizeFileName $ComparisonDataFile]];
	    return;
        }
        set new [read $ComparisonDataHandle];
        if {$new == ""} {
	    ShowMessage [format [_ "Unable to read comparison data from file %s."] \
			     [MinimizeFileName $ComparisonDataFile]];
	    return;
        }
	$::COM configure -state normal
	$::COM insert insert $new;
        close $ComparisonDataHandle;
	set ComparisonputDataFromWindowP 1;
	$::COM configure -state disabled
	ShowMessage [_ "Loaded comparison data."]
    }
}

proc LoadOutputComparisonDataFromClipboard {} {
    global ComparisonDataFromWindowP;
    set sel "";

    if {[catch {set sel [selection get -selection CLIPBOARD -type UTF8_STRING]}]} {
	ShowMessage [_ "The clipboard is empty."];
	return;
    }
    $::COM configure -state normal
    $::COM insert insert $sel;
    set ComparisonputDataFromWindowP 1;
    $::COM configure -state disabled
    ShowMessage [_ "Loaded comparison data from clipboard."]
}

proc SaveOutputComparisonData {} {
    global ComparisonData;
    global ComparisonDataFromWindowP

    if {$ComparisonDataFromWindowP} {
	set ComparisonData [$::COM get 1.0 end];
	set ComparisonData [string trim $ComparisonData]; #Avoid single whitespace
    }
    if {$ComparisonData == ""} {
	ShowMessage [_ "There is no comparison data to save."];
	return;
    }
    set ComparisonSaveFile [tk_getSaveFile -initialfile [_ "SavedComparisonData"]];
    if {$ComparisonSaveFile != ""} {
	if {[catch {open $ComparisonSaveFile "w+"} ComparisonSaveHandle ] != 0} {
	    ShowMessage [format [_ "Unable to open file %s to save comparison data."] \
			     [MinimizeFileName $ComparisonSaveFile]];
	    return;
        }
	puts $ComparisonSaveHandle $ComparisonData;
	close $ComparisonSaveHandle;
	ShowMessage [format [_ "Comparison data saved in %s."] [MinimizeFileName $ComparisonSaveFile]];
    }
}


#Return: -1 on error
#         0 if output and intended are the same
#         1 if output and intended are different

proc RunDiff {AutoP} {
    global DiffResultFile;
    global TempCompFile;
    global TempOutputFile;
    global TempSortFile;
    global ComparisonDataFromWindowP;
    global ComparisonData;
    global RegexpResult;
    global errorCode;
    global GNUDiffP;

    #Get the comparison data from the window if in edit mode
    if {$ComparisonDataFromWindowP} {
	set ComparisonData [$::COM get 1.0 end];
	set ComparisonData [string trim $ComparisonData]; #Avoid single whitespace
    }
    if {$ComparisonData == ""} {
	if {$AutoP == 0} {
	    ShowMessage [_ "No comparison data is available."];
	}
	return -1;
    }

    #Write output data to temporary file.
    #For now just do it all the time, but we can save on i/o and
    #only do it when it isn't already there.
    #Note that we need to sort no matter what so that the diff won't
    #fail due to different ordering.
    if {[catch {open $TempSortFile "w"} TempSortHandle ] != 0} {
	ShowMessage [format [_ "Unable to open temporary sort file %s."] $TempSortFile];
	return -1;
    }
    puts $TempSortHandle $RegexpResult;
    close $TempSortHandle;
    if {[catch {exec sort $TempSortFile > $TempOutputFile} ] != 0} {
	ShowMessage [_ "RunDiff: sort failed"];
	return -1;
    } 

    #Write comparison data to temporary test file
    if {[catch {open $TempSortFile "w"} TempSortHandle ] != 0} {
	ShowMessage [format [_ "Unable to open temporary sort file %s."] $TempSortFile];
	return -1;
    }
    puts $TempSortHandle $ComparisonData;
    close $TempSortHandle;
    if {[catch {exec sort $TempSortFile > $TempCompFile} ] != 0} {
	ShowMessage [_ "RunDiff: sort failed"];
	return -1;
    } 

    #We have to put the output of diff into a file because tcl considers any
    #non-zero exit status to be an error and aborts rather than return the contents
    #of stdout. Therefore, even if there is no real error but diff is merely
    #reporting that there was a difference, because diff returns 1, no output
    #is returned by exec.
    if {$GNUDiffP} {
	if { [catch { exec diff -B --side-by-side --suppress-common-lines $TempOutputFile $TempCompFile > $DiffResultFile} rval]  == 0} {
	    return 0;
	}
    } else {
	if { [catch { exec diff $TempOutputFile $TempCompFile > $DiffResultFile} rval]  == 0} {
	    return 0;
	}
    }

    set ChildError [lindex [split $errorCode] 3];
    if {$ChildError > 1} {
	ShowMessage [_ "Error executing comparison."]
	return -1;
    }
    return 1;
}

proc ShowDiffResult {{AutoP 0}} {
    global DiffPopup;
    global DiffResultFile;

    if {!$::UseDiffP} {
	ShowMessage [_ "Diff is not available."]
	return ;
    }

    set rstat [RunDiff $AutoP];

    if {$rstat == -1} {return $rstat};
    if {$rstat == 0} {
	ShowMessage [_ "Result of executing regexp and comparison data are identical."];
	return $rstat;
    }

    ShowMessage [_ "Result of executing regexp and comparison data are different."];
    #Get text from file and display in pop-up.
    if {[catch {open  $DiffResultFile "r"} DiffResultHandle] != 0} { 
	ShowMessage [format [_ "Unable to open comparison result file %s."] $DiffResultFile];
	error "";
    } else {
	set DiffResults [read $DiffResultHandle];
    }
    if {$DiffResults == ""} {
	ShowMessage [format [_ "Unable to read comparison results from file %s"] $DiffResultFile ];
	return $rstat;
    }
    destroy $DiffPopup;
    set DiffPopup [CreateTextDisplay [_ "Differences between Regexp Output and Comparison Data"] 80 12]
    BindKeys $DiffPopup;
    AppendToTextDisplay $DiffPopup $DiffResults;
    return $rstat;
}

proc CreateTextDisplay {title width height} {
    set bg $::ColorSpecs(TextDisplay,Background)
    set fg $::ColorSpecs(TextDisplay,Foreground)
    set top [new_dialog_create Textdisplay]
    wm title $top $title
    set info [dialog_info $top]
    scrollbar $info.sbar -command "$info.text yview" 
    pack $info.sbar -side right -fill y
    text $info.text -height $height -width $width -font MainFont -wrap word -yscrollcommand "$info.sbar set"  -background $bg -foreground $fg -exportselection 1;
    pack $info.text -side left -expand yes -fill both
    $info.text configure -state disabled
    bind $info.sbar <<B3>> "ScrollbarMoveBigIncrement $info.sbar 0.2 %x %y"
    return $top
}

proc AppendToTextDisplay {top mesg} {
    set info [dialog_info $top]
    $info.text configure -state normal
    $info.text insert end $mesg
    $info.text configure -state disabled
}

set linkNum 0;
proc AppendLinkToTextDisplay {top mesg LinkCode} {
    global linkNum
    set info [dialog_info $top]
    $info.text configure -state normal
    set tag "link[incr linkNum]"
    bind $info.text <ButtonPress> break
    $info.text insert end $mesg [list body $tag]
    $info.text tag configure $tag -foreground red -underline 1
    $info.text tag bind $tag <Enter> \
        "$info.text tag configure $tag -foreground blue"
    $info.text tag bind $tag <Leave> \
        "$info.text tag configure $tag -foreground red"
    $info.text tag bind $tag <ButtonPress> \
        "$LinkCode"
    $info.text configure -state disabled
}

#This is Cameron Laird's procedure
proc launchBrowser url {
    global tcl_platform

    # It *is* generally a mistake to switch on $tcl_platform(os), particularly
    # in comparison to $tcl_platform(platform).  For now, let's just regard it
    # as a stylistic variation subject to debate.
    switch $tcl_platform(os) {
        Darwin {
	    set command [list open $url]
        }
        HP-UX -
        Linux  -
        SunOS {
	    foreach executable {mozilla netscape iexplorer opera lynx
		w3m links galeon konqueror mosaic firefox amaya
		browsex elinks} {
		set executable [auto_execok $executable]
		if [string length $executable] {
		    # Do you want to mess with -remote?  How about other browsers?
		    set command [list $executable $url &]
		    break
		}
	    }
        }
        {Windows 95} -
        {Windows NT} {
	    set command "[auto_execok start] {} [list $url]"
        }
    }
    if [info exists command] {
        if [catch {exec {expand}$command} err] {
	    tk_messageBox -icon error -message "error '$err' with '$command'"
        }
    } else {
        tk_messageBox -icon error -message \
	    "Please tell CL that ($tcl_platform(os), $tcl_platform(platform)) is not yet ready for browsing."
    }
}

proc ShowWebPage {url} {
    global BrowserPIDS;

    if {[string equal $::System MacOSX]} {
	lappend BrowserPIDS [exec osascript -e "\"open location $url\""]
	return 
    }

    set BrowserFound 0;
    foreach Browser $::BrowserList {
	if { [string length [auto_execok $Browser]]} {
	    set BrowserFound 1;
	    break ;
	} else {
	    ShowMessage [format \
	     [_ "The browser %s is not available on this machine or not in your path."]\
		 $Browser];
	}
    }
    if {$BrowserFound} {
	lappend BrowserPIDS [exec $Browser $url &]
    } else {
	ShowMessage [_ "No browser on the browser list was located."]
    }
}

proc WebManual {} {
    global ManualPath;
    global ManualURL;

    if {[file exists $ManualPath] == 0} {
	ShowMessage [format [_ "Manual not found at location %s"] $ManualPath];
	return ;
    }
    ShowWebPage $ManualURL;
}

proc BugReports {} {
    global Version;
    global tcl_platform;

    if {[PopupDown BugReports] ==1} {return}
    set BugReportPopup [CreateTextDisplay [_ "Bug Reports"] 62 21];
    set ::HelpPopups(BugReports) $BugReportPopup;
    BindKeys $BugReportPopup;
    AppendToTextDisplay $BugReportPopup [_ "Report bugs to: billposer@alum.mit.edu.\n"];
    AppendToTextDisplay $BugReportPopup [_ "Please include the following information:\n\n"];
    AppendToTextDisplay $BugReportPopup [_ "  What version of the program are you using?\n"];
    AppendToTextDisplay $BugReportPopup [format [_ "    (This is version %s \[%s\].)\n\n"] $Version [ProgramTimeDateStamp]];
    AppendToTextDisplay $BugReportPopup [_ "  What operating system are you running?.\n"];
    set OS $tcl_platform(os);
    if {$OS == "Linux"} {set OS "GNU/Linux"};
    AppendToTextDisplay $BugReportPopup [format [_ "    (This is %s  %s.)\n\n"] $OS  $tcl_platform(osVersion)];
    AppendToTextDisplay $BugReportPopup [_ "  What window system are you using?.\n"];
    AppendToTextDisplay $BugReportPopup [format [_ "    (This is %s.)\n\n"] $::WindowSystem]
    AppendToTextDisplay $BugReportPopup [_ "  What version of tcl/tk are you using?.\n"];
    AppendToTextDisplay $BugReportPopup [format [_ "    (This is version %s.)\n\n"] [info patchlevel]];
    AppendToTextDisplay $BugReportPopup [_ "If the problem is restricted to a particular program, what program is it and what version is it?\n"];
    AppendToTextDisplay $BugReportPopup [format [_ "  (The current program is %s \[%s\].\n"] [NameProgram] $::ProgramInfo($::program,version)]
    AppendToTextDisplay $BugReportPopup [_ "  The \'This Program\' entry on the Help menu will provide\n  version information for the currently selected program.)\n\n"]
    AppendToTextDisplay $BugReportPopup [_ "Bug reports may be sent in any language that I can read without too much trouble or am trying to learn or improve. These include:\n\n"];
    AppendLinkToTextDisplay $BugReportPopup [_ "\tCatalan"] {ShowWebPage http://www.ethnologue.com/show_language.asp?code=cat};
    AppendToTextDisplay $BugReportPopup "\n";
    AppendLinkToTextDisplay $BugReportPopup [_ "\tDakelh (Carrier)"] {ShowWebPage http://ydli.org}
    AppendToTextDisplay $BugReportPopup "\n";
    AppendLinkToTextDisplay $BugReportPopup [_ "\tDutch"] {ShowWebPage http://www.ethnologue.com/show_language.asp?code=nld};
    AppendToTextDisplay $BugReportPopup "\n";
    AppendLinkToTextDisplay $BugReportPopup [_ "\tEnglish"] {ShowWebPage http://www.ethnologue.com/show_language.asp?code=eng};
    AppendToTextDisplay $BugReportPopup "\n";
    AppendLinkToTextDisplay $BugReportPopup [_ "\tEsperanto"] {ShowWebPage http://www.ethnologue.com/show_language.asp?code=epo};
    AppendToTextDisplay $BugReportPopup "\n";
    AppendLinkToTextDisplay $BugReportPopup [_ "\tFrench"] {ShowWebPage http://www.ethnologue.com/show_language.asp?code=fra};
    AppendToTextDisplay $BugReportPopup "\n";
    AppendLinkToTextDisplay $BugReportPopup [_ "\tGerman"] {ShowWebPage http://www.ethnologue.com/show_language.asp?code=deu};
    AppendToTextDisplay $BugReportPopup "\n";
    AppendLinkToTextDisplay $BugReportPopup [_ "\tItalian"] {ShowWebPage http://www.ethnologue.com/show_language.asp?code=ita};
    AppendToTextDisplay $BugReportPopup "\n";
    AppendLinkToTextDisplay $BugReportPopup [_ "\tJapanese"] {ShowWebPage http://www.ethnologue.com/show_language.asp?code=jpn};
    AppendToTextDisplay $BugReportPopup "\n";
    AppendLinkToTextDisplay $BugReportPopup [_ "\tKazakh"] {ShowWebPage http://www.ethnologue.com/show_language.asp?code=kaz};
    AppendToTextDisplay $BugReportPopup "\n";
    AppendLinkToTextDisplay $BugReportPopup [_ "\tKorean"] {ShowWebPage http://www.ethnologue.com/show_language.asp?code=kor};
    AppendToTextDisplay $BugReportPopup "\n";
    AppendLinkToTextDisplay $BugReportPopup [_ "\tLatin"] {ShowWebPage http://www.ethnologue.com/show_language.asp?code=lat};
    AppendToTextDisplay $BugReportPopup "\n";
    AppendLinkToTextDisplay $BugReportPopup [_ "\tPortuguese"] {ShowWebPage http://www.ethnologue.com/show_language.asp?code=por};
    AppendToTextDisplay $BugReportPopup "\n";
    AppendLinkToTextDisplay $BugReportPopup [_ "\tSpanish"] {ShowWebPage http://www.ethnologue.com/show_language.asp?code=spa};
    AppendToTextDisplay $BugReportPopup "\n";
    AppendLinkToTextDisplay $BugReportPopup [_ "\tTurkish"] {ShowWebPage http://www.ethnologue.com/show_language.asp?code=tur};
    AppendToTextDisplay $BugReportPopup "\n\n";
    AppendToTextDisplay $BugReportPopup [_ "Please note that in many cases although I can understand the language my ability to respond in it may be limited.\n"];
    AppendToTextDisplay $BugReportPopup "\n";
}


set CommandLineOptionsPopup "";
proc CommandLineOptions {} {
    global CommandLineOptionsPopup

    if {[winfo exists $CommandLineOptionsPopup]} {
	raise $CommandLineOptionsPopup;
	return
    }
    set CommandLineOptionsPopup [CreateTextDisplay [_ "Command Line Options"] 60 13];
    BindKeys $CommandLineOptionsPopup;
    AppendToTextDisplay $CommandLineOptionsPopup [_ "Usage: redet \[options\] (<input text file>)\n\n"];
    AppendToTextDisplay $CommandLineOptionsPopup [_ "  -c <filename>   load class definitions from <filename>\n"];
    AppendToTextDisplay $CommandLineOptionsPopup [_ "  -d              set the debug flag\n"];
    AppendToTextDisplay $CommandLineOptionsPopup [_ "  -F <filename>   read a feature list from <filename> >\n"];
    AppendToTextDisplay $CommandLineOptionsPopup [_ "  -f              read input text from standard input\n"];
    AppendToTextDisplay $CommandLineOptionsPopup [_ "  -H              do not read the history file\n"];
    AppendToTextDisplay $CommandLineOptionsPopup [_ "  -h              provide help\n"];
    AppendToTextDisplay $CommandLineOptionsPopup [_ "  -i              do not read the init file\n"];
    AppendToTextDisplay $CommandLineOptionsPopup [_ "  -l <locale>     set the locale to <locale>\n"];
    AppendToTextDisplay $CommandLineOptionsPopup [_ "  -n              disable feature testing\n"];
    AppendToTextDisplay $CommandLineOptionsPopup [_ "  -o              use deprecated old style init files\n"];
    AppendToTextDisplay $CommandLineOptionsPopup [_ "  -p <program>    set the program to <program>\n"];
    AppendToTextDisplay $CommandLineOptionsPopup [_ "  -s              start up in substitution mode\n"];
    AppendToTextDisplay $CommandLineOptionsPopup [_ "  -t              enable feature test debugging\n"];
    AppendToTextDisplay $CommandLineOptionsPopup [_ "  -v              identify version"];
}


proc About {} {
    global Version;
    if {[PopupDown About] ==1} {return}
    set AboutPopup [CreateTextDisplay [_ "About This Program"] 72 12]
    set ::HelpPopups(About) $AboutPopup;
    BindKeys $AboutPopup;
    AppendToTextDisplay $AboutPopup [format [_ "This is Redet version %s \[%s\]."] $Version [ProgramTimeDateStamp]];
    AppendToTextDisplay $AboutPopup [_ " It is a tool for developing, testing, and executing regular expressions."];
    AppendToTextDisplay $AboutPopup [_ " You can obtain the latest version of Redet from: "];
    AppendLinkToTextDisplay $AboutPopup "http://www.billposer.org/Software/redet.html." {ShowWebPage http://www.billposer.org/Software/redet.html};
    AppendToTextDisplay $AboutPopup "\n\n";
    AppendToTextDisplay $AboutPopup "Copyright (C) 2003-2006 William J. Poser (billposer@alum.mit.edu).";
    AppendToTextDisplay $AboutPopup [_ "This program is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either version 2 of the License, or (at your option) any later version."];
    AppendToTextDisplay $AboutPopup "\n\n";
    AppendToTextDisplay $AboutPopup [_ "This program is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.\n"];
    AppendToTextDisplay $AboutPopup [_ "See the GNU General Public License for more details."];
    AppendToTextDisplay $AboutPopup "\n\n";
    AppendToTextDisplay $AboutPopup [_ "You should have received a copy of the GNU General Public License along with this program; if not, write to the Free Software Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA  02110-1301  USA."];
}

proc Description {} {
    if {[PopupDown Description] ==1} {return}
    set DescriptionPopup [CreateTextDisplay "Description" 60 12]
    set ::HelpPopups(Description) $DescriptionPopup;
    AppendToTextDisplay $DescriptionPopup "This program allows you to construct regular\
 expressions and test them against input data by executing any of a variety of search\
 programs, editors, and programming languages that support regular expressions.\
 A variety of regular expression  notations are therefore supported.\
 One window is devoted to the test data. The test data may\
 be loaded from a file, entered by typing in the window, or constructed by editing data loaded\
 from a file. The user may also enter data representing the intended output of execution of the\
 regular expression. This data too may be loaded from a file, entered in the associated window\
 (which appears if needed), or constructed by editing data loaded from a file. If such comparison\
 data is supplied, the program will automatically compare the actual output with the intended\
 output and report on any differences. Comparisons may also be triggered by means of a menu\
 button. This allows the user to correct errors in the comparison data, or test a hypothesis\
 about what is wrong, by editing the data in the window and rerunning the comparison.\
 When a suitable regular expression has been constructed it may be saved to a file.\
 For each program, a palette of regular expression constructions available in that\
 program is provided, from which entries may be copied into the regular expression\
 window by means of a mouse click. Additional palette entries may be supplied by the\
 user in his or her initialization file.
\

The full reference manual is available on-line at:
    http://www.billposer.org/Software/RedetManual.html"
}

set OtherPopups(DescribeKeyBindings) "";
proc DescribeKeyBindings {{bl DefaultKeyBindings}} {
    global CommandGlosses;
    upvar \#0 $bl kb;

    if {[winfo exists $::OtherPopups(DescribeKeyBindings)]} {
	destroy $::OtherPopups(DescribeKeyBindings);
    }
    set DescribeKeyBindingsPopup [CreateTextDisplay [_ "Key Bindings"] 88 16]
    set ::OtherPopups(DescribeKeyBindings) $DescribeKeyBindingsPopup;
    BindKeys $DescribeKeyBindingsPopup;

    #Invert array and get maximum length of gloss while we are at it.
    set MaxGlossLength 0;
    foreach KeySeq [array names kb] {
	set Gloss $CommandGlosses($kb($KeySeq));
	set GlossLength [string length $Gloss];
	if {$MaxGlossLength < $GlossLength} {set MaxGlossLength $GlossLength}
	set GlossToKeySeq($Gloss) $KeySeq;
    }
    #Now generate entries in alphabetical order of command glosses
    foreach Gloss [lsort [array names GlossToKeySeq]] {
	AppendToTextDisplay $DescribeKeyBindingsPopup [format "%-*s\t%s\n" $MaxGlossLength $Gloss $GlossToKeySeq($Gloss)];
    }
}

#Uncomment these to make them the default once it is possible to restore explicit focus
#set FocusFollowsMouseP 1;
#tk_focusFollowsMouse;

set OtherPopups(ShowUnicodeGCP) "";
proc ShowUnicodeGCP {} {
    global PopupLines;
    global SortUnicodeRangesByCodepointP;

    if {[winfo exists $::OtherPopups(ShowUnicodeGCP)]} {
	raise $::OtherPopups(ShowUnicodeGCP);
	return ;
    }
    set po [CreateTextDisplay [_ "Unicode General Character Properties"] 50 $PopupLines];
    set ::OtherPopups(ShowUnicodeGCP) $po;
    BindKeys $po;
    AppendToTextDisplay $po [_ "Single letters represent major classes. "]
    AppendToTextDisplay $po [_ "Two letter sequences represent subclasses. "]
    AppendToTextDisplay $po [_ "Note that some regular expression engines may not implement all classes.\n"]
    AppendToTextDisplay $po "\n";
    AppendToTextDisplay $po [format "L\t%s\n" [_ "letter"]];
    AppendToTextDisplay $po "\n";
    AppendToTextDisplay $po [format "\tLu\t%s\n" [_ "uppercase letter, e.g. A (0x0041)"]];
    AppendToTextDisplay $po [format "\tLl\t%s\n" [_ "lowercase letter, e.g. a (0x0061"]];
    AppendToTextDisplay $po [format "\tLt\t%s\n" [_ "titlecase letter, e.g. \u01C8 (0x01C8)"]];
    AppendToTextDisplay $po [format "\tL&\t%s\n" [_ "union of upper, lower and title-case letters"]];
    AppendToTextDisplay $po [format "\tLm\t%s\n" [_ "modifier letter, e.g. \u02B0 (0x02B0)"]];
    AppendToTextDisplay $po [format "\tLo\t%s\n" [_ "other letter, e.g. \u05D0 (0x05D0) "]];
    AppendToTextDisplay $po "\n";
    AppendToTextDisplay $po [format "N\t%s\n" [_ "number"]];
    AppendToTextDisplay $po "\n";
    AppendToTextDisplay $po [format "\tNd\t%s\n" [_ "decimal digit, e.g. 3 (0x0033)"]];
    AppendToTextDisplay $po [format "\tNl\t%s\n" [_ "letter number, e.g. \u3023 (0x3023)"]];
    AppendToTextDisplay $po [format "\tNo\t%s\n" [_ "other number, e.g. \u00B3 (0x00B3)"]];
    AppendToTextDisplay $po "\n";
    AppendToTextDisplay $po [format "P\t%s\n" [_ "punctuation"]];
    AppendToTextDisplay $po "\n";
    AppendToTextDisplay $po [format "\tPc\t%s\n" [_ "punctuation - connector, e.g. \u203F (0x203F)"]];
    AppendToTextDisplay $po [format "\tPd\t%s\n" [_ "punctuation - dash"]];
    AppendToTextDisplay $po [format "\tPs\t%s\n" [_ "punctuation - open"]];
    AppendToTextDisplay $po [format "\tPe\t%s\n" [_ "punctuation - close"]];
    AppendToTextDisplay $po [format "\tPi\t%s\n" [_ "punctuation - initial quote"]];
    AppendToTextDisplay $po [format "\tPf\t%s\n" [_ "punctuation - final quote"]];
    AppendToTextDisplay $po [format "\tPo\t%s\n" [_ "punctuation - other"]];
    AppendToTextDisplay $po "\n";
    AppendToTextDisplay $po [format "S\t%s\n" [_ "symbol"]];
    AppendToTextDisplay $po "\n";
    AppendToTextDisplay $po [format "\tSm\t%s\n" [_ "math symbol, .e.g \u2245 (0x2245)"]];
    AppendToTextDisplay $po [format "\tSc\t%s\n" [_ "currency symbol, e.g. \u20A0 (0x20A0)"]];
    AppendToTextDisplay $po [format "\tSk\t%s\n" [_ "modifier symbol, e.g. \u005E (0x005E)"]];
    AppendToTextDisplay $po [format "\tSo\t%s\n" [_ "other symbol, e.g. \u00AE (0x00AE)"]];
    AppendToTextDisplay $po "\n";
    AppendToTextDisplay $po [format "Z\t%s\n" [_ "separator"]];
    AppendToTextDisplay $po "\n";
    AppendToTextDisplay $po [format "\tZs\t%s\n" [_ "space separator"]];
    AppendToTextDisplay $po [format "\tZl\t%s\n" [_ "line separator"]];
    AppendToTextDisplay $po [format "\tZp\t%s\n" [_ "paragraph separator"]];
    AppendToTextDisplay $po "\n";
    AppendToTextDisplay $po [format "M\t%s\n" [_ "mark"]];
    AppendToTextDisplay $po "\n";
    AppendToTextDisplay $po [format "\tMn\t%s\n" [_ "non-spacing mark"]];
    AppendToTextDisplay $po [format "\tMc\t%s\n" [_ "spacing combining mark"]];
    AppendToTextDisplay $po [format "\tMe\t%s\n" [_ "enclosing mark"]];
    AppendToTextDisplay $po "\n";
    AppendToTextDisplay $po [format "C\t%s\n" [_ "other"]];
    AppendToTextDisplay $po "\n";
    AppendToTextDisplay $po [format "\tCc\t%s\n" [_ "other - control"]];
    AppendToTextDisplay $po [format "\tCf\t%s\n" [_ "other - format"]];
    AppendToTextDisplay $po [format "\tCo\t%s\n" [_ "other - private use"]];
    AppendToTextDisplay $po [format "\tCn\t%s\n" [_ "other - not assigned"]];

}

set OtherPopups(ShowUnicodeRanges) "";
proc ShowUnicodeRanges {} {
    global SortUnicodeRangesByCodepointP;
    global PopupLines;

    if {[winfo exists $::OtherPopups(ShowUnicodeRanges)]} {
	raise $::OtherPopups(ShowUnicodeRanges);
	return ;
    }
    set po  [CreateTextDisplay [_ "Unicode Ranges"] 65 $PopupLines];
    set ::OtherPopups(ShowUnicodeRanges) $po;
    BindKeys $po;
    if {$SortUnicodeRangesByCodepointP} {
	AppendToTextDisplay $po [format "%-42s  \[0x000000-0x00007F\]\n" [_ "Basic Latin"]];
	AppendToTextDisplay $po [format "%-42s  \[0x000080-0x0000FF\]\n" [_ "C1 Controls and Latin-1 Supplement"]];
	AppendToTextDisplay $po [format "%-42s  \[0x000100-0x00017F\]\n" [_ "Latin Extended-A"]];
	AppendToTextDisplay $po [format "%-42s  \[0x000180-0x00024F\]\n" [_ "Latin Extended-B"]];
	AppendToTextDisplay $po [format "%-42s  \[0x000250-0x0002AF\]\n" [_ "IPA Extensions"]];
	AppendToTextDisplay $po [format "%-42s  \[0x0002B0-0x0002FF\]\n" [_ "Spacing Modifier Letters"]];
	AppendToTextDisplay $po [format "%-42s  \[0x000300-0x00036F\]\n" [_ "Combining Diacritical Marks"]];
	AppendToTextDisplay $po [format "%-42s  \[0x000370-0x0003FF\]\n" [_ "Greek/Coptic"]];
	AppendToTextDisplay $po [format "%-42s  \[0x000400-0x0004FF\]\n" [_ "Cyrillic"]];
	AppendToTextDisplay $po [format "%-42s  \[0x000500-0x00052F\]\n" [_ "Cyrillic Supplement"]];
	AppendToTextDisplay $po [format "%-42s  \[0x000530-0x00058F\]\n" [_ "Armenian"]];
	AppendToTextDisplay $po [format "%-42s  \[0x000590-0x0005FF\]\n" [_ "Hebrew"]];
	AppendToTextDisplay $po [format "%-42s  \[0x000600-0x0006FF\]\n" [_ "Arabic"]];
	AppendToTextDisplay $po [format "%-42s  \[0x000700-0x00074F\]\n" [_ "Syriac"]];
	AppendToTextDisplay $po [format "%-42s  \[0x000750-0x00077F\]\n" [_ "Undefined"]];
	AppendToTextDisplay $po [format "%-42s  \[0x000780-0x0007BF\]\n" [_ "Thaana"]];
	AppendToTextDisplay $po [format "%-42s  \[0x0007C0-0x0008FF\]\n" [_ "Undefined"]];
	AppendToTextDisplay $po [format "%-42s  \[0x000900-0x00097F\]\n" [_ "Devanagari"]];
	AppendToTextDisplay $po [format "%-42s  \[0x000980-0x0009FF\]\n" [_ "Bengali/Assamese"]];
	AppendToTextDisplay $po [format "%-42s  \[0x000A00-0x000A7F\]\n" [_ "Gurmukhi"]];
	AppendToTextDisplay $po [format "%-42s  \[0x000A80-0x000AFF\]\n" [_ "Gujarati"]];
	AppendToTextDisplay $po [format "%-42s  \[0x000B00-0x000B7F\]\n" [_ "Oriya"]];
	AppendToTextDisplay $po [format "%-42s  \[0x000B80-0x000BFF\]\n" [_ "Tamil"]];
	AppendToTextDisplay $po [format "%-42s  \[0x000C00-0x000C7F\]\n" [_ "Telugu"]];
	AppendToTextDisplay $po [format "%-42s  \[0x000C80-0x000CFF\]\n" [_ "Kannada"]];
	AppendToTextDisplay $po [format "%-42s  \[0x000D80-0x000DFF\]\n" [_ "Sinhala"]];
	AppendToTextDisplay $po [format "%-42s  \[0x000D00-0x000DFF\]\n" [_ "Malayalam"]];
	AppendToTextDisplay $po [format "%-42s  \[0x000E00-0x000E7F\]\n" [_ "Thai"]];
	AppendToTextDisplay $po [format "%-42s  \[0x000E80-0x000EFF\]\n" [_ "Lao"]];
	AppendToTextDisplay $po [format "%-42s  \[0x000F00-0x000FFF\]\n" [_ "Tibetan"]];
	AppendToTextDisplay $po [format "%-42s  \[0x001000-0x00109F\]\n" [_ "Myanmar"]];
	AppendToTextDisplay $po [format "%-42s  \[0x0010A0-0x0010FF\]\n" [_ "Georgian"]];
	AppendToTextDisplay $po [format "%-42s  \[0x001100-0x0011FF\]\n" [_ "Hangul Jamo"]];
	AppendToTextDisplay $po [format "%-42s  \[0x001200-0x00137F\]\n" [_ "Ethiopic"]];
	AppendToTextDisplay $po [format "%-42s  \[0x001380-0x00139F\]\n" [_ "Undefined"]];
	AppendToTextDisplay $po [format "%-42s  \[0x0013A0-0x0013FF\]\n" [_ "Cherokee"]];
	AppendToTextDisplay $po [format "%-42s  \[0x001400-0x00167F\]\n" [_ "Unified Canadian Aboriginal Syllabics"]];
	AppendToTextDisplay $po [format "%-42s  \[0x001680-0x00169F\]\n" [_ "Ogham"]];
	AppendToTextDisplay $po [format "%-42s  \[0x0016A0-0x0016FF\]\n" [_ "Runic"]];
	AppendToTextDisplay $po [format "%-42s  \[0x001700-0x00171F\]\n" [_ "Tagalog"]];
	AppendToTextDisplay $po [format "%-42s  \[0x001720-0x00173F\]\n" [_ "Hanunoo"]];
	AppendToTextDisplay $po [format "%-42s  \[0x001740-0x00175F\]\n" [_ "Buhid"]];
	AppendToTextDisplay $po [format "%-42s  \[0x001760-0x00177F\]\n" [_ "Tagbanwa"]];
	AppendToTextDisplay $po [format "%-42s  \[0x001780-0x0017FF\]\n" [_ "Khmer"]];
	AppendToTextDisplay $po [format "%-42s  \[0x001800-0x0018AF\]\n" [_ "Mongolian"]];
	AppendToTextDisplay $po [format "%-42s  \[0x0018B0-0x0018FF\]\n" [_ "Undefined"]];
	AppendToTextDisplay $po [format "%-42s  \[0x001900-0x00194F\]\n" [_ "Limbu"]];
	AppendToTextDisplay $po [format "%-42s  \[0x001950-0x00197F\]\n" [_ "Tai Le"]];
	AppendToTextDisplay $po [format "%-42s  \[0x001980-0x0019DF\]\n" [_ "Undefined"]];
	AppendToTextDisplay $po [format "%-42s  \[0x0019E0-0x0019FF\]\n" [_ "Khmer Symbols"]];
	AppendToTextDisplay $po [format "%-42s  \[0x001A00-0x001CFF\]\n" [_ "Undefined"]];
	AppendToTextDisplay $po [format "%-42s  \[0x001D00-0x001D7F\]\n" [_ "Phonetic Extensions"]];
	AppendToTextDisplay $po [format "%-42s  \[0x001D80-0x001DFF\]\n" [_ "Undefined"]];
	AppendToTextDisplay $po [format "%-42s  \[0x001E00-0x001EFF\]\n" [_ "Latin Extended Additional"]];
	AppendToTextDisplay $po [format "%-42s  \[0x001F00-0x001FFF\]\n" [_ "Greek Extended"]];
	AppendToTextDisplay $po [format "%-42s  \[0x002000-0x00206F\]\n" [_ "General Punctuation"]];
	AppendToTextDisplay $po [format "%-42s  \[0x002070-0x00209F\]\n" [_ "Superscripts and Subscripts"]];
	AppendToTextDisplay $po [format "%-42s  \[0x0020A0-0x0020CF\]\n" [_ "Currency Symbols"]];
	AppendToTextDisplay $po [format "%-42s  \[0x0020D0-0x0020FF\]\n" [_ "Combining Diacritical Marks for Symbols"]];
	AppendToTextDisplay $po [format "%-42s  \[0x002100-0x00214F\]\n" [_ "Letterlike Symbols"]];
	AppendToTextDisplay $po [format "%-42s  \[0x002150-0x00218F\]\n" [_ "Number Forms"]];
	AppendToTextDisplay $po [format "%-42s  \[0x002190-0x0021FF\]\n" [_ "Arrows"]];
	AppendToTextDisplay $po [format "%-42s  \[0x002200-0x0022FF\]\n" [_ "Mathematical Operators"]];
	AppendToTextDisplay $po [format "%-42s  \[0x002300-0x0023FF\]\n" [_ "Miscellaneous Technical"]];
	AppendToTextDisplay $po [format "%-42s  \[0x002400-0x00243F\]\n" [_ "Control Pictures"]];
	AppendToTextDisplay $po [format "%-42s  \[0x002440-0x00245F\]\n" [_ "Optical Character Recognition"]];
	AppendToTextDisplay $po [format "%-42s  \[0x002460-0x0024FF\]\n" [_ "Enclosed Alphanumerics"]];
	AppendToTextDisplay $po [format "%-42s  \[0x002500-0x00257F\]\n" [_ "Box Drawing"]];
	AppendToTextDisplay $po [format "%-42s  \[0x002580-0x00259F\]\n" [_ "Block Elements"]];
	AppendToTextDisplay $po [format "%-42s  \[0x0025A0-0x0025FF\]\n" [_ "Geometric Shapes"]];
	AppendToTextDisplay $po [format "%-42s  \[0x002600-0x0026FF\]\n" [_ "Miscellaneous Symbols"]];
	AppendToTextDisplay $po [format "%-42s  \[0x002700-0x0027BF\]\n" [_ "Dingbats"]];
	AppendToTextDisplay $po [format "%-42s  \[0x0027C0-0x0027EF\]\n" [_ "Miscellaneous Mathematical Symbols-A"]];
	AppendToTextDisplay $po [format "%-42s  \[0x0027F0-0x0027FF\]\n" [_ "Supplemental Arrows-A"]];
	AppendToTextDisplay $po [format "%-42s  \[0x002800-0x0028FF\]\n" [_ "Braille Patterns"]];
	AppendToTextDisplay $po [format "%-42s  \[0x002900-0x00297F\]\n" [_ "Supplemental Arrows-B"]];
	AppendToTextDisplay $po [format "%-42s  \[0x002980-0x0029FF\]\n" [_ "Miscellaneous Mathematical Symbols-B"]];
	AppendToTextDisplay $po [format "%-42s  \[0x002A00-0x002AFF\]\n" [_ "Supplemental Mathematical Operators"]];
	AppendToTextDisplay $po [format "%-42s  \[0x002B00-0x002BFF\]\n" [_ "Miscellaneous Symbols and Arrows"]];
	AppendToTextDisplay $po [format "%-42s  \[0x002C00-0x002E7F\]\n" [_ "Undefined"]];
	AppendToTextDisplay $po [format "%-42s  \[0x002E80-0x002EFF\]\n" [_ "CJK Radicals Supplement"]];
	AppendToTextDisplay $po [format "%-42s  \[0x002F00-0x002FDF\]\n" [_ "Kangxi Radicals"]];
	AppendToTextDisplay $po [format "%-42s  \[0x002FE0-0x002EEF\]\n" [_ "Undefined"]];
	AppendToTextDisplay $po [format "%-42s  \[0x002FF0-0x002FFF\]\n" [_ "Ideographic Description Characters"]];
	AppendToTextDisplay $po [format "%-42s  \[0x003000-0x00303F\]\n" [_ "CJK Symbols and Punctuation"]];
	AppendToTextDisplay $po [format "%-42s  \[0x003040-0x00309F\]\n" [_ "Hiragana"]];
	AppendToTextDisplay $po [format "%-42s  \[0x0030A0-0x0030FF\]\n" [_ "Katakana"]];
	AppendToTextDisplay $po [format "%-42s  \[0x003100-0x00312F\]\n" [_ "Bopomofo"]];
	AppendToTextDisplay $po [format "%-42s  \[0x003130-0x00318F\]\n" [_ "Hangul Compatibility Jamo"]];
	AppendToTextDisplay $po [format "%-42s  \[0x003190-0x00319F\]\n" [_ "Kanbun (Kunten)"]];
	AppendToTextDisplay $po [format "%-42s  \[0x0031A0-0x0031BF\]\n" [_ "Bopomofo Extended"]];
	AppendToTextDisplay $po [format "%-42s  \[0x0031C0-0x0031EF\]\n" [_ "Undefined"]];
	AppendToTextDisplay $po [format "%-42s  \[0x0031F0-0x0031FF\]\n" [_ "Katakana Phonetic Extensions"]];
	AppendToTextDisplay $po [format "%-42s  \[0x003200-0x0032FF\]\n" [_ "Enclosed CJK Letters and Months"]];
	AppendToTextDisplay $po [format "%-42s  \[0x003300-0x0033FF\]\n" [_ "CJK Compatibility"]];
	AppendToTextDisplay $po [format "%-42s  \[0x003400-0x004DBF\]\n" [_ "CJK Unified Ideographs Extension A"]];
	AppendToTextDisplay $po [format "%-42s  \[0x004DC0-0x004DFF\]\n" [_ "Yijing Hexagram Symbols"]];
	AppendToTextDisplay $po [format "%-42s  \[0x004E00-0x009FAF\]\n" [_ "CJK Unified Ideographs"]];
	AppendToTextDisplay $po [format "%-42s  \[0x009FB0-0x009FFF\]\n" [_ "Undefined"]];
	AppendToTextDisplay $po [format "%-42s  \[0x00A000-0x00A48F\]\n" [_ "Yi Syllables"]];
	AppendToTextDisplay $po [format "%-42s  \[0x00A490-0x00A4CF\]\n" [_ "Yi Radicals"]];
	AppendToTextDisplay $po [format "%-42s  \[0x00A4D0-0x00ABFF\]\n" [_ "Undefined"]];
	AppendToTextDisplay $po [format "%-42s  \[0x00AC00-0x00D7AF\]\n" [_ "Hangul Syllables"]];
	AppendToTextDisplay $po [format "%-42s  \[0x00D7B0-0x00D7FF\]\n" [_ "Undefined"]];
	AppendToTextDisplay $po [format "%-42s  \[0x00D800-0x00DBFF\]\n" [_ "High Surrogate Area"]];
	AppendToTextDisplay $po [format "%-42s  \[0x00DC00-0x00DFFF\]\n" [_ "Low Surrogate Area"]];
	AppendToTextDisplay $po [format "%-42s  \[0x00E000-0x00F8FF\]\n" [_ "Private Use Area"]];
	AppendToTextDisplay $po [format "%-42s  \[0x00F900-0x00FAFF\]\n" [_ "CJK Compatibility Ideographs"]];
	AppendToTextDisplay $po [format "%-42s  \[0x00FB00-0x00FB4F\]\n" [_ "Alphabetic Presentation Forms"]];
	AppendToTextDisplay $po [format "%-42s  \[0x00FB50-0x00FDFF\]\n" [_ "Arabic Presentation Forms-A"]];
	AppendToTextDisplay $po [format "%-42s  \[0x00FE00-0x00FE0F\]\n" [_ "Variation Selectors"]];
	AppendToTextDisplay $po [format "%-42s  \[0x00FE10-0x00FE1F\]\n" [_ "Undefined"]];
	AppendToTextDisplay $po [format "%-42s  \[0x00FE20-0x00FE2F\]\n" [_ "Combining Half Marks"]];
	AppendToTextDisplay $po [format "%-42s  \[0x00FE30-0x00FE4F\]\n" [_ "CJK Compatibility Forms"]];
	AppendToTextDisplay $po [format "%-42s  \[0x00FE50-0x00FE6F\]\n" [_ "Small Form Variants"]];
	AppendToTextDisplay $po [format "%-42s  \[0x00FE70-0x00FEFF\]\n" [_ "Arabic Presentation Forms-B"]];
	AppendToTextDisplay $po [format "%-42s  \[0x00FF00-0x00FFEF\]\n" [_ "Halfwidth and Fullwidth Forms"]];
	AppendToTextDisplay $po [format "%-42s  \[0x00FFF0-0x00FFFF\]\n" [_ "Specials"]];
	AppendToTextDisplay $po [format "%-42s  \[0x010000-0x01007F\]\n" [_ "Linear B Syllabary"]];
	AppendToTextDisplay $po [format "%-42s  \[0x010080-0x0100FF\]\n" [_ "Linear B Ideograms"]];
	AppendToTextDisplay $po [format "%-42s  \[0x010100-0x01013F\]\n" [_ "Aegean Numbers"]];
	AppendToTextDisplay $po [format "%-42s  \[0x010140-0x0102FF\]\n" [_ "Undefined"]];
	AppendToTextDisplay $po [format "%-42s  \[0x010300-0x01032F\]\n" [_ "Old Italic"]];
	AppendToTextDisplay $po [format "%-42s  \[0x010330-0x01034F\]\n" [_ "Gothic"]];
	AppendToTextDisplay $po [format "%-42s  \[0x010380-0x01039F\]\n" [_ "Ugaritic"]];
	AppendToTextDisplay $po [format "%-42s  \[0x010400-0x01044F\]\n" [_ "Deseret"]];
	AppendToTextDisplay $po [format "%-42s  \[0x010450-0x01047F\]\n" [_ "Shavian"]];
	AppendToTextDisplay $po [format "%-42s  \[0x010480-0x0104AF\]\n" [_ "Osmanya"]];
	AppendToTextDisplay $po [format "%-42s  \[0x0104B0-0x0107FF\]\n" [_ "Undefined"]];
	AppendToTextDisplay $po [format "%-42s  \[0x010800-0x01083F\]\n" [_ "Cypriot Syllabary"]];
	AppendToTextDisplay $po [format "%-42s  \[0x010840-0x01CFFF\]\n" [_ "Undefined"]];
	AppendToTextDisplay $po [format "%-42s  \[0x01D000-0x01D0FF\]\n" [_ "Byzantine Musical Symbols"]];
	AppendToTextDisplay $po [format "%-42s  \[0x01D100-0x01D1FF\]\n" [_ "Musical Symbols"]];
	AppendToTextDisplay $po [format "%-42s  \[0x01D200-0x01D2FF\]\n" [_ "Undefined"]];
	AppendToTextDisplay $po [format "%-42s  \[0x01D300-0x01D35F\]\n" [_ "Tai Xuan Jing Symbols"]];
	AppendToTextDisplay $po [format "%-42s  \[0x01D360-0x01D3FF\]\n" [_ "Undefined"]];
	AppendToTextDisplay $po [format "%-42s  \[0x01D400-0x01D7FF\]\n" [_ "Mathematical Alphanumeric Symbols"]];
	AppendToTextDisplay $po [format "%-42s  \[0x01D800-0x01FFFF\]\n" [_ "Undefined"]];
	AppendToTextDisplay $po [format "%-42s  \[0x020000-0x02A6DF\]\n" [_ "CJK Unified Ideographs Extension B"]];
	AppendToTextDisplay $po [format "%-42s  \[0x02A6E0-0x02F7FF\]\n" [_ "Undefined"]];
	AppendToTextDisplay $po [format "%-42s  \[0x02F800-0x02FA1F\]\n" [_ "CJK Compatibility Ideographs Supplement"]];
	AppendToTextDisplay $po [format "%-42s  \[0x02FAB0-0x0DFFFF\]\n" [_ "Unused"]];
	AppendToTextDisplay $po [format "%-42s  \[0x0E0000-0x0E007F\]\n" [_ "Tags"]];
	AppendToTextDisplay $po [format "%-42s  \[0x0E0080-0x0E00FF\]\n" [_ "Unused"]];
	AppendToTextDisplay $po [format "%-42s  \[0x0E0100-0x0E01EF\]\n" [_ "Variation Selectors Supplement"]];
	AppendToTextDisplay $po [format "%-42s  \[0x0E01F0-0x0EFFFF\]\n" [_ "Unused"]];
	AppendToTextDisplay $po [format "%-42s  \[0x0F0000-0x0FFFFD\]\n" [_ "Supplementary Private Use Area-A"]];
	AppendToTextDisplay $po [format "%-42s  \[0x0FFFFE-0x0FFFFF\]\n" [_ "Unused"]];
	AppendToTextDisplay $po [format "%-42s  \[0x100000-0x10FFFD\]\n" [_ "Supplementary Private Use Area-B"]];
    } else {
	AppendToTextDisplay $po [format "%-42s  \[0x010100-0x01013F\]\n" [_ "Aegean Numbers"]];
	AppendToTextDisplay $po [format "%-42s  \[0x00FB00-0x00FB4F\]\n" [_ "Alphabetic Presentation Forms"]];
	AppendToTextDisplay $po [format "%-42s  \[0x00FB50-0x00FDFF\]\n" [_ "Arabic Presentation Forms-A"]];
	AppendToTextDisplay $po [format "%-42s  \[0x00FE70-0x00FEFF\]\n" [_ "Arabic Presentation Forms-B"]];
	AppendToTextDisplay $po [format "%-42s  \[0x000600-0x0006FF\]\n" [_ "Arabic"]];
	AppendToTextDisplay $po [format "%-42s  \[0x000530-0x00058F\]\n" [_ "Armenian"]];
	AppendToTextDisplay $po [format "%-42s  \[0x002190-0x0021FF\]\n" [_ "Arrows"]];
	AppendToTextDisplay $po [format "%-42s  \[0x000000-0x00007F\]\n" [_ "Basic Latin"]];
	AppendToTextDisplay $po [format "%-42s  \[0x000980-0x0009FF\]\n" [_ "Bengali/Assamese"]];
	AppendToTextDisplay $po [format "%-42s  \[0x002580-0x00259F\]\n" [_ "Block Elements"]];
	AppendToTextDisplay $po [format "%-42s  \[0x0031A0-0x0031BF\]\n" [_ "Bopomofo Extended"]];
	AppendToTextDisplay $po [format "%-42s  \[0x003100-0x00312F\]\n" [_ "Bopomofo"]];
	AppendToTextDisplay $po [format "%-42s  \[0x002500-0x00257F\]\n" [_ "Box Drawing"]];
	AppendToTextDisplay $po [format "%-42s  \[0x002800-0x0028FF\]\n" [_ "Braille Patterns"]];
	AppendToTextDisplay $po [format "%-42s  \[0x001740-0x00175F\]\n" [_ "Buhid"]];
	AppendToTextDisplay $po [format "%-42s  \[0x01D000-0x01D0FF\]\n" [_ "Byzantine Musical Symbols"]];
	AppendToTextDisplay $po [format "%-42s  \[0x000080-0x0000FF\]\n" [_ "C1 Controls and Latin-1 Supplement"]];
	AppendToTextDisplay $po [format "%-42s  \[0x002E80-0x002EFF\]\n" [_ "CJK Radicals Supplement"]];
	AppendToTextDisplay $po [format "%-42s  \[0x003000-0x00303F\]\n" [_ "CJK Symbols and Punctuation"]];
	AppendToTextDisplay $po [format "%-42s  \[0x003300-0x0033FF\]\n" [_ "CJK Compatibility"]];
	AppendToTextDisplay $po [format "%-42s  \[0x003400-0x004DBF\]\n" [_ "CJK Unified Ideographs Extension A"]];
	AppendToTextDisplay $po [format "%-42s  \[0x004E00-0x009FAF\]\n" [_ "CJK Unified Ideographs"]];
	AppendToTextDisplay $po [format "%-42s  \[0x00F900-0x00FAFF\]\n" [_ "CJK Compatibility Ideographs"]];
	AppendToTextDisplay $po [format "%-42s  \[0x00FE30-0x00FE4F\]\n" [_ "CJK Compatibility Forms"]];
	AppendToTextDisplay $po [format "%-42s  \[0x020000-0x02A6DF\]\n" [_ "CJK Unified Ideographs Extension B"]];
	AppendToTextDisplay $po [format "%-42s  \[0x02F800-0x02FA1F\]\n" [_ "CJK Compatibility Ideographs Supplement"]];
	AppendToTextDisplay $po [format "%-42s  \[0x0013A0-0x0013FF\]\n" [_ "Cherokee"]];
	AppendToTextDisplay $po [format "%-42s  \[0x000300-0x00036F\]\n" [_ "Combining Diacritical Marks"]];
	AppendToTextDisplay $po [format "%-42s  \[0x0020D0-0x0020FF\]\n" [_ "Combining Diacritical Marks for Symbols"]];
	AppendToTextDisplay $po [format "%-42s  \[0x00FE20-0x00FE2F\]\n" [_ "Combining Half Marks"]];
	AppendToTextDisplay $po [format "%-42s  \[0x002400-0x00243F\]\n" [_ "Control Pictures"]];
	AppendToTextDisplay $po [format "%-42s  \[0x0020A0-0x0020CF\]\n" [_ "Currency Symbols"]];
	AppendToTextDisplay $po [format "%-42s  \[0x010800-0x01083F\]\n" [_ "Cypriot Syllabary"]];
	AppendToTextDisplay $po [format "%-42s  \[0x000500-0x00052F\]\n" [_ "Cyrillic Supplement"]];
	AppendToTextDisplay $po [format "%-42s  \[0x000400-0x0004FF\]\n" [_ "Cyrillic"]];
	AppendToTextDisplay $po [format "%-42s  \[0x010400-0x01044F\]\n" [_ "Deseret"]];
	AppendToTextDisplay $po [format "%-42s  \[0x000900-0x00097F\]\n" [_ "Devanagari"]];
	AppendToTextDisplay $po [format "%-42s  \[0x002700-0x0027BF\]\n" [_ "Dingbats"]];
	AppendToTextDisplay $po [format "%-42s  \[0x002460-0x0024FF\]\n" [_ "Enclosed Alphanumerics"]];
	AppendToTextDisplay $po [format "%-42s  \[0x003200-0x0032FF\]\n" [_ "Enclosed CJK Letters and Months"]];
	AppendToTextDisplay $po [format "%-42s  \[0x001200-0x00137F\]\n" [_ "Ethiopic"]];
	AppendToTextDisplay $po [format "%-42s  \[0x002000-0x00206F\]\n" [_ "General Punctuation"]];
	AppendToTextDisplay $po [format "%-42s  \[0x0025A0-0x0025FF\]\n" [_ "Geometric Shapes"]];
	AppendToTextDisplay $po [format "%-42s  \[0x0010A0-0x0010FF\]\n" [_ "Georgian"]];
	AppendToTextDisplay $po [format "%-42s  \[0x010330-0x01034F\]\n" [_ "Gothic"]];
	AppendToTextDisplay $po [format "%-42s  \[0x001F00-0x001FFF\]\n" [_ "Greek Extended"]];
	AppendToTextDisplay $po [format "%-42s  \[0x000370-0x0003FF\]\n" [_ "Greek/Coptic"]];
	AppendToTextDisplay $po [format "%-42s  \[0x000A80-0x000AFF\]\n" [_ "Gujarati"]];
	AppendToTextDisplay $po [format "%-42s  \[0x000A00-0x000A7F\]\n" [_ "Gurmukhi"]];
	AppendToTextDisplay $po [format "%-42s  \[0x00FF00-0x00FFEF\]\n" [_ "Halfwidth and Fullwidth Forms"]];
	AppendToTextDisplay $po [format "%-42s  \[0x001100-0x0011FF\]\n" [_ "Hangul Jamo"]];
	AppendToTextDisplay $po [format "%-42s  \[0x003130-0x00318F\]\n" [_ "Hangul Compatibility Jamo"]];
	AppendToTextDisplay $po [format "%-42s  \[0x00AC00-0x00D7AF\]\n" [_ "Hangul Syllables"]];
	AppendToTextDisplay $po [format "%-42s  \[0x001720-0x00173F\]\n" [_ "Hanunoo"]];
	AppendToTextDisplay $po [format "%-42s  \[0x000590-0x0005FF\]\n" [_ "Hebrew"]];
	AppendToTextDisplay $po [format "%-42s  \[0x00D800-0x00DBFF\]\n" [_ "High Surrogate Area"]];
	AppendToTextDisplay $po [format "%-42s  \[0x003040-0x00309F\]\n" [_ "Hiragana"]];
	AppendToTextDisplay $po [format "%-42s  \[0x000250-0x0002AF\]\n" [_ "IPA Extensions"]];
	AppendToTextDisplay $po [format "%-42s  \[0x002FF0-0x002FFF\]\n" [_ "Ideographic Description Characters"]];
	AppendToTextDisplay $po [format "%-42s  \[0x003190-0x00319F\]\n" [_ "Kanbun (Kunten)"]];
	AppendToTextDisplay $po [format "%-42s  \[0x002F00-0x002FDF\]\n" [_ "Kangxi Radicals"]];
	AppendToTextDisplay $po [format "%-42s  \[0x000C80-0x000CFF\]\n" [_ "Kannada"]];
	AppendToTextDisplay $po [format "%-42s  \[0x0031F0-0x0031FF\]\n" [_ "Katakana Phonetic Extensions"]];
	AppendToTextDisplay $po [format "%-42s  \[0x0030A0-0x0030FF\]\n" [_ "Katakana"]];
	AppendToTextDisplay $po [format "%-42s  \[0x0019E0-0x0019FF\]\n" [_ "Khmer Symbols"]];
	AppendToTextDisplay $po [format "%-42s  \[0x001780-0x0017FF\]\n" [_ "Khmer"]];
	AppendToTextDisplay $po [format "%-42s  \[0x000E80-0x000EFF\]\n" [_ "Lao"]];
	AppendToTextDisplay $po [format "%-42s  \[0x000100-0x00017F\]\n" [_ "Latin Extended-A"]];
	AppendToTextDisplay $po [format "%-42s  \[0x000180-0x00024F\]\n" [_ "Latin Extended-B"]];
	AppendToTextDisplay $po [format "%-42s  \[0x001E00-0x001EFF\]\n" [_ "Latin Extended Additional"]];
	AppendToTextDisplay $po [format "%-42s  \[0x002100-0x00214F\]\n" [_ "Letterlike Symbols"]];
	AppendToTextDisplay $po [format "%-42s  \[0x001900-0x00194F\]\n" [_ "Limbu"]];
	AppendToTextDisplay $po [format "%-42s  \[0x010000-0x01007F\]\n" [_ "Linear B Syllabary"]];
	AppendToTextDisplay $po [format "%-42s  \[0x010080-0x0100FF\]\n" [_ "Linear B Ideograms"]];
	AppendToTextDisplay $po [format "%-42s  \[0x00DC00-0x00DFFF\]\n" [_ "Low Surrogate Area"]];
	AppendToTextDisplay $po [format "%-42s  \[0x000D00-0x000DFF\]\n" [_ "Malayalam"]];
	AppendToTextDisplay $po [format "%-42s  \[0x002200-0x0022FF\]\n" [_ "Mathematical Operators"]];
	AppendToTextDisplay $po [format "%-42s  \[0x01D400-0x01D7FF\]\n" [_ "Mathematical Alphanumeric Symbols"]];
	AppendToTextDisplay $po [format "%-42s  \[0x002300-0x0023FF\]\n" [_ "Miscellaneous Technical"]];
	AppendToTextDisplay $po [format "%-42s  \[0x002600-0x0026FF\]\n" [_ "Miscellaneous Symbols"]];
	AppendToTextDisplay $po [format "%-42s  \[0x0027C0-0x0027EF\]\n" [_ "Miscellaneous Mathematical Symbols-A"]];
	AppendToTextDisplay $po [format "%-42s  \[0x002980-0x0029FF\]\n" [_ "Miscellaneous Mathematical Symbols-B"]];
	AppendToTextDisplay $po [format "%-42s  \[0x002B00-0x002BFF\]\n" [_ "Miscellaneous Symbols and Arrows"]];
	AppendToTextDisplay $po [format "%-42s  \[0x001800-0x0018AF\]\n" [_ "Mongolian"]];
	AppendToTextDisplay $po [format "%-42s  \[0x01D100-0x01D1FF\]\n" [_ "Musical Symbols"]];
	AppendToTextDisplay $po [format "%-42s  \[0x001000-0x00109F\]\n" [_ "Myanmar"]];
	AppendToTextDisplay $po [format "%-42s  \[0x002150-0x00218F\]\n" [_ "Number Forms"]];
	AppendToTextDisplay $po [format "%-42s  \[0x001680-0x00169F\]\n" [_ "Ogham"]];
	AppendToTextDisplay $po [format "%-42s  \[0x010300-0x01032F\]\n" [_ "Old Italic"]];
	AppendToTextDisplay $po [format "%-42s  \[0x002440-0x00245F\]\n" [_ "Optical Character Recognition"]];
	AppendToTextDisplay $po [format "%-42s  \[0x000B00-0x000B7F\]\n" [_ "Oriya"]];
	AppendToTextDisplay $po [format "%-42s  \[0x010480-0x0104AF\]\n" [_ "Osmanya"]];
	AppendToTextDisplay $po [format "%-42s  \[0x001D00-0x001D7F\]\n" [_ "Phonetic Extensions"]];
	AppendToTextDisplay $po [format "%-42s  \[0x00E000-0x00F8FF\]\n" [_ "Private Use Area"]];
	AppendToTextDisplay $po [format "%-42s  \[0x0016A0-0x0016FF\]\n" [_ "Runic"]];
	AppendToTextDisplay $po [format "%-42s  \[0x010450-0x01047F\]\n" [_ "Shavian"]];
	AppendToTextDisplay $po [format "%-42s  \[0x000D80-0x000DFF\]\n" [_ "Sinhala"]];
	AppendToTextDisplay $po [format "%-42s  \[0x00FE50-0x00FE6F\]\n" [_ "Small Form Variants"]];
	AppendToTextDisplay $po [format "%-42s  \[0x0002B0-0x0002FF\]\n" [_ "Spacing Modifier Letters"]];
	AppendToTextDisplay $po [format "%-42s  \[0x00FFF0-0x00FFFF\]\n" [_ "Specials"]];
	AppendToTextDisplay $po [format "%-42s  \[0x002070-0x00209F\]\n" [_ "Superscripts and Subscripts"]];
	AppendToTextDisplay $po [format "%-42s  \[0x0027F0-0x0027FF\]\n" [_ "Supplemental Arrows-A"]];
	AppendToTextDisplay $po [format "%-42s  \[0x002900-0x00297F\]\n" [_ "Supplemental Arrows-B"]];
	AppendToTextDisplay $po [format "%-42s  \[0x002A00-0x002AFF\]\n" [_ "Supplemental Mathematical Operators"]];
	AppendToTextDisplay $po [format "%-42s  \[0x0F0000-0x0FFFFD\]\n" [_ "Supplementary Private Use Area-A"]];
	AppendToTextDisplay $po [format "%-42s  \[0x100000-0x10FFFD\]\n" [_ "Supplementary Private Use Area-B"]];
	AppendToTextDisplay $po [format "%-42s  \[0x000700-0x00074F\]\n" [_ "Syriac"]];
	AppendToTextDisplay $po [format "%-42s  \[0x001700-0x00171F\]\n" [_ "Tagalog"]];
	AppendToTextDisplay $po [format "%-42s  \[0x001760-0x00177F\]\n" [_ "Tagbanwa"]];
	AppendToTextDisplay $po [format "%-42s  \[0x0E0000-0x0E007F\]\n" [_ "Tags"]];
	AppendToTextDisplay $po [format "%-42s  \[0x001950-0x00197F\]\n" [_ "Tai Le"]];
	AppendToTextDisplay $po [format "%-42s  \[0x01D300-0x01D35F\]\n" [_ "Tai Xuan Jing Symbols"]];
	AppendToTextDisplay $po [format "%-42s  \[0x000B80-0x000BFF\]\n" [_ "Tamil"]];
	AppendToTextDisplay $po [format "%-42s  \[0x000C00-0x000C7F\]\n" [_ "Telugu"]];
	AppendToTextDisplay $po [format "%-42s  \[0x000780-0x0007BF\]\n" [_ "Thaana"]];
	AppendToTextDisplay $po [format "%-42s  \[0x000E00-0x000E7F\]\n" [_ "Thai"]];
	AppendToTextDisplay $po [format "%-42s  \[0x000F00-0x000FFF\]\n" [_ "Tibetan"]];
	AppendToTextDisplay $po [format "%-42s  \[0x010380-0x01039F\]\n" [_ "Ugaritic"]];
	AppendToTextDisplay $po [format "%-42s  \[0x000750-0x00077F\]\n" [_ "Undefined"]];
	AppendToTextDisplay $po [format "%-42s  \[0x0007C0-0x0008FF\]\n" [_ "Undefined"]];
	AppendToTextDisplay $po [format "%-42s  \[0x001380-0x00139F\]\n" [_ "Undefined"]];
	AppendToTextDisplay $po [format "%-42s  \[0x0018B0-0x0018FF\]\n" [_ "Undefined"]];
	AppendToTextDisplay $po [format "%-42s  \[0x001980-0x0019DF\]\n" [_ "Undefined"]];
	AppendToTextDisplay $po [format "%-42s  \[0x001A00-0x001CFF\]\n" [_ "Undefined"]];
	AppendToTextDisplay $po [format "%-42s  \[0x001D80-0x001DFF\]\n" [_ "Undefined"]];
	AppendToTextDisplay $po [format "%-42s  \[0x002C00-0x002E7F\]\n" [_ "Undefined"]];
	AppendToTextDisplay $po [format "%-42s  \[0x002FE0-0x002EEF\]\n" [_ "Undefined"]];
	AppendToTextDisplay $po [format "%-42s  \[0x0031C0-0x0031EF\]\n" [_ "Undefined"]];
	AppendToTextDisplay $po [format "%-42s  \[0x009FB0-0x009FFF\]\n" [_ "Undefined"]];
	AppendToTextDisplay $po [format "%-42s  \[0x00A4D0-0x00ABFF\]\n" [_ "Undefined"]];
	AppendToTextDisplay $po [format "%-42s  \[0x00D7B0-0x00D7FF\]\n" [_ "Undefined"]];
	AppendToTextDisplay $po [format "%-42s  \[0x00FE10-0x00FE1F\]\n" [_ "Undefined"]];
	AppendToTextDisplay $po [format "%-42s  \[0x010140-0x0102FF\]\n" [_ "Undefined"]];
	AppendToTextDisplay $po [format "%-42s  \[0x0104B0-0x0107FF\]\n" [_ "Undefined"]];
	AppendToTextDisplay $po [format "%-42s  \[0x010840-0x01CFFF\]\n" [_ "Undefined"]];
	AppendToTextDisplay $po [format "%-42s  \[0x01D200-0x01D2FF\]\n" [_ "Undefined"]];
	AppendToTextDisplay $po [format "%-42s  \[0x01D360-0x01D3FF\]\n" [_ "Undefined"]];
	AppendToTextDisplay $po [format "%-42s  \[0x01D800-0x01FFFF\]\n" [_ "Undefined"]];
	AppendToTextDisplay $po [format "%-42s  \[0x02A6E0-0x02F7FF\]\n" [_ "Undefined"]];
	AppendToTextDisplay $po [format "%-42s  \[0x001400-0x00167F\]\n" [_ "Unified Canadian Aboriginal Syllabics"]];
	AppendToTextDisplay $po [format "%-42s  \[0x02FAB0-0x0DFFFF\]\n" [_ "Unused"]];
	AppendToTextDisplay $po [format "%-42s  \[0x0E0080-0x0E00FF\]\n" [_ "Unused"]];
	AppendToTextDisplay $po [format "%-42s  \[0x0E01F0-0x0EFFFF\]\n" [_ "Unused"]];
	AppendToTextDisplay $po [format "%-42s  \[0x0FFFFE-0x0FFFFF\]\n" [_ "Unused"]];
	AppendToTextDisplay $po [format "%-42s  \[0x00FE00-0x00FE0F\]\n" [_ "Variation Selectors"]];
	AppendToTextDisplay $po [format "%-42s  \[0x0E0100-0x0E01EF\]\n" [_ "Variation Selectors Supplement"]];
	AppendToTextDisplay $po [format "%-42s  \[0x00A000-0x00A48F\]\n" [_ "Yi Syllables"]];
	AppendToTextDisplay $po [format "%-42s  \[0x00A490-0x00A4CF\]\n" [_ "Yi Radicals"]];
	AppendToTextDisplay $po [format "%-42s  \[0x004DC0-0x004DFF\]\n" [_ "Yijing Hexagram Symbols"]];
    }
}

proc ToggleLicense {} {
    if {[winfo exists $::OtherPopups(ShowGPL)] == 0} {
	ShowGPL;
    } else {
	destroy $::OtherPopups(ShowGPL);
    }
}

proc UpdateUnicodeRangeSort {} {
    if {[winfo exists $::OtherPopups(ShowUnicodeRanges)]} {
	destroy $::OtherPopups(ShowUnicodeRanges);
	ShowUnicodeRanges;
    }
}

proc ToggleUnicodeGCP {} {
    if {[winfo exists $::OtherPopups(ShowUnicodeGCP)] == 0} {
	ShowUnicodeGCP;
    } else {
	destroy $::OtherPopups(ShowUnicodeGCP);
    }
}

proc ToggleUnicodeRanges {} {
    if {[winfo exists $::OtherPopups(ShowUnicodeRanges)] == 0} {
	ShowUnicodeRanges;
    } else {
	destroy $::OtherPopups(ShowUnicodeRanges);
    }
}

proc ToggleDescribeKeyBindings {} {
    if {[winfo exists $::OtherPopups(DescribeKeyBindings)] == 0} {
	DescribeKeyBindings;
    } else {
	destroy $::OtherPopups(DescribeKeyBindings);
    }
}

proc ToggleComparisonWindow {} {
    global ComparisonWindowDisplayedP;
    global MenuIndex;
    global m;

    if {$ComparisonWindowDisplayedP} {
	set ComparisonWindowDisplayedP 0;
	$m.file.comp entryconfigure $MenuIndex(ToggleComparisonWindow) -label [_ "Display Comparison Window"];
    } else {
	set ComparisonWindowDisplayedP 1;
	$m.file.comp entryconfigure $MenuIndex(ToggleComparisonWindow) -label [_ "Hide Comparison Window"];
    }
    LayoutWindows;
}


proc ListWindows {} {
    global Wlist;

    foreach key [lsort [array names Wlist]] {
	puts $Wlist($key);
    }
}


proc SaveColorConfiguration {} {
    global ColorSpecs;
    global ColorFullPath;

    if {[catch {open $ColorFullPath "w"} ColorHandle ] != 0} {
	ShowMessage [format [_ "Unable to open %s."] $ColorFullPath];
	return
    }
    foreach key [lsort [array names ColorSpecs]] {
	set pair [split $key ","];
	set win [lindex $pair 0];
	set which [lindex $pair 1];
	puts $ColorHandle [format "%-12s\t%12s\t%s" $win $which $ColorSpecs($win,$which)];
    }
    close $ColorHandle;
}

proc new_dialog_create {class {win "auto"}} {
    if {$win == "auto"} {
        set count 0
        set win ".ndialog[incr count]"
        while {[winfo exists $win]} {
            set win ".ndialog[incr count]"
        }
    }
    toplevel $win -class $class;
    frame $win.info
    pack $win.info -expand yes -fill both -padx 4 -pady 4
    wm title $win $class
    wm group $win .

    after idle [format {
        update idletasks
        wm minsize %s [winfo reqwidth %s] [winfo reqheight %s]
    } $win $win $win]

    return $win
}

# The following code is taken from the Efftcl library by Mark Harrison and
# Michael McLennan, copyrighted by Mark Harrison and Lucent Technologies, available
# from http://www.awprofessional.com/content/images/0201634740/sourcecode/efftcl.zip.
# As the authors explicitly give permission to "steal the code for your own applications"
# the relevant portions are included here so as not to require the user to install
# to install the library. If you install the library, remove the following and
# uncomment the line "#package require Efftcl" by deleting the crosshatch.

#  Effective Tcl/Tk Programming
#    Mark Harrison, DSC Communications Corp.
#    Michael McLennan, Bell Labs Innovations for Lucent Technologies
#    Addison-Wesley Professional Computing Series
# ======================================================================
#  Copyright (c) 1996-1997  Lucent Technologies Inc. and Mark Harrison
# ======================================================================

proc dialog_create {class {win "auto"}} {
    if {$win == "auto"} {
        set count 0
        set win ".dialog[incr count]"
        while {[winfo exists $win]} {
            set win ".dialog[incr count]"
        }
    }
    toplevel $win -class $class -background \#2200DD;

    frame $win.info
    pack $win.info -expand yes -fill both -padx 4 -pady 4
    frame $win.sep -height 2 -borderwidth 1 -relief sunken
    pack $win.sep -fill x -pady 4
    frame $win.controls
    pack $win.controls -fill x -padx 4 -pady 1

    wm title $win $class
    wm group $win .

    after idle [format {
        update idletasks
        wm minsize %s [winfo reqwidth %s] [winfo reqheight %s]
    } $win $win $win]

    return $win
}

proc dialog_info {win} {
    return "$win.info"
}

proc dialog_controls {win} {
    return "$win.controls"
}

proc dialog_wait {win varName} {
    dialog_safeguard $win

    set x [expr [winfo rootx .]+50]
    set y [expr [winfo rooty .]+50]
    wm geometry $win "+$x+$y"

    wm deiconify $win
    grab set $win

    vwait $varName

    grab release $win
    wm withdraw $win
}

bind modalDialog <ButtonPress> {
    wm deiconify %W
    raise %W
}
proc dialog_safeguard {win} {
    if {[lsearch [bindtags $win] modalDialog] < 0} {
        bindtags $win [linsert [bindtags $win] 0 modalDialog]
    }
}

set OtherPopups(ShowGPL) "";
proc ShowGPL {} {
    if {[winfo exists $::OtherPopups(ShowGPL)]} {
	raise $::OtherPopups(ShowGPL);
	return ;
    }
    set GPLPopup [CreateTextDisplay [_ "License"] 70 24]
    set ::OtherPopups(ShowGPL) $GPLPopup;
    BindKeys $GPLPopup;
    AppendToTextDisplay $GPLPopup [format "%s%s" [format "%s\n\t%s\n" [_ "For this license in your language see:"] [_ "http://www.gnu.org/copyleft/gpl.html"]]  "\
\

		    GNU GENERAL PUBLIC LICENSE\

   TERMS AND CONDITIONS FOR COPYING, DISTRIBUTION AND MODIFICATION
\

  0. This License applies to any program or other work which contains
a notice placed by the copyright holder saying it may be distributed
under the terms of this General Public License.  The \"Program\", below,
refers to any such program or work, and a \"work based on the Program\"
means either the Program or any derivative work under copyright law:
that is to say, a work containing the Program or a portion of it,
either verbatim or with modifications and/or translated into another
language.  (Hereinafter, translation is included without limitation in
the term \"modification\".)  Each licensee is addressed as \"you\".
\

Activities other than copying, distribution and modification are not
covered by this License; they are outside its scope.  The act of
running the Program is not restricted, and the output from the Program
is covered only if its contents constitute a work based on the
Program (independent of having been made by running the Program).
Whether that is true depends on what the Program does.
\

  1. You may copy and distribute verbatim copies of the Program's
source code as you receive it, in any medium, provided that you
conspicuously and appropriately publish on each copy an appropriate
copyright notice and disclaimer of warranty; keep intact all the
notices that refer to this License and to the absence of any warranty;
and give any other recipients of the Program a copy of this License
along with the Program.
\

You may charge a fee for the physical act of transferring a copy, and
you may at your option offer warranty protection in exchange for a fee.
\

  2. You may modify your copy or copies of the Program or any portion
of it, thus forming a work based on the Program, and copy and
distribute such modifications or work under the terms of Section 1
above, provided that you also meet all of these conditions:
\

    a) You must cause the modified files to carry prominent notices
    stating that you changed the files and the date of any change.
\

    b) You must cause any work that you distribute or publish, that in
    whole or in part contains or is derived from the Program or any
    part thereof, to be licensed as a whole at no charge to all third
    parties under the terms of this License.
\

    c) If the modified program normally reads commands interactively
    when run, you must cause it, when started running for such
    interactive use in the most ordinary way, to print or display an
    announcement including an appropriate copyright notice and a
    notice that there is no warranty (or else, saying that you provide
    a warranty) and that users may redistribute the program under
    these conditions, and telling the user how to view a copy of this
    License.  (Exception: if the Program itself is interactive but
    does not normally print such an announcement, your work based on
    the Program is not required to print an announcement.)
\

These requirements apply to the modified work as a whole.  If
identifiable sections of that work are not derived from the Program,
and can be reasonably considered independent and separate works in
themselves, then this License, and its terms, do not apply to those
sections when you distribute them as separate works.  But when you
distribute the same sections as part of a whole which is a work based
on the Program, the distribution of the whole must be on the terms of
this License, whose permissions for other licensees extend to the
entire whole, and thus to each and every part regardless of who wrote it.
\

Thus, it is not the intent of this section to claim rights or contest
your rights to work written entirely by you; rather, the intent is to
exercise the right to control the distribution of derivative or
collective works based on the Program.
\

In addition, mere aggregation of another work not based on the Program
with the Program (or with a work based on the Program) on a volume of
a storage or distribution medium does not bring the other work under
the scope of this License.
\

  3. You may copy and distribute the Program (or a work based on it,
under Section 2) in object code or executable form under the terms of
Sections 1 and 2 above provided that you also do one of the following:
\

    a) Accompany it with the complete corresponding machine-readable
    source code, which must be distributed under the terms of Sections
    1 and 2 above on a medium customarily used for software interchange; or,
\

    b) Accompany it with a written offer, valid for at least three
    years, to give any third party, for a charge no more than your
    cost of physically performing source distribution, a complete
    machine-readable copy of the corresponding source code, to be
    distributed under the terms of Sections 1 and 2 above on a medium
    customarily used for software interchange; or,
\

    c) Accompany it with the information you received as to the offer
    to distribute corresponding source code.  (This alternative is
    allowed only for noncommercial distribution and only if you
    received the program in object code or executable form with such
    an offer, in accord with Subsection b above.)
\

The source code for a work means the preferred form of the work for
making modifications to it.  For an executable work, complete source
code means all the source code for all modules it contains, plus any
associated interface definition files, plus the scripts used to
control compilation and installation of the executable.  However, as a
special exception, the source code distributed need not include
anything that is normally distributed (in either source or binary
form) with the major components (compiler, kernel, and so on) of the
operating system on which the executable runs, unless that component
itself accompanies the executable.
\

If distribution of executable or object code is made by offering
access to copy from a designated place, then offering equivalent
access to copy the source code from the same place counts as
distribution of the source code, even though third parties are not
compelled to copy the source along with the object code.
\

  4. You may not copy, modify, sublicense, or distribute the Program
except as expressly provided under this License.  Any attempt
otherwise to copy, modify, sublicense or distribute the Program is
void, and will automatically terminate your rights under this License.
However, parties who have received copies, or rights, from you under
this License will not have their licenses terminated so long as such
parties remain in full compliance.
\

  5. You are not required to accept this License, since you have not
signed it.  However, nothing else grants you permission to modify or
distribute the Program or its derivative works.  These actions are
prohibited by law if you do not accept this License.  Therefore, by
modifying or distributing the Program (or any work based on the
Program), you indicate your acceptance of this License to do so, and
all its terms and conditions for copying, distributing or modifying
the Program or works based on it.
\

  6. Each time you redistribute the Program (or any work based on the
Program), the recipient automatically receives a license from the
original licensor to copy, distribute or modify the Program subject to
these terms and conditions.  You may not impose any further
restrictions on the recipients' exercise of the rights granted herein.
You are not responsible for enforcing compliance by third parties to
this License.
\

  7. If, as a consequence of a court judgment or allegation of patent
infringement or for any other reason (not limited to patent issues),
conditions are imposed on you (whether by court order, agreement or
otherwise) that contradict the conditions of this License, they do not
excuse you from the conditions of this License.  If you cannot
distribute so as to satisfy simultaneously your obligations under this
License and any other pertinent obligations, then as a consequence you
may not distribute the Program at all.  For example, if a patent
license would not permit royalty-free redistribution of the Program by
all those who receive copies directly or indirectly through you, then
the only way you could satisfy both it and this License would be to
refrain entirely from distribution of the Program.
\

If any portion of this section is held invalid or unenforceable under
any particular circumstance, the balance of the section is intended to
apply and the section as a whole is intended to apply in other
circumstances.
\

It is not the purpose of this section to induce you to infringe any
patents or other property right claims or to contest validity of any
such claims; this section has the sole purpose of protecting the
integrity of the free software distribution system, which is
implemented by public license practices.  Many people have made
generous contributions to the wide range of software distributed
through that system in reliance on consistent application of that
system; it is up to the author/donor to decide if he or she is willing
to distribute software through any other system and a licensee cannot
impose that choice.
\

This section is intended to make thoroughly clear what is believed to
be a consequence of the rest of this License.
\

  8. If the distribution and/or use of the Program is restricted in
certain countries either by patents or by copyrighted interfaces, the
original copyright holder who places the Program under this License
may add an explicit geographical distribution limitation excluding
those countries, so that distribution is permitted only in or among
countries not thus excluded.  In such case, this License incorporates
the limitation as if written in the body of this License.
\

  9. The Free Software Foundation may publish revised and/or new versions
of the General Public License from time to time.  Such new versions will
be similar in spirit to the present version, but may differ in detail to
address new problems or concerns.
\

Each version is given a distinguishing version number.  If the Program
specifies a version number of this License which applies to it and \"any
later version\", you have the option of following the terms and conditions
either of that version or of any later version published by the Free
Software Foundation.  If the Program does not specify a version number of
this License, you may choose any version ever published by the Free Software
Foundation.
\

  10. If you wish to incorporate parts of the Program into other free
programs whose distribution conditions are different, write to the author
to ask for permission.  For software which is copyrighted by the Free
Software Foundation, write to the Free Software Foundation; we sometimes
make exceptions for this.  Our decision will be guided by the two goals
of preserving the free status of all derivatives of our free software and
of promoting the sharing and reuse of software generally.
\

			    NO WARRANTY
\

  11. BECAUSE THE PROGRAM IS LICENSED FREE OF CHARGE, THERE IS NO WARRANTY
FOR THE PROGRAM, TO THE EXTENT PERMITTED BY APPLICABLE LAW.  EXCEPT WHEN
OTHERWISE STATED IN WRITING THE COPYRIGHT HOLDERS AND/OR OTHER PARTIES
PROVIDE THE PROGRAM \"AS IS\" WITHOUT WARRANTY OF ANY KIND, EITHER EXPRESSED
OR IMPLIED, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF
MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE.  THE ENTIRE RISK AS
TO THE QUALITY AND PERFORMANCE OF THE PROGRAM IS WITH YOU.  SHOULD THE
PROGRAM PROVE DEFECTIVE, YOU ASSUME THE COST OF ALL NECESSARY SERVICING,
REPAIR OR CORRECTION.
\

  12. IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN WRITING
WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MAY MODIFY AND/OR
REDISTRIBUTE THE PROGRAM AS PERMITTED ABOVE, BE LIABLE TO YOU FOR DAMAGES,
INCLUDING ANY GENERAL, SPECIAL, INCIDENTAL OR CONSEQUENTIAL DAMAGES ARISING
OUT OF THE USE OR INABILITY TO USE THE PROGRAM (INCLUDING BUT NOT LIMITED
TO LOSS OF DATA OR DATA BEING RENDERED INACCURATE OR LOSSES SUSTAINED BY
YOU OR THIRD PARTIES OR A FAILURE OF THE PROGRAM TO OPERATE WITH ANY OTHER
PROGRAMS), EVEN IF SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE
POSSIBILITY OF SUCH DAMAGES."]
}

#Write out a list of init file commands that will reconstruct
#the current configuration 
proc SaveState {{SaveFile Ask}} {
    if {[string equal $SaveFile Ask]} { 
	set SaveFile [tk_getSaveFile -initialfile [_ "SavedState"]];
	if {$SaveFile == ""} {
	    ShowMessage [_ "File selection cancelled."]
	    return ;
	}
    }
    if {[catch {open $SaveFile "w"} fh ] != 0} {
	ShowMessage [format [_ "Unable to open file %s."] [MinimizeFileName $SaveFile]];
	return ;
    }
    set cl [concat \
	[list [format "\#%s" [clock format [clock seconds]]]] \
	[list [format "\#%s" [_ Fonts]]] \
	[fontsel::SaveFontSettings] \
	[list [format "\#%s" [_ Colors]]] \
	[SaveColorSettings] \
	[list [format "\#%s" [_ "Palette Entries"]]] \
	[SavePaletteEntries] \
	[list [format "\#%s" [_ Miscellaneous]]] \
	[SaveMiscellaneousSettings]];
    foreach x $cl {
	puts $fh $x;
    }
    close $fh;
    ShowMessage [format [_ "The configuration has been saved in file %s."] \
		     [MinimizeFileName $SaveFile]]
}

proc Usage {} {
    puts {Usage: redet [options] (<input text file>)};
    puts [_ "    -c <file>     read character class definitions from <file>"];
    puts [_ "    -d            set debug flag"];
    puts [_ "    -F <file>     read a feature list from <file>"];
    puts [_ "    -f            act as filter"];
    puts [_ "    -H            do not read history file"];
    puts [_ "    -h            help"];
    puts [_ "    -i            do not read init file"];
    puts [_ "    -l <locale>   internally set the locale to <locale>"];
    puts [_ "    -n            do not execute feature tests"];
    puts [_ "    -p <program>  use <program>"];
    puts [_ "    -s            start up in substitution mode"];
    puts [_ "    -t            show results of feature tests"];
    puts [_ "    -v            version"];
}

proc PopupTestPatiencePlacard {txt ForbidAbortP} {
    global ColorSpecs;

    toplevel .placard -borderwidth 4 -relief raised  -bg $ColorSpecs(Placard,Background)
    wm title .placard [_ "Feature Test Progress"];
    after idle {
	update idletasks
	set xmax [winfo screenwidth .placard]
	set ymax [winfo screenheight .placard]
	set x0 [expr int(2.4 * ($xmax -[winfo reqwidth .placard])/3.0)];
	set y0 [expr int(2.3 * ($ymax -[winfo reqheight .placard])/3.0)];
	wm geometry .placard "+$x0+$y0";
    }
    label .placard.title -text $txt -bg $ColorSpecs(Placard,Background) -fg $ColorSpecs(Placard,Foreground)
    button .placard.dismiss -text [_ "Abort"] -command AbortFeatureTests;
    Progress .placard.progbar;
    label .placard.time -text [format [_ "time elapsed: %1d minutes %2d seconds\nestimated total time: ? minutes  ? seconds\nestimated time remaining: ? minutes  ? seconds"] 0 0]\
	-bg $ColorSpecs(Placard,Background) -fg $ColorSpecs(Placard,Foreground)
    pack .placard.title -side top -fill x -padx 8 -pady 8;
    pack .placard.time -side top  -fill x -padx 8 -pady 8;
    pack .placard.progbar -side left -fill both -expand 1;
    if {!$ForbidAbortP} {
	pack .placard.dismiss -side right;
    }
    catch {.placard.title configure -font -*-Courier-bold-o-normal--*-140-*}
    catch {.placard.time configure -font -*-Courier-bold-o-normal--*-130-*}
}

proc AbortFeatureTests {} {
    if {$::FirstTestP} {
	ShowMessage [_ "The initial test run cannot be aborted."]
	return ;
    }
    set ::AbortFeatureTestP 1;
    set killpid $::tk_exec_pipe(pid)
    # We give the daughter a chance to exit nicely
    # before terminating with extreme prejudice.
    if {$::tcl_platform(platform) eq "unix"} {
	catch {[exec kill -s TERM $killpid]}
	after 10 {
	    catch {[exec kill -s KILL $killpid]}
	}
    }
}

proc AbortSearch {} {
    if {$::TestingFeaturesP} {
	AbortFeatureTests;
	return ;
    }
    if {$::tcl_platform(platform) eq "unix"} {
	set killpid $::tk_exec_pipe(pid)
	# We give the daughter a chance to exit nicely
	# before terminating with extreme prejudice.
	catch {[exec kill -s TERM $killpid]}
	after 10 {
	    catch {[exec kill -s KILL $killpid]}
	}
    }
    if {$::DoSubstitutionsP} {
	set msg [_ "Substitution aborted by user."]
    } else {
	set msg [_ "Search aborted by user."]
    }
    ShowMessage $msg;
}

proc PopupAlert {name txt} {
    global ColorSpecs;

    destroy .alert_$name;
    toplevel .alert_$name -borderwidth 4 -relief raised -bg $ColorSpecs(Alert,Background)
    wm overrideredirect .alert_$name 1;
    label .alert_$name.title -text $txt -bg  $::ColorSpecs(Alert,Background) -fg $::ColorSpecs(Alert,Foreground);
    button .alert_$name.dismiss -text [_ "Dismiss"] -bg $::ColorSpecs(AlertDismiss,Background) -fg $::ColorSpecs(AlertDismiss,Foreground) -command "destroy .alert_$name";
    pack .alert_$name.title -side top -fill x -padx 8 -pady 8;
    pack .alert_$name.dismiss -side right;
    catch {.alert_$name.title configure -font -*-Courier-bold-o-normal--*-180-*}
}


proc PopupActualRegexp {} {
    global MainWidth;
    global MainFont;
    toplevel .art -borderwidth 4 -relief raised
    wm title .art ""
    after idle {
	update idletasks
	set xmax [winfo screenwidth .art]
	set ymax [winfo screenheight .art]
	set x0 [expr 2 * ($xmax -[winfo reqwidth .art])/3];
	set y0 [expr 2 * ($ymax -[winfo reqheight .art])/3];
	wm geometry .art "+$x0+$y0";
    }
    label .art.title -text [_ "Regular Expression Actually Executed"];
    pack .art.title -side top -fill x -padx 8 -pady 8;
    text .art.txt -width $MainWidth -height 3 -font MainFont -exportselection 1;
    pack .art.txt -side top -fill x -padx 8 -pady 8;
    catch {.art.title configure -font -*-Courier-bold-o-normal--*-180-*}
    BindKeys .art;
}

proc ToggleActualRegexp {} {
    global PreviousActualRegexp;
    global DisplayActualRegexpIndex;
    global DescribeDisplayActualRegexpIndex;
    global m;

    if {[winfo exists .art]} {
	destroy .art;
	$m.tools.classes entryconfigure $DisplayActualRegexpIndex -label [_ "Display Regular Expression Actually Executed"];
    } else {
	PopupActualRegexp;
	DisplayActualRegexp $PreviousActualRegexp;
	$m.tools.classes entryconfigure $DisplayActualRegexpIndex -label [_ "Do Not Display Regular Expression Actually Executed"];
    }
}

proc DisplayActualRegexp {are} {
    if {[winfo exists .art.txt]} {
	.art.txt delete 1.0 end;
	.art.txt insert 1.0 $are;
    }
}

#Put a title in the frame.
proc SetTitle {version TimeStamp locale dosubsp} {
    if {$dosubsp} {
	set mode [_ "Substitution Mode"];
    } else {
	set mode [_ "Match Mode"];
    }
    if {$::DebugP} {
	wm title . [format "Redet %s \[%s\]      %s        %s" $version $TimeStamp $locale $mode];
    } else {
	wm title . [format "Redet %s       %s        %s" $version $locale $mode];
    }

}

proc LoadMessageCatalog {} {
    global DebugP;

    if { $DebugP } {
	if { [::msgcat::mcload "msgs"] == 0} {
	    puts "No message catalog loaded."
	} else {
	    puts "Message catalog loaded."
	}
    } else  {
	::msgcat::mcload [file join [file dirname [info script]] msgs];
    }
}

#Set up balloon help
option add *Balloonhelp*background white widgetDefault
option add *Balloonhelp*foreground black widgetDefault
option add *Balloonhelpinfo.wrapLength 3i  widgetDefault
option add *Balloonhelp.info.justify left widgetDefault
toplevel .balloonhelp -class Balloonhelp -background black -borderwidth 1 -relief flat
#label .balloonhelp.arrow -anchor nw -bitmap @arrow.xbm
#pack .balloonhelp.arrow -side left -fill y
label .balloonhelp.info -font BalloonHelpFont;
pack .balloonhelp.info -side left -fill y
wm overrideredirect .balloonhelp 1
wm withdraw .balloonhelp
set bhInfo(active) 1

proc balloonhelp_control {state} {
     global bhInfo
     if {$state} {
          set bhInfo(active) 1
     } else {
	balloonhelp_cancel
	set bhInfo(active) 0
     }
}

proc balloonhelp_for {win mesg} {
    global bhInfo
    set bhInfo($win) $mesg
    set ::bhOverlapP($win) 1; 
    bind $win <Enter> {+balloonhelp_pending %W}
    bind $win <Leave> {+balloonhelp_cancel}
}

proc balloonhelpd_for {win mesg} {
    global bhInfo
    set ::bhOverlapP($win) 0;
    set bhInfo($win) $mesg
    bind $win <Enter> {+balloonhelp_show %W}
}

proc balloonhelp_pending {win} {
     global bhInfo
     balloonhelp_cancel
     set bhInfo(pending) [after 1000 [list balloonhelp_show $win]]
}

proc balloonhelp_cancel {} {
    global bhInfo
    if { [info exists bhInfo(pending)]} {
	after cancel $bhInfo(pending)
	unset bhInfo(pending)
    }
    wm withdraw .balloonhelp
}

proc balloonhelp_show {win} {
    global bhInfo;
    global bhOverlapP;
    if {[info exists bhOverlapP($win)]} {
	if {$bhOverlapP($win)} {
	    set Overlap 25;
	} else {
	    set Overlap -10;
	}
	if {[winfo exists $win]} {
	    if {$bhInfo(active)} {
		.balloonhelp.info configure -text $bhInfo($win) -font BalloonHelpFont
		#Set abcissa
		set MaxStringWidth 0;
		foreach line [split $bhInfo($win) "\n"] {
		    set StringWidth [font measure BalloonHelpFont -displayof .balloonhelp.info $line]
		    if {$StringWidth > $MaxStringWidth} {
			set MaxStringWidth $StringWidth;
		    }
		}
		set ScreenWidth [winfo screenwidth $win]
		set Width [winfo width $win];
		set LeftEdge  [winfo rootx $win];
		set RightEdge [expr $LeftEdge + $Width];
		if {$ScreenWidth - $RightEdge < $MaxStringWidth} { 
		    if {$LeftEdge > $MaxStringWidth} {
			set x [expr $LeftEdge - $MaxStringWidth + $Overlap];
		    } else {
			if {$ScreenWidth - $MaxStringWidth > 0} {
			    set x [expr $RightEdge - $MaxStringWidth];
			} else {
			    set x [expr $ScreenWidth - $MaxStringWidth];
			}
		    }
		} else {
		    set x [expr $RightEdge - $Overlap];
		}
		#Set ordinate
		set Height [winfo height $win];
		set TopEdge [winfo rooty $win];
		set y [expr $TopEdge + ($Height/2)];
		wm geometry .balloonhelp +$x+$y
		wm deiconify .balloonhelp
		raise .balloonhelp
	    }
	}
    }
	if {[info exist bhInfo(pending)]} {
	    unset bhInfo(pending)
	}
    }

    proc GotoStandardLayout {} {
	if {$::DoSubstitutionsP} {
	    if {!$::RegSubSideBySideP || !$::SideBySideLayoutP} {
		set ::SideBySideLayoutP 1;
		set ::RegSubSideBySideP 1;
		LayoutWindows;
	    }
	} else {
	    if {$::RegSubSideBySideP || $::SideBySideLayoutP} {
		set ::SideBySideLayoutP 0;
		set ::RegSubSideBySideP 0;
		LayoutWindows;
	    }
	}
    }

proc UpdateScrollbars {} {
    LayoutWindows;
    hist::ConstructHistory;
    ConstructPalette;
    ConstructUserClassPalette;
}

#Need to complete this when we allow user configuration of key bindings.
#This needs to be called when we change locale so as to change the
#translations. 
proc SetCommandGlosses {} {
    global CommandGlosses;

    set Pairs [list\
	   AbortSearch "[_ "Abort the search or substitution in progress."]"\
	   ToggleIPAA "[_ "Toggle the accented letter entry widget."]"\
	   ClearRegexp "[_ "Clear Regular Expression"]"\
	   ClearInput  "[_ "Clear Test Data"]"\
	   ClearOutput "[_ "Clear Results"]"\
	   ExecuteRegexp "[_ "Execute Regular Expression"]"\
    	  resc::PopupCachedEntries 	"[_ "Pop up a control panel for manipulating stored results"]"\
	   search::SearchTestData  "[_ "Search the Test Data"]"\
	   search::SearchResults  "[_ "Search the Results"]"\
           PopupCurrentProgramControls    "[_ "Popup the Control Panel for the Current Program"]"\
	   ToggleIPAC "[_ "Toggle the IPA consonant entry widget."]"\
	   ToggleIPAV "[_ "Toggle the IPA vowel entry widget."]"\
	   ToggleIPAD "[_ "Toggle the IPA diacritic entry widget."]"\
	   GotoStandardLayout "[_ "Change to Standard Layout for this Mode."]"\
	   ToggleActualRegexp "[_ "Toggle Display of Regular Expression Actually Executed"]"\
	   ToggleBalloonHelp "[_ "Toggle Balloon Help"]"\
	   hist::ToggleHistory "[_ "Toggle History"]"\
	   ToggleDescribeKeyBindings "[_ "Toggle Key Binding Help"]"\
	   ToggleLicense "[_ "Toggle License"]"\
	   TogglePalette "[_ "Toggle Palette"]"\
	   ToggleSubstitutionMode  "[_ "Toggle Substitution Mode"]"\
	   ToggleUnicodeRanges "[_ "Toggle Unicode Ranges"]"\
	   ToggleUnicodeRangesByCodepoint "[_ "Toggle Sorting of Unicode Ranges by Codepoint"]"\
	   ToggleUserClassEntry	 "[_ "Toggle the Character Class Definition Tool"]"\
	   ShutDown "[_ "Quit"]"\
	   SaveOutput "[_ "Save Output"]"\
	   ToggleUnicodeGCP "[_ "Toggle Unicode General Character Properties"]"\
	   ToggleUserClassPalette "[_ "Toggle User Class Palette"]"]
    array set CommandGlosses $Pairs;
}

proc SelectLocale {} {
    global ProposedLocale;
    global LocaleText;
    global LocaleListHeight;

    catch {set LocaleText [exec locale -a]};
    set LocaleList [split $LocaleText "\n"];

    #See if there are any locales.
    if {$LocaleList == 0} {
	ShowMessage [_ "No locales are available."];
	return 0;
    }
    if {[winfo exists .loclist] == 0} {
	toplevel .loclist;
    }
    wm title .loclist [_ "Available Locales"];
    wm withdraw .loclist;
    destroy .loclist.lbf.lb;
    label .loclist.lab -text [_ "Select Locale"];
    frame .loclist.lbf
    listbox .loclist.lbf.lb -height $LocaleListHeight -width 0 -font MainFont \
	-yscrollcommand {.loclist.lbf.sb set}  -font MainFont \
	-fg $::ColorSpecs(PaletteGloss,Foreground) \
	-bg $::ColorSpecs(PaletteGloss,Background);
    scrollbar .loclist.lbf.sb -command {.loclist.lbf.lb yview} \
	-troughcolor $::ColorSpecs(PaletteGloss,Background) \
	-bg $::ColorSpecs(PaletteGloss,Background);
    bind .loclist.lbf.sb <<B3>> "ScrollbarMoveBigIncrement .loclist.lbf.sb 0.20 %x %y"
    foreach line $LocaleList {
	.loclist.lbf.lb insert end $line;
    }
    bind .loclist.lbf.lb <<B3>> {
	set ProposedLocale [.loclist.lbf.lb get active];
#	balloonhelp_cancel;
	destroy .loclist;
    }
    pack .loclist.lab -side top -expand 1  -fill both;
    pack .loclist.lbf.lb -side left -expand 1 -fill both -padx 5
    if {$::UseScrollbarsP} {
	pack .loclist.lbf.sb -side right -expand 1 -fill y;
    }
    pack .loclist.lbf -expand 1 -fill both
    button .loclist.cancel -text [_ "Cancel"] -command {destroy .loclist}
    button .loclist.proceed -text [_ "Save New Locale"] -command {set ::ProposedLocale [.loclist.lbf.lb get active];destroy .loclist};
    pack .loclist.cancel   -side left -expand yes -fill x;
    pack .loclist.proceed  -side left -expand yes -fill x;
    BindKeys .loclist;
    balloonhelp_for .loclist.lbf.lb  [_ "Right click to select new locale."]
    wm deiconify .loclist;
    grab set .loclist;
    tkwait window .loclist
}

proc SetLocale {loc} {
    set nl [::msgcat::mclocale $loc];
    if {$nl != 0} {
	# We don't use nl/Locale because msgcat downcases but some programs are case-sensitive.
	# GNU grep etc. support Unicode if the locale is zh_TW.UTF-8 but not zh_tw.utf-8.
	set ::env(LC_ALL) $loc;
	set ::env(LANGUAGE) $loc;
	return $loc
    }
    return "";
}

proc ChangeLocale {} {
    global Version;
    global Locale;
    global ProposedLocale;
    global Features;
    global Program;
    global program;
    global ProposedLocale;
    global FeatureTestDebugP;

    SelectLocale;
    if {[string equal $ProposedLocale ""]} {
	return;
    }
    set Locale [SetLocale $ProposedLocale];
    SetTitle $::Version [ProgramTimeDateStamp] $::Locale $::DoSubstitutionsP;
    LoadMessageCatalog;
    if { [FeaturesUnSetP $program $Locale] } {
	TestFeatures;
	LabelMenus;
	RefreshProginfo;
    }
    if {$FeatureTestDebugP} {
	puts "Locale is now $Locale";
	puts "Size of Features array [array size Features]";
    }
    SetCommandGlosses;
    SetFontGlossHelpTranslations;
    ConstructPalette;
    if {$Features(unicodebmp,$program,$Locale) == 1} {
	ShowMessage [format [_ "The new locale is %s. %s supports Unicode in this locale."] $Locale $Program];	
    } else {
	ShowMessage [format [_ "The new locale is %s. %s does not support Unicode in this locale."] $Locale $Program];
    }
    return ;
}

array set DefaultKeyBindings {
"<Control-a>"             ToggleIPAA
"<Control-b>" ToggleBalloonHelp
"<Control-d>"             ToggleIPAD
"<Control-E>"		  ToggleUserClassEntry
"<Control-e>"             ExecuteRegexp
"<Control-f>"		  ClearRegexp
"<Control-h>"             hist::ToggleHistory
"<Control-i>"             ToggleActualRegexp
"<Control-j>"             ToggleIPAC
"<Control-k>"             ToggleDescribeKeyBindings
"<Control-L>" 		  GotoStandardLayout
"<Control-l>"             ToggleUserClassPalette
"<Control-m>"             ToggleSubstitutionMode
"<Control-o>"             SaveOutput
"<Control-p>"             TogglePalette
"<Control-r>"             search::SearchResults
"<Control-u>"             search::SearchTestData
"<Control-w>"             ToggleIPAV
"<Control-z>"             resc::PopupCachedEntries
"<Control-x><Control-i>"  ClearInput
"<Control-x><Control-o>"  ClearOutput
"<Control-x><Control-q>"  ShutDown
"<KeyPress-F1>"	ToggleUnicodeRanges
"<KeyPress-F2>"  ToggleUnicodeGCP
"<KeyPress-F3>"  ToggleUnicodeRangesByCodepoint
"<KeyPress-F4>"  PopupCurrentProgramControls
"<KeyPress-F12>" AbortSearch
};

array set AltKeyBindings {
"<KeyPress-F1>"  ToggleUnicodeRangesByCodepoint
"<KeyPress-F2>"  ToggleBalloonHelp
"<KeyPress-F3>"   ClearRegexp
"<KeyPress-F4>"   ClearInput
"<KeyPress-F5>"  ClearOutput
"<KeyPress-F6>"	 ToggleUserClassEntry
"<KeyPress-F7>"  ExecuteRegexp
"<KeyPress-F8>"  hist::ToggleHistory
"<KeyPress-F9>"  ToggleActualRegexp
"<KeyPress-F11>" ToggleDescribeKeyBindings
"<KeyPress-F12>" ToggleUserClassPalette
"<Control-KeyPress-F1>"  TogglePalette
"<Control-KeyPress-F2>"  ToggleUnicodeRanges
"<Control-KeyPress-F3>"  SaveOutput
"<Control-KeyPress-F4>"  ToggleUnicodeGCP};


proc BindKeys {w {bl DefaultKeyBindings}} {
    upvar \#0 $bl kb;
    foreach KeySeq [array names kb] {
	bind $w $KeySeq $kb($KeySeq);
    }
}

proc SetRegReturnBinding {} {
    global DoSubstitutionsP;

    if {$DoSubstitutionsP} {
    	bind $::REG <Return> {focus -force $::SUB}
    } else {
	bind $::REG <Return> {ExecuteRegexp};
    }
}

proc ConfirmationDialog {WindowName TitleText MainText LeftText RightText} {
    global wret;
    global MainFont;
    
    toplevel $WindowName -borderwidth 4 -relief raised
    wm title $WindowName "";
    label  $WindowName.title -text $TitleText -font MainFont;
    text $WindowName.txt -width 60 -height 2 -font MainFont;
    $WindowName.txt insert insert $MainText;
    button $WindowName.okay   -text $RightText -command {set wret 1} -font MainFont;
    button $WindowName.cancel -text $LeftText  -command {set wret 0} -font MainFont;
    grid $WindowName.title     -row 0 -column 0 -sticky ew -columnspan 2
    grid $WindowName.txt     -row 1 -column 0 -sticky ew -columnspan 2
    grid $WindowName.cancel    -row 2 -column 0
    grid $WindowName.okay      -row 2 -column 1
    tkwait variable wret;
    destroy $WindowName;
    return $wret;
}

# This section provides user-defined character classes.

set UserClassCnt 0;
array set UserClasses {};
array set UserClassGlosses {};
set UserClassPaletteIsDisplayedP 0;
set UserClassPaletteToBeDisplayedP 1;
set MaxUserClassGlossLength 0;
set UserClassColumnSeparation 6;
set LeftUserClassDelimiter  {[_}; #This is what the user uses to insert classes.
set RightUserClassDelimiter {_]}; #This is what the user uses to insert classes.
set LUDlen [string length $LeftUserClassDelimiter];
set RUDlen [string length $RightUserClassDelimiter];
set LeftUserIntDelimiter {<};
set RightUserIntDelimiter {>};

proc ToggleUserClassesEnabled {} {
    global UserClassesEnabledP;
    global ToggleUserClassesEnabledIndex;
    global DescribeToggleUserClassesEnabledIndex;
    global m;

    if {$UserClassesEnabledP == 0} {
	set UserClassesEnabledP 1;
	ShowMessage [_ "User classes enabled."];
	$m.tools.classes entryconfigure $ToggleUserClassesEnabledIndex -label [_ "Disable User Classes"];
	CheckUserClassAvailability;
    } else {
	set UserClassesEnabledP 0;
	ShowMessage [_ "User classes disabled."];
	$m.tools.classes entryconfigure $ToggleUserClassesEnabledIndex -label  [_ "Enable User Classes"];
    }
}

# return a string comprised of the characters in the
# intersection of two strings S1 and S2
proc stringint { S1 S2 } {
#We begin by constructing two arrays whose indices are the characters
#in the input strings.
    set list1 [split $S1 ""];
    set list2 [split $S2 ""];
    array set set1 {}
    array set set2 {}
    foreach x $list1 {
	set set1($x) 1;
    }
    foreach x $list2 {
	set set2($x) 1;
    }
    #Now we actually find the intersection.
    array set intset {}
    foreach k [array names set2] {
	if {[info exists set1($k)]} then {
	    set intset($k) 1;
	}
    }
    #Now convert from array to list to string, sorting en passant.
    return [join [lsort [array names intset]] ""];
}


#This takes a cset and inserts any punctuation (dividers and quotation) required
#by the program for which it is destined.
proc FormatClass {Cset AltType} {

    set retlist [list];
    switch -exact -- $AltType {
	1 {
	    lappend retlist $Cset;
	}
	2 {
	    lappend retlist  [join [split $Cset ""] | ];
	}
	3 {
	    lappend retlist  [join [split $Cset ""] \\| ];
	}
	4 {
	    lappend retlist  [join [split $Cset ""] , ];
	}
	5 {
	    set letlist [split $Cset ""]
	    foreach x $letlist {
		lappend ql [format "\"%s\"" $x];
	    }
	    lappend retlist [join $ql |];
	}
	6 {
	    lappend retlist  [join [split $Cset ""] \\\\| ];
	}
	7 {
	    lappend retlist  [join [split $Cset ""] \\\\| ];
	}
    }
    return [join $retlist ""];
}

#It is probably best to provide user-settable flags governing the responses to:
#(a) unbalanced delimiters and
#(b) unrecognized character classes.
#Warnings should always be issued, but the user should be able to let them go
#so that it is possible to write regexps that contain such things as literals.

# Ways of handling alternation
# 0 Does not support alternation.
# 1 [ab]
# 2 (a|b)
# 3 (a\|b)
# 4 {a,b}
# 5 ("a"|"b")
# 6 (a\\|b)
# 7 \\(a\\|b\\)

#We first look for an intersection. If we find one, we take note of its
#location, process the material leading up to it, then process the
#intersection. Then we shift and do another iteration.
# return modified copy of regexp

proc InstantiateUserClasses {re AltType} {
    global LeftClassDelimiter;
    global RightClassDelimiter;
    global LeftUserClassDelimiter;
    global RightUserClassDelimiter;
    global LeftUserIntDelimiter;
    global RightUserIntDelimiter;
    global LUDlen;
    global RUDlen;

    set LIDlen [string length $LeftUserIntDelimiter];
    set RIDlen [string length $RightUserIntDelimiter];

    if { $AltType > 1 } {
	if {$AltType == 4} {
	   set LeftClassDelimiter  {\{} ;
  	   set RightClassDelimiter {\}} ;
	} elseif {$AltType == 7} {
	    set LeftClassDelimiter  {\\(} ;
   	    set RightClassDelimiter {\\)} ;
	} else {
	    set LeftClassDelimiter  {(} ;
   	    set RightClassDelimiter {)} ;
	}
    } else {
	set LeftClassDelimiter  {[} ;
        set RightClassDelimiter {]} ;
    }

    set ss $re;
    while {[string length $ss] > 0} {
	set IntResult "";
	set NoIntResult "";
	set ldloc [string first $LeftUserIntDelimiter $ss];
	set rdloc [expr [string length $ss] - $RIDlen]; #Effect is that by default we consume the whole string.
	
	if {$ldloc < 0} {
	    if {[catch {InstRegWithoutIntersections $ss $AltType $LUDlen $RUDlen} NoIntResult] !=0} {
		return "";
	    } else {
		lappend strlist $NoIntResult;
	    }
	} else {
	    set rdloc [string first $RightUserIntDelimiter $ss];
	    if {$rdloc >= 0} {
		#If we get here, we've found a potential class intersection.
		if { [catch {InstantiateClassIntersection [string range $ss $ldloc $rdloc] $AltType $LIDlen} IntResult] != 0} {
		    #This means that the region was not a well-formed intersection.
		    #We handle it as a region not containing an intersection, only shift the
		    # right boundary of that region to the right delimiter of the putative intersection.
		    set NoIntersectionRegionEnd $rdloc;
		} else {
		    set NoIntersectionRegionEnd [expr $ldloc -1];
		}
	    } else {
		set NoIntersectionRegionEnd [expr [string length $ss] -1];
		set rdloc $NoIntersectionRegionEnd;
	    }
	    # Handle region with no intersections
	    if { [catch {InstRegWithoutIntersections [string range $ss 0 $NoIntersectionRegionEnd] $AltType $LUDlen $RUDlen} NoIntResult] != 0 } {
		puts "Caught exception on InstRegWithoutIntersections";
		return "";
	    } else {
		lappend strlist $NoIntResult;
	    }

	    lappend strlist $IntResult;
	}
	set ss [string range $ss [expr $rdloc + $RIDlen] end];
    }
    return [join $strlist ""];
}


# We are passed a string that should contain two or more classes.
# We validate this and in the course of this obtain the parse.
# If validation fails, throw an error and catch it above.
# If validation succeeds, we instantiate each of the classes,
# and return their intersection.
proc InstantiateClassIntersection {is AltType LIDlen} {
    global UserClasses;
    global LeftClassDelimiter;
    global RightClassDelimiter;
    global LUDlen;
    global RUDlen;

    set is [string range $is $LIDlen end-1]; #Ignore delimiters.
    set pre {(\[_[^][]+_\])};
    set IndexPairList [regexp -all -inline -indices $pre $is];
    set Matches [llength $IndexPairList];
    if {$Matches} {
	#Each entry is a pair containing the beginning and ending indices of [_name_] in is.
	set subcnt 0;
	set SetList [list];
	foreach k $IndexPairList {
	    set Left [lindex $k 0]
	    if {$Left < 0} {
		break
	    }
	    set Right [lindex $k 1]
	    if {$Right < 0} {
		break
	    }
	    set Name [string range $is [expr $Left+$LUDlen] [expr $Right-$RUDlen]]
	    if { [info exists UserClasses($Name)] } {
		lappend SetList $UserClasses($Name);
		incr subcnt;
	    } else {
		ShowMessage [format [_ "Undefined character class %s"] $Name];
		error $Name;
	    }
	}
	set accum [lindex $SetList 0];
	for {set j 1} {$j < $subcnt} {incr j} {
	    set accum [stringint $accum [lindex $SetList $j] ];
	}
	lappend retlist $LeftClassDelimiter;
	lappend retlist [FormatClass $accum $AltType];
	lappend retlist $RightClassDelimiter;
	return [join $retlist ""];
    }
}


proc InstRegWithoutIntersections { re AltType LDlen RDlen} {
    global UserClasses;
    global LeftClassDelimiter;
    global RightClassDelimiter;
    global LeftUserClassDelimiter;
    global RightUserClassDelimiter;

    set strlist "";
    set ss $re;
    while {[string length $ss] > 0} {
	set ldloc [string first $LeftUserClassDelimiter $ss];
	if {$ldloc < 0} {
	    lappend strlist $ss;
	    break
	} 
	set rdloc [string first $RightUserClassDelimiter $ss];
	if {$rdloc < 0} {
	    lappend strlist $ss;
	    ShowMessage [format [_ "Warning: left class delimiter without right counterpart in %s"] $ss];
	    break ;
	}
	set ClassName [string range $ss [expr $ldloc+$LDlen] [expr $rdloc-1]]
	if { [info exists UserClasses($ClassName)] } {
	    lappend strlist [string range $ss 0 [expr $ldloc -1]]; # Copy string up to $ldloc.
	    lappend strlist $LeftClassDelimiter;
	    lappend strlist [FormatClass $UserClasses($ClassName) $AltType];
	    lappend strlist $RightClassDelimiter;
	} else {
	    ShowMessage [format [_ "Undefined character class %s"] $ClassName];
	    error $re;
	}
	set ss [string range $ss [expr $rdloc + $RDlen] end]
    }
    return [join $strlist ""];
}

proc ToggleUserClassPalette {} {
    global m;
    global UserClassCnt;
    global UserClassPaletteIsDisplayedP;
    global UserClassPaletteToBeDisplayedP;
    global ToggleUserClassPaletteIndex
    global DescribeToggleUserClassPaletteIndex;

    if { $UserClassPaletteIsDisplayedP == 0} {
	if {$UserClassCnt == 0} {
	    ShowMessage [_ "No character classes have been defined."]
	    return 
	}
	if {[winfo exists .ucpal.lb] == 0} {
	    ConstructUserClassPalette;
	}
	pack .ucpal.lb;
	wm deiconify .ucpal
	$m.tools.classes entryconfigure $ToggleUserClassPaletteIndex -label [_ "Do Not Display User-Defined Class Palette"];
	set UserClassPaletteIsDisplayedP 1;
	set UserClassPaletteToBeDisplayedP 1;
    } else {
	if {[winfo exists .ucpal] == 1} {
	    wm withdraw .ucpal;
	    if {[winfo exists .ucpal.lb] == 1} {
		pack forget .ucpal.lb;
	    }
	}
	$m.tools.classes entryconfigure $ToggleUserClassPaletteIndex -label [_ "Display User-Defined Class Palette"];
	set UserClassPaletteIsDisplayedP 0;
	set UserClassPaletteToBeDisplayedP 0;
    }
}

proc ShowUserClassPalette {} {
    global .ucpal;
    global UserClassPaletteDisplayedP;

    if {$::UseScrollbarsP} {
	pack .ucpal.sbar -side right -expand 0 -fill y;
    }  
    pack .ucpal.lb -side left -expand 1 -fill both;
    wm deiconify .ucpal
    set UserClassPaletteDisplayedP 1;
}

# Ignore leading + and - unless they are the only distinction between the strings.
proc ClassCompare {a b} {
    set cmp [string compare [string trimleft $a "+-"] [string trimleft $b "+-"]];
    if {$cmp != 0} {
	return $cmp;
    } else {
	return [string compare $a $b];
    }
}

proc ListUserClassFromMenu {} {
    global LUDlen;
    global RUDlen;
    set renot [GetClassSpecFromClassMenu [.ucpal.lb get active]];
    #We can be sure that ClassName is defined since  we got it from the palette.
    ListUserClass [string range $renot $LUDlen end-$RUDlen];
}

proc ListUserClass {ClassName} {
    global UserClasses;
    set MinWidth 30;

    set SortedList [lsort [split $UserClasses($ClassName) ""]];
    set CharCnt [llength $SortedList];
    set Cset [join $SortedList ""];
    if {$CharCnt < 60} {
	set Width $CharCnt;
    } else {
	set Width 60;
    }
    if {$Width < $MinWidth} { set Width $MinWidth;}
    if {$CharCnt <= $Width} {
	set Lines 1
    } else {
	set Lines 3;
    }
    set ClassListPopup [CreateTextDisplay [format [_ "Class %s"] $ClassName] $Width $Lines];
    BindKeys $ClassListPopup;
    AppendToTextDisplay $ClassListPopup $Cset;
    return $ClassListPopup;
}

proc ConstructUserClassPalette { } {
    global UserClasses;
    global UserClassGlosses;
    global UserClassPaletteIsDisplayedP;
    global UserClassPaletteToBeDisplayedP;
    global MaxUserClassPaletteHeight;
    global MaxUserClassGlossLength;
    global UserClassCnt;
    global UserClassColumnSeparation;
    global LeftUserClassDelimiter;
    global RightUserClassDelimiter;
    global program;

    set MaxUserClassPaletteHeight 10;

    destroy .ucpal.lb;
    destroy .ucpal.sbar
    if {$UserClassCnt == 0} {
	destroy .ucpal;
	return;
    }
    set UserClassPaletteIsDisplayedP 0;
    if {[winfo exists .ucpal] == 0} {
	toplevel .ucpal;
    }
    wm title .ucpal [_ "User Defined Named Character Classes"];
    wm withdraw .ucpal
    if {$UserClassCnt > $MaxUserClassPaletteHeight} {
	set lbentries $MaxUserClassPaletteHeight;
    } else {
	set lbentries 0;
    }
    if {[winfo exists .ucpal.lb] == 0} {
	listbox .ucpal.lb -height $lbentries -width 0 -font MainFont  \
	    -yscrollcommand {.ucpal.sbar set} -fg $::ColorSpecs(UserClassPalette,Foreground) \
	    -bg $::ColorSpecs(UserClassPalette,Background);
	scrollbar .ucpal.sbar -command {.ucpal.lb yview} \
	    -troughcolor $::ColorSpecs(UserClassPalette,Background) \
	    -bg $::ColorSpecs(UserClassPalette,Background);
    }
    bind .ucpal.lb <Double-ButtonPress-1> {
	ListUserClassFromMenu;
    }
    bind .ucpal.lb <<B3>> {
	$::REG insert insert [GetClassSpecFromClassMenu [.ucpal.lb get active]]
    }
    bind .ucpal.lb <Destroy> {
	set UserClassPaletteIsDisplayedP 0;
    }
    bind .ucpal.sbar <<B3>> "ScrollbarMoveBigIncrement .ucpal.sbar 0.25 %x %y"
    BindKeys .ucpal;
    set SortedList [lsort -command ClassCompare [array names UserClassGlosses]];
    foreach ClassName  $SortedList {
	.ucpal.lb insert end [format {%-*s %s%s%s} \
	   [expr $MaxUserClassGlossLength + $UserClassColumnSeparation] \
	  $UserClassGlosses($ClassName) $LeftUserClassDelimiter $ClassName \
		  $RightUserClassDelimiter];
    }
    balloonhelp_for .ucpal.lb [_ "Left click to select. Right click to insert into regular expression.\nDouble left click to display members of class."]
    if {$UserClassPaletteToBeDisplayedP} {
	ShowUserClassPalette;
    }
}

proc StoreUserClassDefinition {name cset gloss} {
    global UserClassCnt;
    global UserClasses;
    global UserClassGlosses;
    global MaxUserClassGlossLength;

    set UserClassGlosses($name) $gloss;
    set UserClasses($name) $cset;
    set lg [string length $gloss];
    # We keep track of the maximum length so we can use it to compute
    # the field width in the palette.
    if { $lg > $MaxUserClassGlossLength} {
	set MaxUserClassGlossLength $lg;
    }
    incr UserClassCnt;
    CheckUserClassAvailability;
}


proc DefineUserClassFromPopup {} {
    global YesNoResponse;
    global UserClasses;

    set redo 0;
    set name  [.udcentry.nameent get];
    set cset  [.udcentry.charent get];
    set gloss [.udcentry.glosent get];
    set nl [string length $name]
    set cl [string length $cset]
    set gl [string length $gloss]
    if {[expr $nl * $cl * $gl] == 0} {
	set redo 1;
	lappend msg [_ "Missing fields: "];
	if {$nl < 1} {
	    lappend msg [_ "name"];
	}
        if {$cl < 1} {
	    lappend msg [_ "characters"];
	}
	if {$gl < 1} {
	    lappend msg [_ "gloss"];
	}
	ShowMessage [join $msg];
    }
    destroy .udcentry;
    if {$redo == 0} {
	if {[info exists UserClasses($name)]} {
	    set SortedList [lsort [split $UserClasses($name) ""]];
	    set resp [ConfirmationDialog .udcconf [format [_ "You are about to redefine character class %s.\nHere is the current definition:\n"] $name] $SortedList [_ "Cancel Redefinition"] [_ "Proceed with Redefinition"]];
	    if {$resp == 0} {
		set redo 1;
		set name "";
	    }
	}
    }
    if {$redo == 1} {
	PopupUserClassEntry $name $cset $gloss;
    } else {
	StoreUserClassDefinition $name $cset $gloss;
	ShowMessage [format [_ "Definition of character class %s added."] $name];
	ConstructUserClassPalette;
    }
}

proc ToggleUserClassEntry {} {
    if {[winfo exists .udcentry]} {
	destroy .udcentry;
    } else {
	PopupUserClassEntry;
    }
}

option add *udcentry*Button.background $::ColorSpecs(PopupWidgetButton,Background) 100
option add *udcentry*Button.foreground $::ColorSpecs(PopupWidgetButton,Foreground) 100
option add *udcentry*Entry.background $::ColorSpecs(PopupWidgetEntry,Background) 100
option add *udcentry*Entry.foreground $::ColorSpecs(PopupWidgetEntry,Foreground) 100
option add *udcentry*Label.background $::ColorSpecs(PopupWidgetLabel,Background) 100
option add *udcentry*Label.foreground $::ColorSpecs(PopupWidgetLabel,Foreground) 100

proc PopupUserClassEntry {{name ""} {cset ""} {gloss ""} } {
    global MainFont;

    if {[winfo exists .udcentry]} {
	ShowMessage [_ "A class definition entry window is already popped up."]
	return;
    }
    toplevel .udcentry -borderwidth 4 -relief raised \
	-bg $::ColorSpecs(PopupWidgetDefault,Background)
    wm title .udcentry "";
    after idle {
	update idletasks
	set xmax [winfo screenwidth .udcentry]
	set ymax [winfo screenheight .udcentry]
	set x0 [expr 1 * ($xmax -[winfo reqwidth .udcentry])/3];
	set y0 [expr 1 * ($ymax -[winfo reqheight .udcentry])/3];
	wm geometry .udcentry "+$x0+$y0";
    }
    label  .udcentry.title -text [_ "Enter Character Class Definition"];
    label  .udcentry.namelab -text [format "%-12s" [_ "Name"]];
    entry  .udcentry.nameent -width 50 -font MainFont;
    .udcentry.nameent insert 0 $name;
    label  .udcentry.charlab  -text [format "%-12s" [_ "Characters"]];
    entry  .udcentry.charent -width 50 -font MainFont;
    .udcentry.charent insert 0 $cset;
    label  .udcentry.gloslab -text [format "%-12s" [_ "Gloss"]];
    entry  .udcentry.glosent -width 50 -font MainFont;
    .udcentry.glosent insert 0 $gloss;
    button .udcentry.okay   -text [_ "OK"]     -command DefineUserClassFromPopup;
    button .udcentry.cancel -text [_ "Cancel"] -command {destroy .udcentry}
    catch {.udcentry.title configure -font -*-Courier-bold-o-*--*-180-*}
    bind .udcentry.nameent <FocusIn> {SetInsertionTargets .udcentry.nameent}
    bind .udcentry.charent <FocusIn> {SetInsertionTargets .udcentry.charent}
    bind .udcentry.glosent <FocusIn> {SetInsertionTargets .udcentry.glosent}
    BindKeys .udcentry;

    grid .udcentry.title     -row 0 -column 0 -sticky ew -columnspan 3
    grid .udcentry.namelab   -row 1 -column 0
    grid .udcentry.nameent   -row 1 -column 1 -sticky w
    grid .udcentry.charlab   -row 2 -column 0
    grid .udcentry.charent   -row 2 -column 1 -sticky w
    grid .udcentry.gloslab   -row 3 -column 0
    grid .udcentry.glosent   -row 3 -column 1 -sticky w
    grid .udcentry.cancel    -row 4 -column 0
    grid .udcentry.okay      -row 4 -column 2
}

# Returns the number of fields found.
proc ParseUserClassEntry { def } {
    # First field is class name
    # Second field is set of characters
    # Third field is gloss

    set def [string trim $def];
    set tabloc1 [string first "\t" $def];
    if {$tabloc1 == -1} {
	return 1; 
    }
    set tabloc2 [string last "\t" $def];
    if {$tabloc1 == $tabloc2} {
	return 2;
    }
    set ClassName [string trim [string range $def 0 [expr $tabloc1 -1]]];
    set Cset [string trim [string range $def [expr $tabloc1 +1] [expr $tabloc2 -1]]];
    set Gloss [string trim [string range $def [expr $tabloc2 +1] end]];

    StoreUserClassDefinition $ClassName $Cset $Gloss;
    return 3;
}

proc ReadUserClasses { UserClassFile } {
    set cnt 0;
    if { [file exists $UserClassFile] } {
	if {[ catch {open $UserClassFile "r"} UserClassHandle] == 0} {
	    while { [gets $UserClassHandle line] > 0} {
		incr cnt;
		set fields [ParseUserClassEntry $line];
		if {$fields < 3} {
		    ShowMessage [format [_ "The class definition at line %1\$d of file %2\$s is ill-formed."] $cnt $UserClassFile]
		    if {$fields == 2} {
			ShowMessage [_ "It has only two of the three required fields"];
		    } else {
			ShowMessage [_ "It has only one of the three required fields"]; 
		    }
		    close $UserClassHandle;
		    return;
		}
	    }
	    close $UserClassHandle;
	    ShowMessage [format  [_ "%d character classes read from file %s."] $cnt $UserClassFile];
	} else {
	    ShowMessage [format [_ "Cannot open file %s."] $UserClassFile];
	    close $UserClassHandle;
	    return;
	}
    } else {
	ShowMessage [format [_ "There is no file named %s"] $UserClassFile];
    }
    return;
}

proc ReadUserClassesInteractively { } {
    set UserClassFile [tk_getOpenFile];
    if {[string equal $UserClassFile ""] != 1} {
	ReadUserClasses $UserClassFile;
    } else {
	ShowMessage [_ "File selection aborted."];
    }
}

proc SaveUserClassDefinitions {} {
    global UserClassGlosses;
    global UserClasses;
    global UserClassCnt;

    if {$UserClassCnt == 0} {
	ShowMessage [_ "No named character classes have been defined."];
	return ;
    }
    set SaveFile [tk_getSaveFile -initialfile [_ "ClassDefinitions"]];
    if {[string equal $SaveFile ""] == 1} {
	return ;
    } else {
        if { [catch {open $SaveFile "w+"} fh] != 0} {
	    ShowMessage [format [_ "Unable to open file %s in which to save class definitions."] \
			     [MinimizeFileName $SaveFile]];
	    return ;
        }
    }
    foreach ClassName [lsort [array names UserClassGlosses]] {
	puts $fh [format "%s\t%s\t%s\n" $ClassName $UserClasses($ClassName) $UserClassGlosses($ClassName)]
    }
    close $fh;
}

proc GetClassSpecFromClassMenu {mre} {
    global MaxUserClassGlossLength;
    global UserClassColumnSeparation;

    return [string trimleft [string range $mre [expr $MaxUserClassGlossLength + $UserClassColumnSeparation] end]];
}

#End of user-defined named character class section

#In the new system, we have a single Property list which defines the order
#in which entries appear in the palette. To determine whether a particular
#entry is to be tested or apper in the palette, we use the following
#array.

set PropertyUse(tested,TestP) 0;
set PropertyUse(BooleanAnd,TestP) 1;
set PropertyUse(group,TestP) 1;
set PropertyUse(groupbs,TestP) 1;
set PropertyUse(groupdbs,TestP) 1;
set PropertyUse(ncgroup,TestP) 1;
set PropertyUse(ncgroupdb,TestP) 1;
set PropertyUse(ObligatoryQuantifierGroup,TestP) 0;
set PropertyUse(SelfishNoCaptureGroup,TestP) 0;
set PropertyUse(SelfishNoCaptureGroupA,TestP) 1;
set PropertyUse(SelfishNoCaptureGroupB,TestP) 1;
set PropertyUse(SelfishNoCaptureGroupC,TestP) 1;
set PropertyUse(taggedgroup,TestP) 1;
set PropertyUse(taggedgroupref,TestP) 0;
set PropertyUse(groupcomp,TestP) 1;
set PropertyUse(dot,TestP) 1;
set PropertyUse(starprev,TestP) 1;
set PropertyUse(starnext,TestP) 1;
set PropertyUse(starclass,TestP) 1;
set PropertyUse(SubReluctantStarPrevDollar,TestP) 1;
set PropertyUse(SubReluctantStarPrevBackslash,TestP) 1;
set PropertyUse(SubHyphenClass,TestP) 1;
set PropertyUse(starany,TestP) 1;
set PropertyUse(plusprev,TestP) 1;
set PropertyUse(plusnext,TestP) 1;
set PropertyUse(plusprevbs,TestP) 1;
set PropertyUse(plusclass,TestP) 1;
set PropertyUse(SubReluctantPlusPrevDollar,TestP) 1;
set PropertyUse(SubReluctantPlusPrevBackslash,TestP) 1;
set PropertyUse(plusany,TestP) 1;
set PropertyUse(crosshatchany,TestP) 1;
set PropertyUse(atsignonenext,TestP) 1;
set PropertyUse(qmopt,TestP) 1;
set PropertyUse(qmoptnext,TestP) 1;
set PropertyUse(qmoptclass,TestP) 1;
set PropertyUse(qmoptbs,TestP) 1;
set PropertyUse(qm1,TestP) 1;
set PropertyUse(qm1bs,TestP) 1;
set PropertyUse(SubReluctantQuestionMarkPrevDollar,TestP) 1;
set PropertyUse(SubReluctantQuestionMarkPrevBackslash,TestP) 1;
set PropertyUse(commaor,TestP) 1;
set PropertyUse(semiand,TestP) 1;
set PropertyUse(caret,TestP) 1;
set PropertyUse(pabegin,TestP) 1;
set PropertyUse(pabegindb,TestP) 1;
set PropertyUse(boslq,TestP) 1;
set PropertyUse(dollar,TestP) 1;
set PropertyUse(LiteralMetachar,TestP) 1;
set PropertyUse(AbsoluteEndOfString,TestP) 1;
set PropertyUse(pzendbs,TestP) 1;
set PropertyUse(pzenddbs,TestP) 1;
set PropertyUse(pZendbs,TestP) 1;
set PropertyUse(pZenddbs,TestP) 1
set PropertyUse(eosrq,TestP) 1;;
set PropertyUse(langle,TestP) 1;
set PropertyUse(rangle,TestP) 1;
set PropertyUse(WordBoundary,TestP) 1;
set PropertyUse(WordBoundaryBs,TestP) 1;
set PropertyUse(WordBoundaryY,TestP) 1;
set PropertyUse(WordBoundaryYBs,TestP) 1;
set PropertyUse(NonWordBoundary,TestP) 1;
set PropertyUse(NonWordBoundaryBs,TestP) 1;
set PropertyUse(pipe,TestP) 1;
set PropertyUse(pipebs,TestP) 1;
set PropertyUse(pipedbs,TestP) 1;
set PropertyUse(pipedbsall,TestP) 1;
set PropertyUse(altcomma,TestP) 1;
set PropertyUse(backref,TestP) 1;
set PropertyUse(backrefdbs,TestP) 1;
set PropertyUse(backrefper,TestP) 1;
set PropertyUse(backrefbsall,TestP) 1;
set PropertyUse(backrefdbsall,TestP) 1;
set PropertyUse(backrefAtLeastTen,TestP) 1;
set PropertyUse(backrefdbsAtLeastTen,TestP) 1;
set PropertyUse(backrefperAtLeastTen,TestP) 1;
set PropertyUse(backrefbsallAtLeastTen,TestP) 1;
set PropertyUse(backrefdbsallAtLeastTen,TestP) 1;
set PropertyUse(backrefksh,TestP) 1;
set PropertyUse(backrefkshAtLeastTen,TestP) 1;
set PropertyUse(repfixed,TestP) 1;
set PropertyUse(repfixedbs,TestP) 1;
set PropertyUse(repmin,TestP) 1;
set PropertyUse(repminbs,TestP) 1;
set PropertyUse(reprange,TestP) 1;
set PropertyUse(reprangebs,TestP) 1;
set PropertyUse(reprangedbs,TestP) 1;
set PropertyUse(SubReluctantIntegerRangeDollar,TestP) 1;
set PropertyUse(SubReluctantIntegerRangeBackslash,TestP) 1;
set PropertyUse(set,TestP) 1;
set PropertyUse(setcomp,TestP) 1;
set PropertyUse(setcomptilde,TestP) 1;
set PropertyUse(setcompbang,TestP) 1;
set PropertyUse(range,TestP) 1;
set PropertyUse(multirange,TestP) 1;
set PropertyUse(baldlim,TestP) 1;
set PropertyUse(bsw,TestP) 1;
set PropertyUse(alnum,TestP) 1;
set PropertyUse(alnumrebol,TestP) 1;
set PropertyUse(pbsw,TestP) 1;
set PropertyUse(pbbsw,TestP) 1;
set PropertyUse(lalnumc,TestP) 1;
set PropertyUse(lalnum,TestP) 1;
set PropertyUse(bsW,TestP) 1;
set PropertyUse(bsWdb,TestP) 1;
set PropertyUse(pbsW,TestP) 1;
set PropertyUse(alpha,TestP) 1;
set PropertyUse(alpharebol,TestP) 1;
set PropertyUse(lalpha,TestP) 1;
set PropertyUse(lalphac,TestP) 1;
set PropertyUse(upper,TestP) 1;
set PropertyUse(upperrebol,TestP) 1;
set PropertyUse(lupper,TestP) 1;
set PropertyUse(lupperc,TestP) 1;
set PropertyUse(lower,TestP) 1;
set PropertyUse(lowerrebol,TestP) 1;
set PropertyUse(llower,TestP) 1;
set PropertyUse(llowerc,TestP) 1;
set PropertyUse(punct,TestP) 1;
set PropertyUse(lpunct,TestP) 1;
set PropertyUse(lpunctc,TestP) 1;
set PropertyUse(space,TestP) 1;
set PropertyUse(lspace,TestP) 1;
set PropertyUse(pspace,TestP) 1;
set PropertyUse(pspacedb,TestP) 1;
set PropertyUse(lspacec,TestP) 1;
set PropertyUse(pspacec,TestP) 1;
set PropertyUse(pspacedbc,TestP) 1;
set PropertyUse(blank,TestP) 1;
set PropertyUse(graph,TestP) 1;
set PropertyUse(print,TestP) 1;
set PropertyUse(cntrl,TestP) 1;
set PropertyUse(lcntrl,TestP) 1;
set PropertyUse(lcntrlc,TestP) 1;
set PropertyUse(digit,TestP) 1;
set PropertyUse(digitrebol,TestP) 1;
set PropertyUse(ldigit,TestP) 1;
set PropertyUse(pdigit,TestP) 1;
set PropertyUse(pdigitdb,TestP) 1;
set PropertyUse(ldigitc,TestP) 1;
set PropertyUse(pdigitc,TestP) 1;
set PropertyUse(pdigitdbc,TestP) 1;
set PropertyUse(xdigit,TestP) 1;
set PropertyUse(xdigitrebol,TestP) 1;
set PropertyUse(lxdigit,TestP) 1;
set PropertyUse(lxdigitc,TestP) 1;
set PropertyUse(compposixclassinner,TestP) 1;
set PropertyUse(compposixclassouter,TestP) 1;
set PropertyUse(octal,TestP) 1;
set PropertyUse(octalo,TestP) 1;
set PropertyUse(octaldb,TestP) 1;
set PropertyUse(decimald,TestP) 1;
set PropertyUse(hexl,TestP) 1;
set PropertyUse(hexldb,TestP) 1;
set PropertyUse(hexu,TestP) 1;
set PropertyUse(hexudb,TestP) 1;
set PropertyUse(bell,TestP) 1;
set PropertyUse(belldb,TestP) 1;
set PropertyUse(backspace,TestP) 1;
set PropertyUse(escape,TestP) 1;
set PropertyUse(escapedb,TestP) 1;
set PropertyUse(cr,TestP) 1;
set PropertyUse(crdb,TestP) 1;
set PropertyUse(tab,TestP) 1;
set PropertyUse(tabdb,TestP) 1;
set PropertyUse(controlc,TestP) 1;
set PropertyUse(controlcdb,TestP) 1;
set PropertyUse(some,TestP) 1;
set PropertyUse(any,TestP) 1;
set PropertyUse(rangerebol,TestP) 1;
set PropertyUse(piperebol,TestP) 1;
set PropertyUse(comment,TestP) 1;
set PropertyUse(flagi,TestP) 0;
set PropertyUse(flagiu,TestP) 0;
set PropertyUse(flagiAsciiLiteral,TestP) 1;
set PropertyUse(flagiNonAsciiLiteral,TestP) 1;
set PropertyUse(flagiuNonAsciiLiteral,TestP) 1;
set PropertyUse(flagiAsciiClass,TestP) 1;
set PropertyUse(flagiNonAsciiClass,TestP) 1;
set PropertyUse(flagiuNonAsciiClass,TestP) 1;
set PropertyUse(flagiAsciiClassSymmetric,TestP) 1;
set PropertyUse(flagiNonAsciiClassSymmetric,TestP) 1;
set PropertyUse(flagiuNonAsciiClassSymmetric,TestP) 1;
set PropertyUse(flagx,TestP) 1;
set PropertyUse(flagb,TestP) 1;
set PropertyUse(flage,TestP) 1;
set PropertyUse(flagq,TestP) 1;
set PropertyUse(UnsetFlag,TestP) 1;
set PropertyUse(FlagWideScope,TestP) 1;
set PropertyUse(jLower,TestP) 1;
set PropertyUse(jLowerdb,TestP) 1;
set PropertyUse(jLowerc,TestP) 1;
set PropertyUse(jLowercdb,TestP) 1;
set PropertyUse(jUpper,TestP) 1;
set PropertyUse(jUpperdb,TestP) 1;
set PropertyUse(jUpperc,TestP) 1;
set PropertyUse(jUppercdb,TestP) 1;
set PropertyUse(jAscii,TestP) 1;
set PropertyUse(jAsciidb,TestP) 1;
set PropertyUse(jAsciic,TestP) 1;
set PropertyUse(jAsciicdb,TestP) 1;
set PropertyUse(jAlpha,TestP) 1;
set PropertyUse(jAlphadb,TestP) 1;
set PropertyUse(jAlphac,TestP) 1;
set PropertyUse(jAlphacdb,TestP) 1;
set PropertyUse(jDigit,TestP) 1;
set PropertyUse(jDigitdb,TestP) 1;
set PropertyUse(jDigitc,TestP) 1;
set PropertyUse(jDigitcdb,TestP) 1;
set PropertyUse(jXdigit,TestP) 1;
set PropertyUse(jXdigitdb,TestP) 1;
set PropertyUse(jXdigitc,TestP) 1;
set PropertyUse(jXdigitcdb,TestP) 1;
set PropertyUse(jAlnum,TestP) 1;
set PropertyUse(jAlnumdb,TestP) 1;
set PropertyUse(jAlnumc,TestP) 1;
set PropertyUse(jAlnumcdb,TestP) 1;
set PropertyUse(jPunct,TestP) 1;
set PropertyUse(jPunctdb,TestP) 1;
set PropertyUse(jPunctc,TestP) 1;
set PropertyUse(jPunctcdb,TestP) 1;
set PropertyUse(jGraph,TestP) 1;
set PropertyUse(jGraphdb,TestP) 1;
set PropertyUse(jGraphc,TestP) 1;
set PropertyUse(jGraphcdb,TestP) 1;
set PropertyUse(jPrint,TestP) 1;
set PropertyUse(jPrintdb,TestP) 1;
set PropertyUse(jPrintc,TestP) 1;
set PropertyUse(jPrintcdb,TestP) 1;
set PropertyUse(jBlank,TestP) 1;
set PropertyUse(jBlankdb,TestP) 1;
set PropertyUse(jBlankc,TestP) 1;
set PropertyUse(jBlankcdb,TestP) 1;
set PropertyUse(jSpace,TestP) 1;
set PropertyUse(jSpacedb,TestP) 1;
set PropertyUse(jSpacec,TestP) 1;
set PropertyUse(jSpacecdb,TestP) 1;
set PropertyUse(jCntrl,TestP) 1;
set PropertyUse(jCntrldb,TestP) 1;
set PropertyUse(jCntrlc,TestP) 1;
set PropertyUse(jCntrlcdb,TestP) 1;
set PropertyUse(uname,TestP) 1;
set PropertyUse(unamedb,TestP) 1;
set PropertyUse(jUBlock,TestP) 1;
set PropertyUse(jUBlockc,TestP) 1;
set PropertyUse(jUCat,TestP) 1;
set PropertyUse(jUCatc,TestP) 1;
set PropertyUse(jUBlockdb,TestP) 1;
set PropertyUse(jUBlockcdb,TestP) 1;
set PropertyUse(jUCatdb,TestP) 1;
set PropertyUse(jUCatcdb,TestP) 1;
set PropertyUse(jUnion,TestP) 1;
set PropertyUse(jInter,TestP) 1;
set PropertyUse(plookahead,TestP) 1;
set PropertyUse(plookback,TestP) 1;
set PropertyUse(nlookahead,TestP) 1;
set PropertyUse(nlookback,TestP) 1;
set PropertyUse(CondGroupSimple,TestP) 1;
set PropertyUse(CondGroupElse,TestP) 1;
set PropertyUse(CondLookaroundSimple,TestP) 1;
set PropertyUse(CondLookaroundElse,TestP) 1;
set PropertyUse(SubBackRefBare,TestP) 1;
set PropertyUse(SubBackRefBareAtLeastTen,TestP) 1;
set PropertyUse(SubEntBackRefZero,TestP) 1;
set PropertyUse(SubBackReferenceDol,TestP) 1;
set PropertyUse(SubBackReferenceDolAtLeastTen,TestP) 1;
set PropertyUse(SubBackReferenceDolZero,TestP) 1;
set PropertyUse(SubBackReferencePercent,TestP) 1;
set PropertyUse(SubBackReferencePercentAtLeastTen,TestP) 1;
set PropertyUse(SubBackReferencePercentZero,TestP) 1;
set PropertyUse(SubBackRefbs,TestP) 1;
set PropertyUse(SubBackRefParbs,TestP) 1;
set PropertyUse(SubBackRefbsAtLeastTen,TestP) 1;
set PropertyUse(SubBackRefParbsAtLeastTen,TestP) 1;
set PropertyUse(SubBackRefbsZero,TestP) 1;
set PropertyUse(SubBackRefParbsZero,TestP) 1;
set PropertyUse(SubBackRefdbs,TestP) 1;
set PropertyUse(SubBackRefdbsAtLeastTen,TestP) 1;
set PropertyUse(SubBackRefdbsZero,TestP) 1;
set PropertyUse(SubBackRefPardbsdbs,TestP) 1;
set PropertyUse(SubBackRefPardbsdbsAtLeastTen,TestP) 1;
set PropertyUse(SubBackRefPardbsdbsZero,TestP) 1;
set PropertyUse(Subampentbackrefsdbs,TestP) 1;
set PropertyUse(SubampentbackrefsPardbsdbs,TestP) 1;
set PropertyUse(SubDolAmpEntBackRef,TestP) 1;
set PropertyUse(SubPreMatch,TestP) 1;
set PropertyUse(SubPreMatchDol,TestP) 1;
set PropertyUse(SubPostMatch,TestP) 1;
set PropertyUse(SubPostMatchDol,TestP) 1;
set PropertyUse(SubLastCapture,TestP) 1;
set PropertyUse(SubLastCaptureDol,TestP) 1;
set PropertyUse(SubPreMatchLit,TestP) 1;
set PropertyUse(SubPostMatchLit,TestP) 1;
set PropertyUse(SubRange,TestP) 1;
set PropertyUse(SubAlnum,TestP) 1;
set PropertyUse(SubAlpha,TestP) 1;
set PropertyUse(SubBlank,TestP) 1;
set PropertyUse(SubCntrl,TestP) 1;
set PropertyUse(SubDigit,TestP) 1;
set PropertyUse(SubGraph,TestP) 1;
set PropertyUse(SubLower,TestP) 1;
set PropertyUse(SubPrint,TestP) 1;
set PropertyUse(SubPunct,TestP) 1;
set PropertyUse(SubSpace,TestP) 1;
set PropertyUse(SubUpper,TestP) 1;
set PropertyUse(SubXdigit,TestP) 1;
set PropertyUse(SubCStarN,TestP) 1;
set PropertyUse(SubCStar,TestP) 1;
set PropertyUse(SubLitString,TestP) 1;
set PropertyUse(ExactMatchWD,TestP) 1;
set PropertyUse(ExactMatchTRE,TestP) 1;
set PropertyUse(ExactMatchCgrep,TestP) 1;
set PropertyUse(TRECostSetting,TestP) 1;
set PropertyUse(PossStar,TestP) 0;
set PropertyUse(PossPlus,TestP) 0;
set PropertyUse(PossQMark,TestP) 0;
set PropertyUse(PossAtLeastM,TestP) 0;
set PropertyUse(PossMToN,TestP) 0;
set PropertyUse(CondPosLookaheadSimple,TestP) 0;
set PropertyUse(CondPosLookaheadElse,TestP) 0;
set PropertyUse(CondNegLookaheadSimple,TestP) 0;
set PropertyUse(CondNegLookaheadElse,TestP) 0;
set PropertyUse(CondPosLookbackSimple,TestP) 0;
set PropertyUse(CondPosLookbackElse,TestP) 0;
set PropertyUse(CondNegLookbackSimple,TestP) 0;
set PropertyUse(CondNegLookbackElse,TestP) 0;
set PropertyUse(embedding,TestP) 1;
set PropertyUse(embeddingLeft,TestP) 1;
set PropertyUse(embeddingRight,TestP) 1;
set PropertyUse(unicodebmp,TestP) 1;
set PropertyUse(unicodefull,TestP) 1;
set PropertyUse(PossQMarkA,TestP) 1;
set PropertyUse(PossQMarkB,TestP) 1;
set PropertyUse(PossStarA,TestP) 1;
set PropertyUse(PossStarB,TestP) 1;
set PropertyUse(PossPlusA,TestP) 1;
set PropertyUse(PossPlusB,TestP) 1;
set PropertyUse(PossAtLeastMA,TestP) 1;
set PropertyUse(PossAtLeastMB,TestP) 1;
set PropertyUse(PossMToNA,TestP) 1;
set PropertyUse(PossMToNB,TestP) 1;
set PropertyUse(PossMToNC,TestP) 1; 
set PropertyUse(CollationClass,TestP) 1; 
set PropertyUse(CollatingElementMultichar,TestP) 1; 
set PropertyUse(CollatingElementNamed,TestP) 1; 
#set PropertyUse(ReluctantStar,TestP) 1;
#set PropertyUse(GreedyDoubleStar,TestP) 1;

set PropertyUse(tested,PaletteP) 0;
set PropertyUse(BooleanAnd,PaletteP) 1;
set PropertyUse(group,PaletteP) 1;
set PropertyUse(groupbs,PaletteP) 1;
set PropertyUse(ObligatoryQuantifierGroup,PaletteP) 1;
set PropertyUse(groupdbs,PaletteP) 1;
set PropertyUse(ncgroup,PaletteP) 1;
set PropertyUse(ncgroupdb,PaletteP) 1;
set PropertyUse(SelfishNoCaptureGroup,PaletteP) 1;
set PropertyUse(SelfishNoCaptureGroupA,PaletteP) 0;
set PropertyUse(SelfishNoCaptureGroupB,PaletteP) 0;
set PropertyUse(SelfishNoCaptureGroupC,PaletteP) 0;
set PropertyUse(taggedgroup,PaletteP) 1;
set PropertyUse(taggedgroupref,PaletteP) 1;
set PropertyUse(groupcomp,PaletteP) 1;
set PropertyUse(dot,PaletteP) 1;
set PropertyUse(starprev,PaletteP) 1;
set PropertyUse(starnext,PaletteP) 1;
set PropertyUse(starclass,PaletteP) 1;
set PropertyUse(SubReluctantStarPrevDollar,PaletteP) 1;
set PropertyUse(SubReluctantStarPrevBackslash,PaletteP) 1;
set PropertyUse(SubHyphenClass,PaletteP) 1;
set PropertyUse(starany,PaletteP) 1;
set PropertyUse(plusprev,PaletteP) 1;
set PropertyUse(plusnext,PaletteP) 1;
set PropertyUse(plusprevbs,PaletteP) 1;
set PropertyUse(plusclass,PaletteP) 1;
set PropertyUse(SubReluctantPlusPrevDollar,PaletteP) 1;
set PropertyUse(SubReluctantPlusPrevBackslash,PaletteP) 1;
set PropertyUse(plusany,PaletteP) 1;
set PropertyUse(crosshatchany,PaletteP) 1;
set PropertyUse(atsignonenext,PaletteP) 1;
set PropertyUse(qmopt,PaletteP) 1;
set PropertyUse(qmoptnext,PaletteP) 1;
set PropertyUse(qmoptclass,PaletteP) 1;
set PropertyUse(qmoptbs,PaletteP) 1;
set PropertyUse(qm1,PaletteP) 1;
set PropertyUse(qm1bs,PaletteP) 1;
set PropertyUse(SubReluctantQuestionMarkPrevDollar,PaletteP) 1;
set PropertyUse(SubReluctantQuestionMarkPrevBackslash,PaletteP) 1;
set PropertyUse(commaor,PaletteP) 1;
set PropertyUse(semiand,PaletteP) 1;
set PropertyUse(caret,PaletteP) 1;
set PropertyUse(pabegin,PaletteP) 1;
set PropertyUse(pabegindb,PaletteP) 1;
set PropertyUse(boslq,PaletteP) 1;
set PropertyUse(dollar,PaletteP) 1;
set PropertyUse(LiteralMetachar,PaletteP) 1;
set PropertyUse(AbsoluteEndOfString,PaletteP) 0;
set PropertyUse(pzendbs,PaletteP) 1;
set PropertyUse(pzenddbs,PaletteP) 1;
set PropertyUse(pZendbs,PaletteP) 1;
set PropertyUse(pZenddbs,PaletteP) 1;
set PropertyUse(eosrq,PaletteP) 1;
set PropertyUse(langle,PaletteP) 1;
set PropertyUse(rangle,PaletteP) 1;
set PropertyUse(WordBoundary,PaletteP) 1;
set PropertyUse(WordBoundaryY,PaletteP) 1;
set PropertyUse(WordBoundaryYBs,PaletteP) 1;
set PropertyUse(WordBoundaryBs,PaletteP) 1;
set PropertyUse(NonWordBoundary,PaletteP) 1;
set PropertyUse(NonWordBoundaryBs,PaletteP) 1;
set PropertyUse(pipe,PaletteP) 1;
set PropertyUse(pipebs,PaletteP) 1;
set PropertyUse(pipedbs,PaletteP) 1;
set PropertyUse(pipedbsall,PaletteP) 1;
set PropertyUse(altcomma,PaletteP) 1;
set PropertyUse(backref,PaletteP) 1;
set PropertyUse(backrefdbs,PaletteP) 1;
set PropertyUse(backrefper,PaletteP) 1;
set PropertyUse(backrefbsall,PaletteP) 1;
set PropertyUse(backrefdbsall,PaletteP) 1;
set PropertyUse(repfixed,PaletteP) 1;
set PropertyUse(backrefAtLeastTen,PaletteP) 0;
set PropertyUse(backrefdbsAtLeastTen,PaletteP) 0;
set PropertyUse(backrefperAtLeastTen,PaletteP) 0;
set PropertyUse(backrefbsallAtLeastTen,PaletteP) 0;
set PropertyUse(backrefdbsallAtLeastTen,PaletteP) 0;
set PropertyUse(backrefksh,PaletteP) 1;
set PropertyUse(backrefkshAtLeastTen,PaletteP) 0;
set PropertyUse(repfixedbs,PaletteP) 1;
set PropertyUse(repmin,PaletteP) 1;
set PropertyUse(repminbs,PaletteP) 1;
set PropertyUse(reprange,PaletteP) 1;
set PropertyUse(reprangebs,PaletteP) 1;
set PropertyUse(reprangedbs,PaletteP) 1;
set PropertyUse(SubReluctantIntegerRangeDollar,PaletteP) 1;
set PropertyUse(SubReluctantIntegerRangeBackslash,PaletteP) 1;
set PropertyUse(set,PaletteP) 1;
set PropertyUse(setcomp,PaletteP) 1;
set PropertyUse(setcomptilde,PaletteP) 1;
set PropertyUse(setcompbang,PaletteP) 1;
set PropertyUse(range,PaletteP) 1;
set PropertyUse(multirange,PaletteP) 1;
set PropertyUse(baldlim,PaletteP) 1;
set PropertyUse(bsw,PaletteP) 1;
set PropertyUse(alnum,PaletteP) 1;
set PropertyUse(alnumrebol,PaletteP) 1;
set PropertyUse(pbsw,PaletteP) 1;
set PropertyUse(pbbsw,PaletteP) 1;
set PropertyUse(lalnumc,PaletteP) 1;
set PropertyUse(lalnum,PaletteP) 1;
set PropertyUse(bsW,PaletteP) 1;
set PropertyUse(bsWdb,PaletteP) 1;
set PropertyUse(pbsW,PaletteP) 1;
set PropertyUse(alpha,PaletteP) 1;
set PropertyUse(alpharebol,PaletteP) 1;
set PropertyUse(lalpha,PaletteP) 1;
set PropertyUse(lalphac,PaletteP) 1;
set PropertyUse(upper,PaletteP) 1;
set PropertyUse(upperrebol,PaletteP) 1;
set PropertyUse(lupper,PaletteP) 1;
set PropertyUse(lupperc,PaletteP) 1;
set PropertyUse(lower,PaletteP) 1;
set PropertyUse(lowerrebol,PaletteP) 1;
set PropertyUse(llower,PaletteP) 1;
set PropertyUse(llowerc,PaletteP) 1;
set PropertyUse(punct,PaletteP) 1;
set PropertyUse(lpunct,PaletteP) 1;
set PropertyUse(lpunctc,PaletteP) 1;
set PropertyUse(space,PaletteP) 1;
set PropertyUse(lspace,PaletteP) 1;
set PropertyUse(pspace,PaletteP) 1;
set PropertyUse(pspacedb,PaletteP) 1;
set PropertyUse(lspacec,PaletteP) 1;
set PropertyUse(pspacec,PaletteP) 1;
set PropertyUse(pspacedbc,PaletteP) 1;
set PropertyUse(blank,PaletteP) 1;
set PropertyUse(graph,PaletteP) 1;
set PropertyUse(print,PaletteP) 1;
set PropertyUse(cntrl,PaletteP) 1;
set PropertyUse(lcntrl,PaletteP) 1;
set PropertyUse(lcntrlc,PaletteP) 1;
set PropertyUse(digit,PaletteP) 1;
set PropertyUse(digitrebol,PaletteP) 1;
set PropertyUse(ldigit,PaletteP) 1;
set PropertyUse(pdigit,PaletteP) 1;
set PropertyUse(pdigitdb,PaletteP) 1;
set PropertyUse(ldigitc,PaletteP) 1;
set PropertyUse(pdigitc,PaletteP) 1;
set PropertyUse(pdigitdbc,PaletteP) 1;
set PropertyUse(xdigit,PaletteP) 1;
set PropertyUse(xdigitrebol,PaletteP) 1;
set PropertyUse(lxdigit,PaletteP) 1;
set PropertyUse(lxdigitc,PaletteP) 1;
set PropertyUse(compposixclassinner,PaletteP) 1;
set PropertyUse(compposixclassouter,PaletteP) 1;
set PropertyUse(octal,PaletteP) 1;
set PropertyUse(octalo,PaletteP) 1;
set PropertyUse(decimald,PaletteP) 1;
set PropertyUse(octaldb,PaletteP) 1;
set PropertyUse(hexl,PaletteP) 1;
set PropertyUse(hexldb,PaletteP) 1;
set PropertyUse(hexu,PaletteP) 1;
set PropertyUse(hexudb,PaletteP) 1;
set PropertyUse(bell,PaletteP) 1;
set PropertyUse(belldb,PaletteP) 1;
set PropertyUse(backspace,PaletteP) 1;
set PropertyUse(escape,PaletteP) 1;
set PropertyUse(escapedb,PaletteP) 1;
set PropertyUse(cr,PaletteP) 1;
set PropertyUse(crdb,PaletteP) 1;
set PropertyUse(tab,PaletteP) 1;
set PropertyUse(tabdb,PaletteP) 1;
set PropertyUse(controlc,PaletteP) 1;
set PropertyUse(controlcdb,PaletteP) 1;
set PropertyUse(some,PaletteP) 1;
set PropertyUse(any,PaletteP) 1;
set PropertyUse(rangerebol,PaletteP) 1;
set PropertyUse(piperebol,PaletteP) 1;
set PropertyUse(comment,PaletteP) 1;
set PropertyUse(flagi,PaletteP) 1;
set PropertyUse(flagiu,PaletteP) 1;
set PropertyUse(flagiAsciiLiteral,PaletteP) 0;
set PropertyUse(flagiNonAsciiLiteral,PaletteP) 0;
set PropertyUse(flagiuNonAsciiLiteral,PaletteP) 0;
set PropertyUse(flagiAsciiClass,PaletteP) 0;
set PropertyUse(flagiNonAsciiClass,PaletteP) 0;
set PropertyUse(flagiuNonAsciiClass,PaletteP) 0;
set PropertyUse(flagiAsciiClassSymmetric,PaletteP) 0;
set PropertyUse(flagiNonAsciiClassSymmetric,PaletteP) 0;
set PropertyUse(flagiuNonAsciiClassSymmetric,PaletteP) 0;
set PropertyUse(flagx,PaletteP) 1;
set PropertyUse(flagb,PaletteP) 1;
set PropertyUse(flage,PaletteP) 1;
set PropertyUse(flagq,PaletteP) 1;
set PropertyUse(UnsetFlag,PaletteP) 1;
set PropertyUse(FlagWideScope,PaletteP) 0;
set PropertyUse(jLower,PaletteP) 1;
set PropertyUse(jLowerdb,PaletteP) 1;
set PropertyUse(jLowerc,PaletteP) 1;
set PropertyUse(jLowercdb,PaletteP) 1;
set PropertyUse(jUpper,PaletteP) 1;
set PropertyUse(jUpperdb,PaletteP) 1;
set PropertyUse(jUpperc,PaletteP) 1;
set PropertyUse(jUppercdb,PaletteP) 1;
set PropertyUse(jAscii,PaletteP) 1;
set PropertyUse(jAsciidb,PaletteP) 1;
set PropertyUse(jAsciic,PaletteP) 1;
set PropertyUse(jAsciicdb,PaletteP) 1;
set PropertyUse(jAlpha,PaletteP) 1;
set PropertyUse(jAlphadb,PaletteP) 1;
set PropertyUse(jAlphac,PaletteP) 1;
set PropertyUse(jAlphacdb,PaletteP) 1;
set PropertyUse(jDigit,PaletteP) 1;
set PropertyUse(jDigitdb,PaletteP) 1;
set PropertyUse(jDigitc,PaletteP) 1;
set PropertyUse(jDigitcdb,PaletteP) 1;
set PropertyUse(jXdigit,PaletteP) 1;
set PropertyUse(jXdigitdb,PaletteP) 1;
set PropertyUse(jXdigitc,PaletteP) 1;
set PropertyUse(jXdigitcdb,PaletteP) 1;
set PropertyUse(jAlnum,PaletteP) 1;
set PropertyUse(jAlnumdb,PaletteP) 1;
set PropertyUse(jAlnumc,PaletteP) 1;
set PropertyUse(jAlnumcdb,PaletteP) 1;
set PropertyUse(jPunct,PaletteP) 1;
set PropertyUse(jPunctdb,PaletteP) 1;
set PropertyUse(jPunctc,PaletteP) 1;
set PropertyUse(jPunctcdb,PaletteP) 1;
set PropertyUse(jGraph,PaletteP) 1;
set PropertyUse(jGraphdb,PaletteP) 1;
set PropertyUse(jGraphc,PaletteP) 1;
set PropertyUse(jGraphcdb,PaletteP) 1;
set PropertyUse(jPrint,PaletteP) 1;
set PropertyUse(jPrintdb,PaletteP) 1;
set PropertyUse(jPrintc,PaletteP) 1;
set PropertyUse(jPrintcdb,PaletteP) 1;
set PropertyUse(jBlank,PaletteP) 1;
set PropertyUse(jBlankdb,PaletteP) 1;
set PropertyUse(jBlankc,PaletteP) 1;
set PropertyUse(jBlankcdb,PaletteP) 1;
set PropertyUse(jSpace,PaletteP) 1;
set PropertyUse(jSpacedb,PaletteP) 1;
set PropertyUse(jSpacec,PaletteP) 1;
set PropertyUse(jSpacecdb,PaletteP) 1;
set PropertyUse(jCntrl,PaletteP) 1;
set PropertyUse(jCntrldb,PaletteP) 1;
set PropertyUse(jCntrlc,PaletteP) 1;
set PropertyUse(jCntrlcdb,PaletteP) 1;
set PropertyUse(uname,PaletteP) 1;
set PropertyUse(unamedb,PaletteP) 1;
set PropertyUse(jUBlock,PaletteP) 1;
set PropertyUse(jUBlockc,PaletteP) 1;
set PropertyUse(jUCat,PaletteP) 1;
set PropertyUse(jUCatc,PaletteP) 1;
set PropertyUse(jUBlockdb,PaletteP) 1;
set PropertyUse(jUBlockcdb,PaletteP) 1;
set PropertyUse(jUCatdb,PaletteP) 1;
set PropertyUse(jUCatcdb,PaletteP) 1;
set PropertyUse(jUnion,PaletteP) 1;
set PropertyUse(jInter,PaletteP) 1;
set PropertyUse(plookahead,PaletteP) 1;
set PropertyUse(plookback,PaletteP) 1;
set PropertyUse(nlookahead,PaletteP) 1;
set PropertyUse(nlookback,PaletteP) 1;
set PropertyUse(CondGroupSimple,PaletteP) 1;
set PropertyUse(CondGroupElse,PaletteP) 1;
set PropertyUse(CondLookaroundSimple,PaletteP) 0;
set PropertyUse(CondLookaroundElse,PaletteP) 0;
set PropertyUse(SubBackRefBare,PaletteP) 1;
set PropertyUse(SubBackRefBareAtLeastTen,PaletteP) 0;
set PropertyUse(SubBackReferenceDol,PaletteP) 1;
set PropertyUse(SubBackReferenceDolAtLeastTen,PaletteP) 0;
set PropertyUse(SubBackReferenceDolZero,PaletteP) 1;
set PropertyUse(SubBackReferencePercent,PaletteP) 1;
set PropertyUse(SubBackReferencePercentAtLeastTen,PaletteP) 0;
set PropertyUse(SubBackReferencePercentZero,PaletteP) 1;
set PropertyUse(SubBackRefbs,PaletteP) 1;
set PropertyUse(SubBackRefParbs,PaletteP) 1;
set PropertyUse(SubBackRefbsAtLeastTen,PaletteP) 0;
set PropertyUse(SubBackRefParbsAtLeastTen,PaletteP) 0;
set PropertyUse(SubBackRefbsZero,PaletteP) 1;
set PropertyUse(SubBackRefParbsZero,PaletteP) 1;
set PropertyUse(SubBackRefdbs,PaletteP) 1;
set PropertyUse(SubBackRefdbsAtLeastTen,PaletteP) 0;
set PropertyUse(SubBackRefdbsZero,PaletteP) 1;
set PropertyUse(SubBackRefPardbsdbs,PaletteP) 1;
set PropertyUse(SubBackRefPardbsdbsAtLeastTen,PaletteP) 0;
set PropertyUse(SubBackRefPardbsdbsZero,PaletteP) 1;
set PropertyUse(SubEntBackRefZero,PaletteP) 1;
set PropertyUse(Subampentbackrefsdbs,PaletteP) 1;
set PropertyUse(SubampentbackrefsPardbsdbs,PaletteP) 1;
set PropertyUse(SubDolAmpEntBackRef,PaletteP) 1;
set PropertyUse(SubPreMatch,PaletteP) 1;
set PropertyUse(SubPreMatchDol,PaletteP) 1;
set PropertyUse(SubPostMatch,PaletteP) 1;
set PropertyUse(SubPostMatchDol,PaletteP) 1;
set PropertyUse(SubLastCapture,PaletteP) 1;
set PropertyUse(SubLastCaptureDol,PaletteP) 1;
set PropertyUse(SubPreMatchLit,PaletteP) 1;
set PropertyUse(SubPostMatchLit,PaletteP) 1;
set PropertyUse(SubRange,PaletteP) 1;
set PropertyUse(SubAlnum,PaletteP) 1;
set PropertyUse(SubAlpha,PaletteP) 1;
set PropertyUse(SubBlank,PaletteP) 1;
set PropertyUse(SubCntrl,PaletteP) 1;
set PropertyUse(SubDigit,PaletteP) 1;
set PropertyUse(SubGraph,PaletteP) 1;
set PropertyUse(SubLower,PaletteP) 1;
set PropertyUse(SubPrint,PaletteP) 1;
set PropertyUse(SubPunct,PaletteP) 1;
set PropertyUse(SubSpace,PaletteP) 1;
set PropertyUse(SubUpper,PaletteP) 1;
set PropertyUse(SubXdigit,PaletteP) 1;
set PropertyUse(SubCStarN,PaletteP) 1;
set PropertyUse(SubCStar,PaletteP) 1;
set PropertyUse(SubLitString,PaletteP) 1;
set PropertyUse(ExactMatchWD,PaletteP) 1;
set PropertyUse(ExactMatchTRE,PaletteP) 1;
set PropertyUse(ExactMatchCgrep,PaletteP) 1;
set PropertyUse(TRECostSetting,PaletteP) 1;
set PropertyUse(PossStar,PaletteP) 1;
set PropertyUse(PossPlus,PaletteP) 1;
set PropertyUse(PossQMark,PaletteP) 1;
set PropertyUse(PossAtLeastM,PaletteP) 1;
set PropertyUse(PossMToN,PaletteP) 1;
set PropertyUse(CondPosLookaheadSimple,PaletteP) 1;
set PropertyUse(CondPosLookaheadElse,PaletteP) 1;
set PropertyUse(CondNegLookaheadSimple,PaletteP) 1;
set PropertyUse(CondNegLookaheadElse,PaletteP) 1;
set PropertyUse(CondPosLookbackSimple,PaletteP) 1;
set PropertyUse(CondPosLookbackElse,PaletteP) 1;
set PropertyUse(CondNegLookbackSimple,PaletteP) 1;
set PropertyUse(CondNegLookbackElse,PaletteP) 1;
set PropertyUse(embedding,PaletteP) 0;
set PropertyUse(embeddingLeft,PaletteP) 0;
set PropertyUse(embeddingRight,PaletteP) 0;
set PropertyUse(unicodebmp,PaletteP) 0;
set PropertyUse(unicodefull,PaletteP) 0;
set PropertyUse(PossQMarkA,PaletteP) 0;
set PropertyUse(PossQMarkB,PaletteP) 0;
set PropertyUse(PossStarA,PaletteP) 0;
set PropertyUse(PossStarB,PaletteP) 0;
set PropertyUse(PossPlusA,PaletteP) 0;
set PropertyUse(PossPlusB,PaletteP) 0;
set PropertyUse(PossAtLeastMA,PaletteP) 0;
set PropertyUse(PossAtLeastMB,PaletteP) 0;
set PropertyUse(PossMToNA,PaletteP) 0;
set PropertyUse(PossMToNB,PaletteP) 0;
set PropertyUse(PossMToNC,PaletteP) 0;
set PropertyUse(CollationClass,PaletteP) 1; 
set PropertyUse(CollatingElementMultichar,PaletteP) 1; 
set PropertyUse(CollatingElementNamed,PaletteP) 1; 
#set PropertyUse(ReluctantStar,PaletteP) 1;
#set PropertyUse(GreedyDoubleStar,PaletteP) 1;

set PropertyList [list\
tested\
dot\
starany\
starprev\
starnext\
starclass\
PossStar\
SubReluctantStarPrevDollar\
SubReluctantStarPrevBackslash\
SubHyphenClass\
plusany\
plusprev\
plusprevbs\
plusclass\
PossPlus\
plusnext\
SubReluctantPlusPrevDollar\
SubReluctantPlusPrevBackslash\
crosshatchany\
atsignonenext\
qm1\
qm1bs\
qmopt\
qmoptbs\
qmoptclass\
qmoptnext\
PossQMark\
SubReluctantQuestionMarkPrevDollar\
SubReluctantQuestionMarkPrevBackslash\
commaor\
semiand\
pipe\
pipebs\
pipedbs\
pipedbsall\
altcomma\
group\
groupbs\
groupdbs\
ncgroup\
ncgroupdb\
ObligatoryQuantifierGroup\
SelfishNoCaptureGroup\
SelfishNoCaptureGroupA\
SelfishNoCaptureGroupB\
SelfishNoCaptureGroupC\
taggedgroup\
taggedgroupref\
groupcomp\
backref\
backrefdbs\
backrefksh\
backrefper\
backrefbsall\
backrefdbsall\
backrefAtLeastTen\
backrefkshAtLeastTen\
backrefdbsAtLeastTen\
backrefperAtLeastTen\
backrefbsallAtLeastTen\
backrefdbsallAtLeastTen\
repfixed\
repfixedbs\
repmin\
repminbs\
PossAtLeastM\
reprange\
reprangebs\
reprangedbs\
PossMToN\
SubReluctantIntegerRangeDollar\
SubReluctantIntegerRangeBackslash\
rangerebol\
piperebol\
lowerrebol\
upperrebol\
alpharebol\
digitrebol\
xdigitrebol\
alnumrebol\
set\
setcomp\
setcomptilde\
setcompbang\
range\
multirange\
CollationClass\
CollatingElementNamed\
CollatingElementMultichar\
baldlim\
caret\
pabegin\
pabegindb\
boslq\
dollar\
LiteralMetachar\
AbsoluteEndOfString\
pzendbs\
pzenddbs\
pZendbs\
pZenddbs\
eosrq\
langle\
rangle\
WordBoundary\
WordBoundaryBs\
WordBoundaryY\
WordBoundaryYBs\
NonWordBoundary\
NonWordBoundaryBs\
lower\
upper\
digit\
punct\
cntrl\
alpha\
alnum\
blank\
space\
graph\
print\
xdigit\
compposixclassinner\
compposixclassouter\
SubLower\
SubUpper\
SubDigit\
SubPunct\
SubCntrl\
SubAlnum\
SubAlpha\
SubBlank\
SubSpace\
SubGraph\
SubPrint\
SubXdigit\
jLower\
jLowerdb\
jLowerc\
jLowercdb\
jUpper\
jUpperdb\
jUpperc\
jUppercdb\
jDigit\
jDigitdb\
jDigitc\
jDigitcdb\
jPunct\
jPunctdb\
jPunctc\
jPunctcdb\
jCntrl\
jCntrldb\
jCntrlc\
jCntrlcdb\
jAlpha\
jAlphadb\
jAlphac\
jAlphacdb\
jXdigit\
jXdigitdb\
jXdigitc\
jXdigitcdb\
jAlnum\
jAlnumdb\
jAlnumc\
jAlnumcdb\
jGraph\
jGraphdb\
jGraphc\
jGraphcdb\
jPrint\
jPrintdb\
jPrintc\
jPrintcdb\
jBlank\
jBlankdb\
jBlankc\
jBlankcdb\
jSpace\
jSpacedb\
jSpacec\
jSpacecdb\
jAscii\
jAsciidb\
jAsciic\
jAsciicdb\
uname\
unamedb\
jUBlock\
jUBlockc\
jUCat\
jUCatc\
jUBlockdb\
jUBlockcdb\
jUCatdb\
jUCatcdb\
bsW\
bsWdb\
llower\
llowerc\
lupper\
lupperc\
ldigit\
ldigitc\
lpunct\
lpunctc\
lcntrl\
lcntrlc\
lalpha\
lalphac\
lalnum\
lalnumc\
lspace\
lspacec\
lxdigit\
lxdigitc\
pdigit\
pdigitc\
pspace\
pspacec\
pspacedb\
pspacedbc\
pdigitdb\
pdigitdbc\
bsw\
pbsw\
pbbsw\
pbsW\
bell\
belldb\
backspace\
escape\
escapedb\
cr\
crdb\
tab\
tabdb\
controlc\
controlcdb\
octal\
octalo\
octaldb\
decimald\
hexl\
hexldb\
hexu\
hexudb\
some\
any\
comment\
flagi\
flagiu\
flagiAsciiLiteral\
flagiNonAsciiLiteral\
flagiuNonAsciiLiteral\
flagiAsciiClass\
flagiNonAsciiClass\
flagiuNonAsciiClass\
flagiAsciiClassSymmetric\
flagiNonAsciiClassSymmetric\
flagiuNonAsciiClassSymmetric\
FlagWideScope\
flagx\
flagb\
flage\
flagq\
UnsetFlag\
jUnion\
jInter\
plookahead\
plookback\
nlookahead\
nlookback\
CondGroupSimple\
CondGroupElse\
CondLookaroundSimple\
CondLookaroundElse\
CondPosLookaheadSimple\
CondPosLookaheadElse\
CondNegLookaheadSimple\
CondNegLookaheadElse\
CondPosLookbackSimple\
CondPosLookbackElse\
CondNegLookbackSimple\
CondNegLookbackElse\
SubBackRefBare\
SubBackRefBareAtLeastTen\
SubBackReferenceDol\
SubBackReferenceDolAtLeastTen\
SubBackReferencePercent\
SubBackReferencePercentAtLeastTen\
SubBackRefbs\
SubBackRefParbs\
SubBackRefbsAtLeastTen\
SubBackRefParbsAtLeastTen\
SubBackRefdbs\
SubBackRefdbsAtLeastTen\
SubBackRefPardbsdbs\
SubBackRefPardbsdbsAtLeastTen\
SubEntBackRefZero\
SubBackReferenceDolZero\
SubBackReferencePercentZero\
SubBackRefdbsZero\
SubBackRefbsZero\
SubBackRefParbsZero\
SubBackRefPardbsdbsZero\
Subampentbackrefsdbs\
SubampentbackrefsPardbsdbs\
SubDolAmpEntBackRef\
SubPreMatch\
SubPreMatchDol\
SubPostMatch\
SubPostMatchDol\
SubLastCapture\
SubLastCaptureDol\
SubPreMatchLit\
SubPostMatchLit\
SubRange\
SubCStarN\
SubCStar\
SubLitString\
ExactMatchWD\
ExactMatchTRE\
ExactMatchCgrep\
TRECostSetting\
embedding\
embeddingLeft\
embeddingRight\
unicodebmp\
unicodefull\
PossQMarkA\
PossQMarkB\
PossStarA\
PossStarB\
PossPlusA\
PossPlusB\
PossAtLeastMA\
PossAtLeastMB\
PossMToNA\
PossMToNB\
PossMToNC
];

#Here begin the palette entries
set Palette(BooleanAnd,gloss)   [_ "and"]
set Palette(BooleanAnd,re)  	[list {{-a 0 } F} {{X Y} V}]
set Palette(BooleanAnd,link)	[list BooleanAnd]

set Palette(dot,gloss)         [_ "any single character"]
set Palette(dot,re)    	[list {. F}]
set Palette(dot,link)    [list Dot]

set Palette(starprev,gloss)    [_ "0 or more of preceding"]
set Palette(starprev,re)	[list {* F}]
set Palette(starprev,link)  	[list Star]

set Palette(starnext,gloss)    [_ "0 or more of the parenthesized group"]
set Palette(starnext,re)	[list {*( F} {abc V} {) F}]
set Palette(starnext,link)  	[list StarNext]

set Palette(starclass,gloss)    [_ "0 or more of preceding class"]
set Palette(starclass,re)	[list {* F}]
set Palette(starclass,link)  	[list StarClass]

set Palette(PossStar,gloss)    [_ "0 or more of preceding (selfish)"]
set Palette(PossStar,re)    [list {*+ F}]
set Palette(PossStar,link)   [list SelfishQuantifier Star]

set Palette(SubReluctantStarPrevDollar,gloss)  [_ "0 or more of preceding (reluctant)"]
set Palette(SubReluctantStarPrevDollar,re)    [list {*? F}]
set Palette(SubReluctantStarPrevDollar,link)   [list ReluctantQuantifier Star]

set Palette(SubReluctantStarPrevBackslash,gloss)  [_ "0 or more of preceding (reluctant)"]
set Palette(SubReluctantStarPrevBackslash,re)	[list {*? F}]
set Palette(SubReluctantStarPrevBackslash,link)   [list ReluctantQuantifier Star]

set Palette(SubHyphenClass,gloss)  [_ "0 or more of preceding class (reluctant)"]
set Palette(SubHyphenClass,re)     [list {- F}];
set Palette(SubHyphenClass,link)     [list HyphenClass ReluctantQuantifier]

set Palette(any,gloss)         [_ {0 or more of following character or block}]
set Palette(any,re)          [list {{any "} F}  {a V} {{"} F}]
set Palette(any,link)          [list Any]

set Palette(starany,gloss)     [_ "0 or more of any character"]
set Palette(starany,re)	  [list {* F}]
set Palette(starany,link)	  [list StarAny]

set Palette(plusprev,gloss)   [_ "1 or more of preceding"]
set Palette(plusprev,re)    [list {+ F}];
set Palette(plusprev,link)    [list Plus]

set Palette(plusprevbs,gloss)   [_ "1 or more of preceding"]
set Palette(plusprevbs,re)    [list {\\+ F}];
set Palette(plusprevbs,link)    [list Plus]

set Palette(plusclass,gloss)   [_ "1 or more of preceding class"]
set Palette(plusclass,re)    [list {+ F}];
set Palette(plusclass,link)    [list PlusClass]

set Palette(PossPlus,gloss)   [_ "1 or more of preceding (selfish)"]
set Palette(PossPlus,re)   			   [list {++ F}];
set Palette(PossPlus,link)   	[list Plus SelfishQuantifier]

set Palette(plusnext,gloss)    [_ "1 or more of the parenthesized group"]
set Palette(plusnext,re)	[list {+( F} {abc V} {) F}]
set Palette(plusnext,link)  	[list PlusNext]

set Palette(atsignonenext,gloss)    [_ "one of the alternatives in the parenthesized group"]
set Palette(atsignonenext,re)	[list {@( F} {ab V} {| F} {cd V} {) F}]
set Palette(atsignonenext,link)  [list AtSignOneNext]

set Palette(SubReluctantPlusPrevDollar,gloss)   [_ "1 or more of preceding (reluctant)"]
set Palette(SubReluctantPlusPrevDollar,re)	   [list {+? F}];
set Palette(SubReluctantPlusPrevDollar,link)	   [list Plus ReluctantQuantifier]

set Palette(SubReluctantPlusPrevBackslash,gloss)  [_ "1 or more of preceding (reluctant)"]
set Palette(SubReluctantPlusPrevBackslash,re)    [list {+? F}];
set Palette(SubReluctantPlusPrevBackslash,link)    [list Plus ReluctantQuantifier]

set Palette(some,gloss)        [_ {1 or more of following character or block}]
set Palette(some,re)         [list {{some "} F}  {a V} {{"} F}]

set Palette(plusany,gloss)     [_ "1 or more of any character"]
set Palette(plusany,re)     [list {+ F}];
set Palette(plusany,link)     [list PlusAny]

set Palette(crosshatchany,gloss)  [_ {1 or more of preceding character}]
set Palette(crosshatchany,re)     [list {\# F}];
set Palette(crosshatchany,link)     [list CrosshatchAny]

set Palette(qmopt,gloss)       [_ "0 or 1 of preceding"];
set Palette(qmopt,re)       [list {? F}];;
set Palette(qmopt,link)       [list ZeroOneQMark]

set Palette(qmoptclass,gloss)       [_ "0 or 1 of preceding class"];
set Palette(qmoptclass,re)       [list {? F}];;
set Palette(qmoptclass,link)       [list ZeroOneQMarkClass]

set Palette(qmoptnext,gloss)       [_ "0 or 1 of the parenthesized group"];
set Palette(qmoptnext,re)       [list {?( F} {ab V} {) F}];
set Palette(qmoptnext,link)       [list ZeroOneQMarkNext]

set Palette(PossQMark,gloss)   [_ "0 or 1 of preceding (selfish)"]
set Palette(PossQMark,re)   [list {?+ F}];
set Palette(PossQMark,link)   [list ZeroOneQMark SelfishQuantifier]

set Palette(SubReluctantQuestionMarkPrevDollar,gloss)       [_ "0 or 1 of preceding (reluctant)"]
set Palette(SubReluctantQuestionMarkPrevDollar,re)       [list {?? F}];
set Palette(SubReluctantQuestionMarkPrevDollar,link)       [list ZeroOneQMark ReluctantQuantifier]

set Palette(SubReluctantQuestionMarkPrevBackslash,gloss)    [_ "0 or 1 of preceding (reluctant)"]
set Palette(SubReluctantQuestionMarkPrevBackslash,re)       [list {?? F}];
set Palette(SubReluctantQuestionMarkPrevBackslash,link)    [list ZeroOneQMark ReluctantQuantifier]

set Palette(qmoptbs,gloss)     [_ "0 or 1 of preceding"]
set Palette(qmoptbs,re)     [list {{\?} F}];
set Palette(qmoptbs,link)     [list ZeroOneQMark]

set Palette(qm1,gloss)         [_ "any single character"]
set Palette(qm1,re)         [list {? F}];
set Palette(qm1,link)         [list Dot]

set Palette(qm1bs,gloss)       [_ "any single character"]
set Palette(qm1bs,re)       [list {{\?} F}];
set Palette(qm1bs,link)         [list Dot]

set Palette(commaor,gloss)  [_ {"abc" or "def"}]
set Palette(commaor,re)     [list {abc V} {, F} {def V}];
set Palette(commaor,link)     [list OrString]

set Palette(semiand,gloss)     [_ {"abc" and "def"}];
set Palette(semiand,re)     [list {abc V} {; F} {def V}];
set Palette(semiand,link)     [list AndString]

set Palette(caret,gloss)       [_ {beginning of string}];
set Palette(caret,re)       [list {^ F}];
set Palette(caret,link)       [list BeginningOfString]

set Palette(pabegin,gloss)     [_ {beginning of string}]
set Palette(pabegin,re)     [list {\\A F}];
set Palette(pabegin,link)       [list BeginningOfString]

set Palette(pabegindb,gloss)   [_ {beginning of string}];
set Palette(pabegindb,re)   [list {\\A F} ];
set Palette(pabegindb,link)       [list BeginningOfString]

set Palette(boslq,gloss)     [_ {beginning of string}]
set Palette(boslq,re)     [list {\` F}];
set Palette(boslq,link)       [list BeginningOfString]

set Palette(dollar,gloss)      [_ "end of string"]
set Palette(dollar,re)      [list {$ F}];
set Palette(dollar,link)      [list EndOfString]

set Palette(pzendbs,gloss)     [_ "end of string"]
set Palette(pzendbs,re)     [list {{\z} F}];
set Palette(pzendbs,link)      [list EndOfString]

set Palette(pZendbs,gloss)     [_ {end of string}]
set Palette(pZendbs,re)     [list {\\Z F}];
set Palette(pZendbs,link)      [list EndOfString]

set Palette(pzenddbs,gloss)    [_ {end of string}];
set Palette(pzenddbs,re)    [list {\\z F}];
set Palette(pzenddbs,link)      [list EndOfString]

set Palette(pZenddbs,gloss)    [_ {end of string}];
set Palette(pZenddbs,re)    [list {\\\\Z F}];
set Palette(pZenddbs,link)      [list EndOfString]

set Palette(eosrq,gloss)     [_ {end of string}]
set Palette(eosrq,re)     [list {\' F}];
set Palette(eosrq,link)       [list EndOfString]

set Palette(langle,gloss)      [_ {beginning of word}];
set Palette(langle,re)      [list {\< F}];
set Palette(langle,link)      [list BeginningOfWord]

set Palette(rangle,gloss)      [_ {end of word}];
set Palette(rangle,re)      [list {\> F}];
set Palette(rangle,link)      [list EndOfWord];

set Palette(WordBoundary,gloss) [_ "word boundary"]
set Palette(WordBoundary,re) [list {\b F}]
set Palette(WordBoundary,link) [list WordBoundary]

set Palette(WordBoundaryY,gloss) [_ "word boundary"]
set Palette(WordBoundaryY,re) [list {\\y F}]
set Palette(WordBoundaryY,link) [list WordBoundary]

set Palette(WordBoundaryYBs,gloss) [_ "word boundary"]
set Palette(WordBoundaryYBs,re) [list {\\y F}]
set Palette(WordBoundaryYBs,link) [list WordBoundary]

set Palette(WordBoundaryBs,gloss) [_ "word boundary"]
set Palette(WordBoundaryBs,re) [list {\\b F}]
set Palette(WordBoundaryBs,link) [list WordBoundary]

set Palette(NonWordBoundary,gloss) [_ "non-word boundary"]
set Palette(NonWordBoundary,re) [list {\B F}]
set Palette(NonWordBoundary,link) [list NonWordBoundary]

set Palette(NonWordBoundaryBs,gloss) [_ "non-word boundary"]
set Palette(NonWordBoundaryBs,re) [list {\\B F}]
set Palette(NonWordBoundaryBs,link) [list NonWordBoundary]

set Palette(set,gloss)         [_ "any character in the set"]
set Palette(set,re)            [list {[ F} {abc V} {] F}]
set Palette(set,link)            [list Set]

set Palette(setcomp,gloss)     [_ {any character not in the set}];
set Palette(setcomp,re)     [list {[^ F} {abc V} {] F}];
set Palette(setcomp,link)     [list SetComplement]

set Palette(setcomptilde,gloss)     [_ {any character not in the set}];
set Palette(setcomptilde,re)     [list {[~ F} {abc V} {] F}];
set Palette(setcomptilde,link)     [list SetComplement]

set Palette(setcompbang,gloss)     [_ {any character not in the set}];
set Palette(setcompbang,re)     [list {[! F} {abc V} {] F}];
set Palette(setcompbang,link)     [list SetComplement]

set Palette(range,gloss)       [_ {any character from a through d}];
set Palette(range,re)       [list {[ F} {a V} {- F} {d V} {] F}];
set Palette(range,link)       [list Range]

set Palette(multirange,gloss)       [_ {any character from a through d or w through z} ];
set Palette(multirange,re)       [list {[ F} {a V} {- F} {d V} {w V} {- F} {z V} {] F}];
set Palette(multirange,link)       [list MultiRange]

set Palette(group,gloss)       [_ {group}];
set Palette(group,re)       [list {( F} {abc V} {) F}];
set Palette(group,link)       [list Group]

set Palette(groupbs,gloss)     [_ {group}];
set Palette(groupbs,re)     [list {\( F} {abc V} {\) F}];
set Palette(groupbs,link)       [list Group]

set Palette(ObligatoryQuantifierGroup,gloss)     [_ {obligatorily quantified group}];
set Palette(ObligatoryQuantifierGroup,re)     [list {\( F} {abc V} {\) F}];
set Palette(ObligatoryQuantifierGroup,link)       [list ObligatoryQuantifierGroup]

set Palette(groupdbs,gloss)    [_ {group}];
set Palette(groupdbs,re)    [list {\\( F} {abc V} {\\) F}];
set Palette(groupdbs,link)       [list Group]

set Palette(ncgroup,gloss)     [_ {no capture group}];
set Palette(ncgroup,re)     [list {(?: F} {abc V} {) F}];
set Palette(ncgroup,link)     [list NoCaptureGroup]

set Palette(ncgroupdb,gloss)   [_ {no capture group}];
set Palette(ncgroupdb,re)   [list {(?: F} {abc V} {) F} ];
set Palette(ncgroupdb,link)     [list NoCaptureGroup]

set Palette(groupcomp,gloss)   [_ {complement of group}];
set Palette(groupcomp,re)   [list {!( F} {abc V} {) F} ];
set Palette(groupcomp,link)     [list GroupComplement]

set Palette(repfixed,gloss)    [_ "n copies of preceding re"];
set Palette(repfixed,re)    [list {\{ F} {n V} {\} F}];
set Palette(repfixed,link)    [list NCopies]

set Palette(repfixedbs,gloss)  [_ "n copies of preceding re"];
set Palette(repfixedbs,re)  [list {\{} F {n V} {\} F}];
set Palette(repfixedbs,link)  [list NCopies]

set Palette(repmin,gloss)      [_ "at least n copies of preceding re"];
set Palette(repmin,re)      [list {\{ F} {n V} {,\} F}];
set Palette(repmin,link)      [list MNAtLeast]

set Palette(PossAtLeastM,gloss) [_ "at least n copies of preceding re (selfish)"];
set Palette(PossAtLeastM,re) [list {\{ F} {n V} {,\}+ F}];
set Palette(PossAtLeastM,link) [list MNAtLeast SelfishQuantifier]

set Palette(repminbs,gloss)    [_ "at least n copies of preceding re"];
set Palette(repminbs,re)    [list {{\{} F}   {n V}   {{,\}} F} ];
set Palette(repminbs,link) [list MNAtLeast]

set Palette(reprange,gloss)    [_ {from m to n of preceding re}];
set Palette(reprange,re)    [list {\{ F} {m V} {, F} {n V} {\} F}];
set Palette(reprange,link)    [list MNRange]

set Palette(PossMToN,gloss)    [_ {from m to n of preceding re (selfish)}];
set Palette(PossMToN,re)    [list {\{ F} {m V} {, F} {n V} {\}+ F}];
set Palette(PossMToN,link)    [list MNRange SelfishQuantifier]

set Palette(SubReluctantIntegerRangeDollar,gloss)    [_ {from m to n of preceding re (reluctant)}];
set Palette(SubReluctantIntegerRangeDollar,re)      [list {\{ F} {m V} {, F} {n V} {\}? F}];
set Palette(SubReluctantIntegerRangeDollar,link)      [list MNRange ReluctantQuantifier]

set Palette(SubReluctantIntegerRangeBackslash,gloss)    [_ {from m to n of preceding re (reluctant)}];
set Palette(SubReluctantIntegerRangeBackslash,re)   [list {\{ F} {m V} {, F} {n V} {\}? F}];
set Palette(SubReluctantIntegerRangeBackslash,link)      [list MNRange ReluctantQuantifier]

set Palette(reprangebs,gloss)  [_ {from m to n of preceding re}];
set Palette(reprangebs,re)  [list  {\\\{ F} {m V} {, F} {n V} {\\\} F} ];
set Palette(reprangebs,link)  [list  MNRange]

set Palette(reprangedbs,gloss) [_ {from m to n of preceding re}];
set Palette(reprangedbs,re)  [list  {\\\\\{ F} {m V} {, F} {n V} {\\\\\} F} ];
set Palette(reprangedbs,link)  [list  MNRange]

set Palette(rangerebol,gloss)  [_ {from m to n of following}];
set Palette(rangerebol,re)  [list {\[ F} {m V} {{ } F} {n V} {\" F} {ab V} {\"\] F}];

set Palette(pipe,gloss)         [_ {a or b}];
set Palette(pipe,re)         [list {( F} {a V} {| F} {b V} {) F}];
set Palette(pipe,link)         [list OrString]

set Palette(pipebs,gloss)       [_ {a or b}];
set Palette(pipebs,re)       [list  {( F} {a V} {\\| F} {b V} {) F} ];
set Palette(pipebs,link)         [list OrString]

set Palette(pipedbs,gloss)      [_ {a or b}];
set Palette(pipedbs,re)   [list  {( F} {a V} {\\\\| F} {b V} {) F} ];
set Palette(pipedbs,link)         [list OrString]

set Palette(pipedbsall,gloss)   [_ {a or b}];
set Palette(pipedbsall,re)   [list  {\\\\( F} {a V} {\\\\| F} {b V} {\\\\) F} ];
set Palette(pipedbsall,link)         [list OrString]

set Palette(piperebol,gloss)  [_ {a or b}];
set Palette(piperebol,re)  [list {\[\" F} {a V} {\"|\" F} {b V} {\"\] F}];
set Palette(piperebol,link)         [list OrString]

set Palette(altcomma,gloss)   [_ {string ab or cd or ef}];
set Palette(altcomma,re)   [list {\{ F} {{ab} V} {, F} {{cd} V} {, F} {ef V} {\} F}];
set Palette(altcomma,link)         [list OrString]

set Palette(backref,gloss)    [_ {match what is matched by kth subexpression}];
set Palette(backref,re)    [list {\\ F} {k V}];
set Palette(backref,link)    [list BackReferenceMatch]

set Palette(backrefksh,gloss)    [_ {match what is matched by kth subexpression}];
set Palette(backrefksh,re)    [list {\\ F} {k V}];
set Palette(backrefksh,link)    [list BackReferenceMatch]

set Palette(backrefper,gloss) [_ {match what is matched by kth subexpression}];
set Palette(backrefper,re) [list {% F} {k V}];
set Palette(backrefper,link) [list BackReferenceMatch]

set Palette(backrefdbs,gloss) [_ {match what is matched by kth subexpression}];
set Palette(backrefdbs,re) [list {\\\\ F} {k V}];
set Palette(backrefdbs,link) [list BackReferenceMatch]

set Palette(backrefbsall,gloss) [_ {match what is matched by kth subexpression}];
set Palette(backrefbsall,re) [list {\\ F} {k V}];
set Palette(backrefbsall,link) [list BackReferenceMatch]

set Palette(backrefdbsall,gloss) [_ {match what is matched by kth subexpression}];
set Palette(backrefdbsall,re) [list {\\\\ F} {k V}];
set Palette(backrefdbsall,link) [list BackReferenceMatch]

set Palette(baldlim,gloss)    [_ {a string beginning with x and ending with y}];
set Palette(baldlim,re)    [list {%b F} {xy V}];
set Palette(baldlim,link)    [list XYPair]

set Palette(alnum,gloss)      [_ {any alphanumeric character}];
set Palette(alnum,re)      [list {[[:alnum:]] F}];
set Palette(alnum,link)    [list AlphaNumWord]

set Palette(alnumrebol,gloss) [_ {any alphanumeric character}];
set Palette(alnumrebol,re) [list {alnum F}];
set Palette(alnumrebol,link)    [list AlphaNumWord]

set Palette(lalnum,gloss)     [_ {any alphanumeric character}];
set Palette(lalnum,re)     [list {%w F}];
set Palette(lalnum,link)    [list AlphaNumWord]

set Palette(lalnumc,gloss)    [_ {any non-alphanumeric character}];
set Palette(lalnumc,re)    [list {%W F}];
set Palette(lalnum,link)    [list AlphaNumWord]

set Palette(alpha,gloss)      [_ {any alphabetic character}];
set Palette(alpha,re)      [list {[[:alpha:]] F}];
set Palette(alpha,link)      [list Alpha]

set Palette(alpharebol,gloss) [_ {any alphabetic character}];
set Palette(alpharebol,re) [list {alpha F}];
set Palette(alpharebol,link)      [list Alpha]

set Palette(lalpha,gloss)     [_ {any alphabetic character}];
set Palette(lalpha,re)     [list {%a F}];
set Palette(lalpha,link)      [list Alpha]

set Palette(lalphac,gloss)    [_ {any non-alphabetic character}];
set Palette(lalphac,re)    [list {%A F}];
set Palette(lalphac,link)      [list Alpha]

set Palette(blank,gloss)      [_ {any space or tab character}];
set Palette(blank,re)      [list {[[:blank:]] F}];
set Palette(blank,link)      [list Blank];

set Palette(cntrl,gloss)      [_ {any control character}];
set Palette(cntrl,re)      [list {[[:cntrl:]] F}];
set Palette(cntrl,link)    [list ControlCharacter]

set Palette(lcntrl,gloss)     [_ {any control character}];
set Palette(lcntrl,re)     [list {%c F}];
set Palette(lcntrl,link)    [list ControlCharacter]

set Palette(lcntrlc,gloss)    [_ {any non control character}];
set Palette(lcntrlc,re)    [list {%C F}];
set Palette(lcntrlc,link)    [list ControlCharacter]

set Palette(graph,gloss)      [_ {any visible character}];
set Palette(graph,re)      [list {[[:graph:]] F}];
set Palette(graph,link)      [list Visible];

set Palette(print,gloss)      [_ {any printable character}];
set Palette(print,re)      [list {[[:print:]] F}];
set Palette(print,link)      [list Visible]

set Palette(space,gloss)      [_ {any space character}];
set Palette(space,re)      [list {[[:space:]] F}];
set Palette(space,link)      [list Whitespace]

set Palette(lspace,gloss)     [_ {any space character}];
set Palette(lspace,re)     [list {%s F}];
set Palette(lspace,link)      [list Whitespace]

set Palette(pspace,gloss)     [_ {any space character}];
set Palette(pspace,re)     [list {\\s F}];
set Palette(pspace,link)     [list Whitespace]

set Palette(pspacedb,gloss)   [_ {one space character}];
set Palette(pspacedb,re)   [list {\\\\s F}];
set Palette(pspacedb,link)   [list Whitespace]

set Palette(lspacec,gloss)    [_ {one non space character}];
set Palette(lspacec,re)    [list {%S F}];
set Palette(lspacec,link)    [list Whitespace]

set Palette(pspacec,gloss)    [_ {one non-space character}];
set Palette(pspacec,re)    [list {\\S F}];
set Palette(pspacec,link)    [list Whitespace]

set Palette(pspacedbc,gloss)  [_ {one non-space character}];
set Palette(pspacedbc,re)  [list {\\\\S F}];
set Palette(pspacedbc,link)  [list Whitespace]

set Palette(punct,gloss)      [_ {one punctuation symbol}];
set Palette(punct,re)      [list {[[:punct:]] F}];
set Palette(punct,link)      [list Punctuation]

set Palette(lpunct,gloss)     [_ {one punctuation symbol}];
set Palette(lpunct,re)     [list {%p F}];
set Palette(lpunct,link)     [list Punctuation]

set Palette(lpunctc,gloss)    [_ {one non-punctuation symbol}];
set Palette(lpunctc,re)    [list {%P F}];
set Palette(lpunctc,link)    [list Punctuation]

set Palette(lower,gloss)      [_ {one lower-case alphabetic character}];
set Palette(lower,re)      [list {[[:lower:]] F}];
set Palette(lower,link)      [list LowerCaseLetter]

set Palette(lowerrebol,gloss) [_ {one lower-case alphabetic character}];
set Palette(lowerrebol,re) [list {lower F}];
set Palette(lowerrebol,link)      [list LowerCaseLetter]

set Palette(llower,gloss)     [_ {one lower-case alphabetic character}];
set Palette(llower,re)     [list {%l F}];
set Palette(llower,link)      [list LowerCaseLetter]

set Palette(llowerc,gloss)    [_ {one non lower-case alphabetic character}];
set Palette(llowerc,re)    [list {%L F}];
set Palette(llowerc,link)      [list LowerCaseLetter]

set Palette(upper,gloss)      [_ {one upper-case alphabetic character}];
set Palette(upper,re)      [list {[[:upper:]] F}];
set Palette(upper,link)      [list UpperCaseLetter]

set Palette(upperrebol,gloss) [_ {one upper-case alphabetic character}];
set Palette(upperrebol,re) [list {upper F}];
set Palette(upperrebol,link)      [list UpperCaseLetter]

set Palette(lupper,gloss)     [_ {one upper-case alphabetic character}];
set Palette(lupper,re)     [list {%u F}];
set Palette(lupper,link)      [list UpperCaseLetter]

set Palette(lupperc,gloss)    [_ {one non upper-case alphabetic character}];
set Palette(lupperc,re)    [list {%U F}];
set Palette(lupperc,link)      [list UpperCaseLetter]

set Palette(digit,gloss)      [_ {one digit}];
set Palette(digit,re)      [list {[[:digit:]] F}];
set Palette(digit,link)    [list Digit]

set Palette(digitrebol,gloss) [_ {one digit}];
set Palette(digitrebol,re) [list {digit F}];
set Palette(digitrebol,link)    [list Digit]

set Palette(compposixclassinner,gloss)      [_ {complement of named class foo}];
set Palette(compposixclassinner,re)      [list {[[:^  F} {foo V} {:]] F}];
set Palette(compposixclassinner,link)      [list ClassComplement]

set Palette(compposixclassouter,gloss)      [_ {complement of named class foo}];
set Palette(compposixclassouter,re)      [list {[^[:  F} {foo V} {:]] F}];
set Palette(compposixclassouter,link)      [list ClassComplement]

set Palette(ldigit,gloss)     [_ {one digit}];
set Palette(ldigit,re)     [list {%d F}];
set Palette(ldigit,link)    [list Digit]

set Palette(pdigit,gloss)     [_ {one digit}];
set Palette(pdigit,re)     [list {\\d F}];
set Palette(pdigit,link)    [list Digit]

set Palette(pdigitdb,gloss)   [_ {one digit}];
set Palette(pdigitdb,re)   [list {\\\\d F}];
set Palette(pdigitdb,link)    [list Digit]

set Palette(ldigitc,gloss)    [_ {one non-digit}];
set Palette(ldigitc,re)    [list {%D F}];
set Palette(ldigitc,link)    [list Digit]

set Palette(pdigitc,gloss)    [_ {one non-digit}];
set Palette(pdigitc,re)    [list {\\D F}];
set Palette(pdigitc,link)    [list Digit]

set Palette(pdigitdbc,gloss)  [_ {one non-digit}];
set Palette(pdigitdbc,re)  [list {\\\\D F}];
set Palette(pdigitcdb,link)    [list Digit]

set Palette(xdigit,gloss)     [_ {one hex digit}];
set Palette(xdigit,re)     [list {[[:xdigit:]] F}];
set Palette(xdigit,link)    [list HexDigit]

set Palette(xdigitrebol,gloss) [_ {one hex digit}];
set Palette(xdigitrebol,re) [list {xdigit F}];
set Palette(xdigitrebol,link)    [list HexDigit]

set Palette(lxdigit,gloss)    [_ {one hex digit}];
set Palette(lxdigit,re)    [list {%x F}];
set Palette(lxdigit,link)    [list HexDigit]

set Palette(lxdigitc,gloss)   [_ {one non hex digit}];
set Palette(lxdigitc,re)   [list {%X F}];
set Palette(lxdigitc,link)    [list HexDigit]

set Palette(bsw,gloss)        [_ {one alphanumeric character}];
set Palette(bsw,re)        [list {\\w F}];
set Palette(bsw,link)        [list AlphaNumWord];

set Palette(pbsw,gloss)       [_ {one alphanumeric character or underscore}];
set Palette(pbsw,re)       [list {\\w F}];
set Palette(pbsw,link)    [list AlphaNumWord]

set Palette(pbbsw,gloss)      [_ {one alphanumeric character or underscore}];
set Palette(pbbsw,re)      [list {\\\\w F}];
set Palette(pbbsw,link)    [list AlphaNumWord]

set Palette(bsW,gloss)        [_ {one non-alphanumeric character}];
set Palette(bsW,re)        [list {\\W F}];
set Palette(bsW,link)        [list AlphaNumword];

set Palette(bsWdb,gloss)      [_ {one non-alphanumeric character}];
set Palette(bsWdb,re)      [list {\\\\W F}];
set Palette(bsWdb,link)        [list AlphaNumword];

set Palette(pbsW,gloss)       [_ {one character not alphanumeric or underscore}];
set Palette(pbsW,re)       [list {\\W F}];
set Palette(pbsW,link)    [list AlphaNumWord]

set Palette(octal,gloss)      [_ {a character code in octal}];
set Palette(octal,re)      [list {\\ F} {155 V}];
set Palette(octal,link)      [list OctalCode];

set Palette(octalo,gloss)      [_ {a character code in octal}];
set Palette(octalo,re)      [list {\\o F} {155 V}];
set Palette(octalo,link)      [list OctalCode];

set Palette(decimald,gloss)      [_ {a character code in decimal}];
set Palette(decimald,re)      [list {\\d F} {155 V}];
set Palette(decimald,link)      [list DecimalCode];

set Palette(octaldb,gloss)    [_ {a character code in octal}];
set Palette(octaldb,re)    [list {\\\\ F} {155 V}];
set Palette(octaldb,link)    [list OctalCode];

set Palette(hexl,gloss)       [_ {a character code in hexadecimal}];
set Palette(hexl,re)       [list {\\x F} {6d V}];
set Palette(hexl,link)       [list HexCode]

set Palette(hexldb,gloss)     [_ {a character code in hexadecimal}];
set Palette(hexldb,re)     [list {\\\\x F} {6d V}];
set Palette(hexldb,link)     [list HexCode]

set Palette(hexu,gloss)       [_ {a character code in hexadecimal}];
set Palette(hexu,re)       [list {\\x F} {6D V}];
set Palette(hexu,link)       [list HexCode]

set Palette(hexudb,gloss)     [_ {a character code in hexadecimal}];
set Palette(hexudb,re)     [list {\\\\x F} {6D V}];
set Palette(hexudb,link)     [list HexCode]

set Palette(bell,gloss)       [_ {bell character}];
set Palette(bell,re)       [list {\\a F}];
set Palette(bell,link)       [list Bell]

set Palette(belldb,gloss)     [_ {bell character}];
set Palette(belldb,re)     [list {\\\\a F}];
set Palette(belldb,linke)   [list Bell]

set Palette(backspace,gloss)     [_ {backspace character (\u0008)}];
set Palette(backspace,re)     [list {\\b F}];
#set Palette(backspace,linke)   [list Bell]

set Palette(escape,gloss)     [_ {escape character}];
set Palette(escape,re)     [list {\\e F}];
set Palette(escape,link)    [list Escape]

set Palette(escapedb,gloss)   [_ {escape character}];
set Palette(escapedb,re)   [list {\\\\e F}];
set Palette(escapedb,link)   [list Escape];

set Palette(cr,gloss)         [_ {carriage return character}];
set Palette(cr,re)         [list {\\r F}];
set Palette(cr,link)         [list CarriageReturn]

set Palette(crdb,gloss)       [_ {carriage return character}];
set Palette(crdb,re)       [list {\\\\r F}];
set Palette(crdb,link)         [list CarriageReturn]

set Palette(tab,gloss)        [_ {tab character}];
set Palette(tab,re)        [list {\\t F}];
set Palette(tab,link)        [list Tab]

set Palette(tabdb,gloss)      [_ {tab character}];
set Palette(tabdb,re)      [list {\\\\t F}];
set Palette(tabdb,link)        [list Tab]

set Palette(LiteralMetachar,gloss)      [_ "escape to make metacharacter literal"]
set Palette(LiteralMetachar,re)      [list {\\ F} {x V}];
set Palette(LiteralMetachar,link)      [list LiteralMetachar]

set Palette(controlc,gloss)   [_ {control X}];
set Palette(controlc,re)   [list {\\c F} {X V}];
set Palette(controlc,link)   [list ControlCharacter]

set Palette(controlc,gloss)   [_ {control X}];
set Palette(controlcdb,re) [list {\\\\c F} {X V}];
set Palette(controlcdb,link) [list ControlCharacter]

set Palette(comment,gloss)    [_ {comment}];
set Palette(comment,re)    [list {(?\# F} {foo V} {) F}];
set Palette(comment,link)    [list Comment]

set Palette(flagi,gloss)      [_ {case insensitive flag}];
set Palette(flagi,re)      [list {(?i) F}];
set Palette(flagi,link)      [list CaseInsensitive]

set Palette(flagiu,gloss)      [_ {Unicode case insensitive flag}];
set Palette(flagiu,re)      [list {(?iu) F}];
set Palette(flagiu,link)      [list CaseInsensitiveIU]

set Palette(UnsetFlag,gloss)      [_ {unset flag}];
set Palette(UnsetFlag,re)      [list { (?- F} {f V} {) F}];
set Palette(UnsetFlag,link)      [list UnsetFlag]

set Palette(flagL,gloss)      [_ {locale flag L}];
set Palette(flagL,re)      [list {(?L) F}];

set Palette(flagx,gloss)      [_ {verbose flag}];
set Palette(flagx,re)      [list {(?x) F}];
#set Palette(flagx,link)      [list VerboseFlag]

set Palette(flagb,gloss)      [_ {basic regexp flag}];
set Palette(flagb,re)      [list {(?b) F}];
#set Palette(flagb,link)      [list BasicFlag]

set Palette(flage,gloss)      [_ {extended regexp flag}];
set Palette(flage,re)      [list {(?e) F}];
#set Palette(flage,link)      [list ExtendedFlag]

set Palette(flagq,gloss)      [_ {literal string flag}];
set Palette(flagq,re)      [list {(?q) F}];
#set Palette(flagq,link)      [list LiteralFlag]

set Palette(taggedgroup,gloss)   [_ {tagged group}];
set Palette(taggedgroup,re)   [list {(?P<  F} {tag V} {> F} {xy V} {) F}];
set Palette(taggedgroup,link)   [list Taggedgroup]

set Palette(taggedgroupref,gloss)   [_ {tagged group backreference}];
set Palette(taggedgroupref,re)    [list { (?P= F}  {tag V} {) F} ];
set Palette(taggedgroupref,link)   [list TaggedBackReference]

set Palette(uname,gloss)      [_ {Named Unicode character}];
set Palette(uname,re)      [list {\\N\{ F} {name V} {\}  F}];
set Palette(uname,link)  [list UnicodeName]

set Palette(unamedb,gloss)      [_ {Named Unicode character}];
set Palette(unamedb,re)    [list {\\\\N\{ F} {name V} { \} F}];
set Palette(unamedb,link)  [list UnicodeName]

set Palette(jLower,gloss)     [_ {A lower case ASCII letter}];
set Palette(jLower,re)     [list {\\p\{Lower\} F}];
set Palette(jLower,link)     [list LowerCaseASCIILetter]

set Palette(jLowerdb,gloss)   [_ {A lower case ASCII letter}];
set Palette(jLowerdb,re)   [list {\\\\p\{Lower} F}];
set Palette(jLowerdb,link)     [list LowerCaseASCIILetter]

set Palette(jLowerc,gloss)    [_ {Not a lower case ASCII letter}];
set Palette(jLowerc,re)    [list {\\P\{ F} {Lower F} {\} F}];
set Palette(jLowerc,link)     [list LowerCaseASCIILetter]

set Palette(jLowercdb,gloss)  [_ {Not a lower case ASCII letter}];
set Palette(jLowercdb,re)  [list {\\\\P\{ F} {Lower F} {\} F}];
set Palette(jLowercdb,link)     [list LowerCaseASCIILetter]

set Palette(jUpper,gloss)     [_ {An upper case ASCII letter}];
set Palette(jUpper,re)    [list {\\p\{ F} {Upper F} {\} F}];
set Palette(jUpper,rlink)    [list UpperCaseASCIILetter]

set Palette(jUpperdb,gloss)   [_ {A upper case ASCII letter}];
set Palette(jUpperdb,re)   [list {\\\\p\{ F} {Upper F} {\} F}];
set Palette(jUpperdb,rlink)    [list UpperCaseASCIILetter]

set Palette(jUpperc,gloss)    [_ {Not an upper case ASCII letter}];
set Palette(jUpperc,re)    [list {\\P\{ F} {Upper F} {\} F}];
set Palette(jUpperc,rlink)    [list UpperCaseASCIILetter]

set Palette(jUppercdb,gloss)  [_ {Not an upper case ASCII letter}];
set Palette(jUppercdb,re)  [list {\\\\P\{ F} {Upper F} {\} F}];
set Palette(jUppercdb,rlink)    [list UpperCaseASCIILetter]

set Palette(jAscii,gloss)     [_ {An ASCII character}];
set Palette(jAscii,re)     [list {\\p\{ F} {ASCII F} {\} F}];
set Palette(jAscii,link)     [list ASCIIChar]

set Palette(jAsciidb,gloss)   [_ {An ASCII character}];
set Palette(jAsciidb,re)   [list {\\\\p\{ F} {ASCII F} {\} F}];
set Palette(jAsciidb,link)     [list ASCIIChar]

set Palette(jAsciic,gloss)    [_ {Not an ASCII character}];
set Palette(jAsciic,re)    [list {\\P\{ F} {ASCII F} {\} F}];
set Palette(jAsciic,link)     [list ASCIIChar]

set Palette(jAsciicdb,gloss)  [_ {Not an ASCII character}];
set Palette(jAsciicdb,re)  [list {\\\\P\{ F} {ASCII F} {\} F}];
set Palette(jAsciicdb,link)     [list ASCIIChar]

set Palette(jAlpha,gloss)     [_ {An ASCII letter}];
set Palette(jAlpha,re)       [list {\\p\{ F} {Alpha F} {\} F}];
set Palette(jAlpha,link)       [list ASCIILetter]

set Palette(jAlphadb,gloss) [_ {An ASCII letter}];
set Palette(jAlphadb,re)  [list {\\\\p\{ F} {Alpha F} {\} F}];
set Palette(jAlphadb,link)       [list ASCIILetter]

set Palette(jAlphac,gloss)    [_ {Not an ASCII letter}];
set Palette(jAlphac,re)      [list {\\P\{ F} {Alpha F} {\} F}];
set Palette(jAlphac,link)       [list ASCIILetter]

set Palette(jAlphacdb,gloss)  [_ {Not an ASCII letter}];
set Palette(jAlphacdb,re)    [list {\\\\P\{ F} {Alpha F} {\} F}];
set Palette(jAlphacdb,link)       [list ASCIILetter]

set Palette(jDigit,gloss)     [_ {An ASCII digit}];
set Palette(jDigit,re)       [list {\\p\{ F} {Digit F} {\} F}];
set Palette(jDigit,link)    [list ASCIIDigit]

set Palette(jDigitdb,gloss)   [_ {An ASCII digit}];
set Palette(jDigitdb,re)     [list {\\\\p\{ F} {Digit F} {\} F}];
set Palette(jDigitdb,link)    [list ASCIIDigit]

set Palette(jDigitc,gloss)    [_ {Not an ASCII digit}];
set Palette(jDigitc,re)      [list {\\P\{ F} {Digit F} {\} F}];
set Palette(jDigitc,link)    [list ASCIIDigit]

set Palette(jDigitcdb,gloss)  [_ {Not an ASCII digit}];
set Palette(jDigitcdb,re)    [list {\\\\P\{ F} {Digit F} {\} F}];
set Palette(jDigitcdb,link)    [list ASCIIDigit]

set Palette(jXdigit,gloss)    [_ {A hexadecimal digit}];
set Palette(jXdigit,re)      [list {\\p\{ F} {XDigit F} {\} F}];
set Palette(jXdigit,link)    [list HexDigit]

set Palette(jXdigitdb,gloss)  [_ {A hexadecimal digit}];
set Palette(jXdigitdb,re)    [list {\\\\p\{XDigit\} F}];
set Palette(jXdigitdb,link)    [list HexDigit]

set Palette(jXdigitc,gloss)   [_ {Not a hexadecimal digit}];
set Palette(jXdigitc,re)     [list {\P{XDigit} F}];
set Palette(jXdigitc,link)    [list HexDigit]

set Palette(jXdigitcdb,gloss) [_ {Not a hexadecimal digit}];
set Palette(jXdigitcdb,re)   [list {\\\\P\{XDigit\} F}];
set Palette(jXdigitcdb,link)    [list HexDigit]

set Palette(jAlnum,gloss)     [_ {An ASCII letter or digit}];
set Palette(jAlnum,re)        [list {\\p\{Alnum\} F}];
set Palette(jAlnum,link)    [list ASCIIAlphaDigit]

set Palette(jAlnumdb,gloss)   [_ {An ASCII letter or digit}];
set Palette(jAlnumdb,re)      [list {\\\\p\{Alnum\} F}];
set Palette(jAlnumdb,link)    [list ASCIIAlphaDigit]

set Palette(jAlnumc,gloss)    [_ {Not an ASCII letter or digit}];
set Palette(jAlnumc,re)       [list {\\P\{Alnum\} F}];
set Palette(jAlnumc,link)    [list ASCIIAlphaDigit]

set Palette(jAlnumcdb,gloss)  [_ {Not an ASCII letter or digit}];
set Palette(jAlnumcdb,re)     [list {\\\\P\{Alnum\} F}];
set Palette(jAlnumcdb,link)    [list ASCIIAlphaDigit]

set Palette(jPunct,gloss)     [_ {An ASCII punctuation symbol}];
set Palette(jPunct,re)        [list {\\p\{Punct\} F}];
set Palette(jPunct,link)      [list ASCIIPunctuation]

set Palette(jPunctdb,gloss)   [_ {An ASCII punctuation symbol}];
set Palette(jPunctdb,re)      [list {\\\\p\{Punct\} F}];
set Palette(jPunctdb,link)      [list ASCIIPunctuation]

set Palette(jPunctc,gloss)    [_ {Not an ASCII punctuation symbol}];
set Palette(jPunctc,re)       [list {\\P\{Punct\} F}];
set Palette(jPunctc,link)      [list ASCIIPunctuation]

set Palette(jPunctcdb,gloss)  [_ {Not an ASCII punctuation symbol}];
set Palette(jPunctcdb,re)     [list {\\\\P\{Punct\} F}];
set Palette(jPunctcdb,link)      [list ASCIIPunctuation]

set Palette(jGraph,gloss)     [_ {A visible ASCII character}];
set Palette(jGraph,re)     [list {\\p\{Graph\} F} ];
set Palette(jGraph,link)     [list Visible]

set Palette(jGraphdb,gloss)   [_ {A visible ASCII character}];
set Palette(jGraphdb,re)   [list {\\\\p\{Graph\} F} ];
set Palette(jGraphdb,link)   [list Visible]

set Palette(jGraphc,gloss)    [_ {Not a visible ASCII character}];
set Palette(jGraphc,re)    [list {\\P\{Graph\} F} ];
set Palette(jGraphc,link)    [list Visible]

set Palette(jGraphcdb,gloss)  [_ {Not a visible ASCII character}];
set Palette(jGraphcdb,re)  [list {\\\\P\{Graph\} F} ];
set Palette(jGraphcdb,link)     [list Visible]

set Palette(jPrint,gloss)     [_ {A visible ASCII character}];
set Palette(jPrint,re)     [list {\\p\{Print\} F} ];
set Palette(jPrint,link)     [list Visible]

set Palette(jPrintdb,gloss)  [_ {A visible ASCII character}];
set Palette(jPrintdb,re)  [list {\\\\p\{Print\} F} ];
set Palette(jPrintdb,link)  [list Visible]

set Palette(jPrintc,gloss)    [_ {Not a visible ASCII character}];
set Palette(jPrintc,re)   [list {\\P\{Print\} F} ];
set Palette(jPrintc,link)   [list Visible]

set Palette(jPrintcdb,gloss)  [_ {Not a visible ASCII character}];
set Palette(jPrintcdb,re) [list {\\\\P\{Print\} F} ];
set Palette(jPrintcdb,link) [list Visible]

set Palette(jBlank,gloss)     [_ {A space or tab}];
set Palette(jBlank,re)     [list {\\p\{Blank\} F} ];
set Palette(jBlank,link)     [list Blank]

set Palette(jBlankdb,gloss)   [_ {A space or tab}];
set Palette(jBlankdb,re)   [list {\\\\p\{Blank\} F} ];
set Palette(jBlankdb,link)     [list Blank]

set Palette(jBlankc,gloss)    [_ {Not a space or tab}];
set Palette(jBlankc,re)    [list {\\P\{Blank\} F} ];
set Palette(jBlankc,link)     [list Blank]

set Palette(jBlankcdb,gloss)  [_ {Not a space or tab}];
set Palette(jBlankcdb,re)  [list {\\\\P\{Blank\} F} ];
set Palette(jBlankcdb,link)     [list Blank]

set Palette(jSpace,gloss)     [_ {A whitespace character}];
set Palette(jSpace,re)       [list {\\p\{Space\} F} ];
set Palette(jSpace,link)    [list Whitespace]

set Palette(jSpacedb,gloss)  [_ {A whitespace character}];
set Palette(jSpacedb,re)        [list {\\\\p\{Space\} F} ];
set Palette(jSpacedb,link)    [list Whitespace]

set Palette(jSpacec,gloss)    [_ {Not a whitespace character}];
set Palette(jSpacec,re)      [list {\\P\{Space\} F} ];
set Palette(jSpacec,link)    [list Whitespace]

set Palette(jSpacecdb,gloss)    [_ {Not a whitespace character}];
set Palette(jSpacecdb,re)   [list {\\\\P\{Space\} F} ];
set Palette(jSpacecdb,link)    [list Whitespace]

set Palette(jCntrl,gloss)     [_ {A control character}];
set Palette(jCntrl,re)       [list {\\p\{Cntrl\} F} ];
set Palette(jCntrl,link)      [list ControlCharacter]

set Palette(jCntrldb,gloss)   [_ {A control character}];
set Palette(jCntrldb,re)     [list {\\\\p\{Cntrl\} F} ];
set Palette(jCntrdbl,link)      [list ControlCharacter]

set Palette(jCntrlc,gloss)    [_ {Not a control character}];
set Palette(jCntrlc,re)      [list {\\P\{Cntrl\} F} ];
set Palette(jCntrlc,link)      [list ControlCharacter]

set Palette(jCntrlcdb,gloss)  [_ {Not a control character}];
set Palette(jCntrlcdb,re)    [list {\\\\P\{Cntrl\} F} ];
set Palette(jCntrlcdb,link)      [list ControlCharacter]

set Palette(jUBlock,gloss)    [_ {A named Unicode block}];
set Palette(jUBlock,re)    [list {\\p\{ F} {InHiragana V}  {\} F}];
set Palette(jUBlock,link)    [list UnicodeRange]

set Palette(jUBlockdb,gloss)  [_ {A named Unicode block}];
set Palette(jUBlockdb,re)  [list {\\\\p\{ F} {InHiragana V}  {\} F}];
set Palette(jUBlocdbk,link)    [list UnicodeRange]

set Palette(jUBlockc,gloss)   [_ {Not in named Unicode block}];
set Palette(jUBlockc,re)   [list {\\P\{ F} {InHiragana V}  {\} F}];
set Palette(jUBlockc,link)    [list UnicodeRange]

set Palette(jUBlockcdb,gloss) [_ {Not in named Unicode block}];
set Palette(jUBlockcdb,re) [list {\\\\P\{ F} {InHiragana V}  {\} F}];
set Palette(jUBlockcdb,link)    [list UnicodeRange]

set Palette(jUCat,gloss)      [_ {A named Unicode category}];
set Palette(jUCat,re)      [list {\\p\{ F} {Sm V}  {\} F}];
set Palette(jUCat,link)	[list UnicodeCategory]

set Palette(jUCatdb,gloss)    [_ {A named Unicode category}];
set Palette(jUCatdb,re)   [list {\\\\p\{ F} {Sm V}  {\} F}];
set Palette(jUCatdb,link)	[list UnicodeCategory]

set Palette(jUCatc,gloss)     [_ {Not in named Unicode category}];
set Palette(jUCatc,re)     [list {\\P\{ F} {Sm V}  {\} F}];
set Palette(jUCatc,link)	[list UnicodeCategory]

set Palette(jUCatcdb,gloss)   [_ {Not in named Unicode category}];
set Palette(jUCatcdb,re)   [list {\\\\P\{ F} {Sm V}  {\} F}];
set Palette(jUCatcdb,link)	[list UnicodeCategory]

set Palette(jUnion,gloss)     [_ {The union of [1-3] and [d-f]}];
set Palette(jUnion,re)     [list {[ F} {1 V} {- F} {3 V} {[ F}  {d V} {- F} {f V} {]] F}];

set Palette(jInter,gloss)     [_ {The intersection of [d-f] and [a-z]}];
set Palette(jInter,re)     [list {{[} F} {d V} {- F} {f V} {{&&[} F} {a V} {- F} {z V} {{]]} F}];
set Palette(jInter,link)     [list Intersection]

set Palette(plookahead,gloss) [_ {Positive forward assertion}];
set Palette(plookahead,re) [list {(?= F} {xyz V} {) F}];
set Palette(plookahead,link) [list PositiveForwardAssertion]

set Palette(plookback,gloss)  [_ {Positive backward assertion}];
set Palette(plookback,re)  [list {(?<= F} {{xyz} V} {) F}];
set Palette(plookback,link)  [list PositiveBackwardAssertion]

set Palette(nlookahead,gloss) [_ {Negative forward assertion}];
set Palette(nlookahead,re) [list {(?! F} {xyz V} {) F}];
set Palette(nlookahead,link) [list NegativeForwardAssertion]

set Palette(nlookback,gloss)  [_ {Negative backward assertion}];
set Palette(nlookback,re)  [list {(?<! F} {xyz V} {) F}];
set Palette(nlookback,link)  [list NegativeBackwardAssertion]

set Palette(SelfishNoCaptureGroup,gloss)      [_ {selfish no capture group}];
set Palette(SelfishNoCaptureGroup,re)      [list {(?> F} {abc V} {) F}]
set Palette(SelfishNoCaptureGroup,link)      [list SelfishNoCaptureGroup]

set Palette(CondGroupSimple,gloss)      [_ {Group backreference conditional}];
set Palette(CondGroupSimple,re)      [list {(?( F} {k V} {) F} {x V} {) F}]
set Palette(CondGroupSimple,link)      [list SimpleGroupConditional]

set Palette(CondGroupElse,gloss)      [_ {Group backreference conditional with else clause}];
set Palette(CondGroupElse,re)        [list {(?( F} {k V} {) F} {x V} {| F} {y V} {) F}]
set Palette(CondGroupElse,link)      [list ElseGroupConditional]

set Palette(CondPosLookaheadSimple,gloss)      [_ {Positive forward assertion conditional}];
set Palette(CondPosLookaheadSimple,re)     [list {(?(? F} {= F} {w V} {) F} {x V} {) F}]
set Palette(CondPosLookaheaddSimple,link)      [list SimpleLookaroundConditional]

set Palette(CondPosLookaheadElse,gloss)      [_ {Positive forward assertion conditional with else clause}];
set Palette(CondPosLookaheadElse,re)       [list {(?(? F} {= F} {w V} {) F} {x V} {| F} {y V} {) F}]
set Palette(CondPosLookaheadElse,link)      [list ElseLookaroundConditional]

set Palette(CondPosLookbackSimple,gloss)      [_ {Positive backward assertion conditional}];
set Palette(CondPosLookbackSimple,re)     [list {(?(? F} {<= F} {w V} {) F} {x V} {) F}]
set Palette(CondPosLookbackSimple,link)      [list SimpleLookaroundConditional]

set Palette(CondPosLookbackElse,gloss)      [_ {Positive backward assertion conditional with else clause}];
set Palette(CondPosLookbackElse,re)       [list {(?(? F} {<= F} {w V} {) F} {x V} {| F} {y V} {) F}]
set Palette(CondPosLookbackElse,link)      [list ElseLookaroundConditional]

set Palette(CondNegLookaheadSimple,gloss)      [_ {Negative forward assertion conditional}];
set Palette(CondNegLookaheadSimple,re)     [list {(?(? F} {! F} {w V} {) F} {x V} {) F}]
set Palette(CondNegLookaheadSimple,link)      [list SimpleLookaroundConditional]

set Palette(CondNegLookaheadElse,gloss)      [_ {Negative forward assertion conditional with else clause}];
set Palette(CondNegLookaheadElse,re)       [list {{(?(?} F} {! F} {w V} {) F} {x V} {| F} {y V} {) F}]
set Palette(CondNegLookaheadElse,link)      [list ElseLookaroundConditional]

set Palette(CondNegLookbackSimple,gloss)      [_ {Negative backward assertion conditional}];
set Palette(CondNegLookbackSimple,re)     [list {(?(? F} {<! F} {w V} {) F} {x V} {) F}]
set Palette(CondNegLookbackSimple,link)      [list SimpleLookaroundConditional]

set Palette(CondNegLookbackElse,gloss)      [_ {Negative backward assertion conditional with else clause}];
set Palette(CondNegLookbackElse,re)       [list {(?(? F} {<! F} {w V} {) F} {x V} {| F} {y V} {) F}]
set Palette(CondNegLookbackElse,link)      [list ElseLookaroundConditional]

set Palette(SubBackRefBare,gloss)  [_ {Insert the kth captured subgroup}];
set Palette(SubBackRefBare,re)  [list {k V}];
set Palette(SubBackRefBare,Prefix)  "";
set Palette(SubBackRefBare,link)  [list BackReferenceSub]

set Palette(SubBackReferenceDol,gloss)  [_ {Insert the kth captured subgroup}];
set Palette(SubBackReferenceDol,re)  [list {$ F} {k V}];
set Palette(SubBackReferenceDol,Prefix)  {$}
set Palette(SubBackReferenceDol,link) [list BackReferenceSub]

set Palette(SubBackReferenceDolZero,gloss)  [_ {Insert the entire match}];
set Palette(SubBackReferenceDolZero,re)  [list {$0 F}];
set Palette(SubBackReferenceDolZero,link) [list InsertEntireMatch]

set Palette(SubBackReferencePercent,gloss)  [_ {Insert the kth captured subgroup}];
set Palette(SubBackReferencePercent,re)  [list {% F} {k V}];
set Palette(SubBackReferencePercent,Prefix)  {%}
set Palette(SubBackReferencePercent,link) [list BackReferenceSub]

set Palette(SubBackReferencePercentZero,gloss)  [_ {Insert the entire match}];
set Palette(SubBackReferencePercentZero,re)  [list {%0 F}];
set Palette(SubBackReferencePercentZero,link) [list InsertEntireMatch]

set Palette(SubBackRefbs,gloss)   [_ {Insert the kth captured subgroup}]
set Palette(SubBackRefbs,re)  [list {\\ F} {k V}]
set Palette(SubBackRefbs,Prefix)  "\\"
set Palette(SubBackRefbs,link)  [list BackReferenceSub]

set Palette(SubBackRefbsZero,gloss)   [_ {Insert the entire match}]
set Palette(SubBackRefbsZero,re)  [list {\\0 F}]
set Palette(SubBackRefbsZero,link)  [list InsertEntireMatch]

set Palette(SubBackRefdbs,gloss)  [_ {Insert the kth captured subgroup}];
set Palette(SubBackRefdbs,re) [list {\\\\ F} {k V}]
set Palette(SubBackRefdbs,Prefix) {\\}
set Palette(SubBackRefdbs,link) [list BackReferenceSub]

set Palette(SubBackRefdbsZero,gloss)  [_ {Insert the entire match}];
set Palette(SubBackRefdbsZero,re) [list {\\\\0 F}]
set Palette(SubBackRefdbsZero,link) [list InsertEntireMatch]

set Palette(SubBackRefPardbsdbs,gloss)  [_ {Insert the kth captured subgroup}];
set Palette(SubBackRefPardbsdbs,re) [list {\\\\ F} {k V}]
set Palette(SubBackRefPardbsdbs,Prefix) {\\};
set Palette(SubBackRefPardbsdbs,link) [list BackReferenceSub]

set Palette(SubBackRefParbs,gloss)  [_ {Insert the kth captured subgroup}];
set Palette(SubBackRefParbs,re) [list {\\ F} {k V}]
set Palette(SubBackRefParbs,Prefix) "\\" ;
set Palette(SubBackRefParbs,link) [list BackReferenceSub]

set Palette(SubBackRefPardbsdbsZero,gloss)  [_ {Insert the entire match}];
set Palette(SubBackRefPardbsdbsZero,re) [list {\\\\0 F}]
set Palette(SubBackRefPardbsdbsZero,link) [list InsertEntireMatch]

set Palette(SubEntBackRefZero,gloss)  [_ {Insert the entire match}];
set Palette(SubEntBackRefZero,re)  [list {0 F}];
set Palette(SubEntBackRefZero,link)  [list InsertEntireMatch]

set Palette(Subampentbackrefsdbs,gloss)  [_ {Insert the entire match}];
set Palette(Subampentbackrefsdbs,re)  [list {\\\\& F}];
set Palette(Subampentbackrefsdbs,link)  [list InsertEntireMatch]

set Palette(SubDolAmpEntBackRef,gloss) [_ {Insert the entire match} ];
set Palette(SubDolAmpEntBackRef,re) [list {$& F}]
set Palette(SubDolAmpEntBackRef,link)  [list InsertEntireMatch]

set Palette(SubampentbackrefsPardbsdbs,gloss)  [_ {Insert the entire match}];
set Palette(SubampentbackrefsPardbsdbs,re) [list {\\\\& F}];
set Palette(SubampentbackrefsPardbsdbs,link) [list InsertEntireMatch]

set Palette(SubPreMatch,gloss)     [_ {Insert the portion preceding the match}];
set Palette(SubPreMatch,re)     [list {\\` F}];
set Palette(SubPreMatch,link)     [list InsertPreMatch]

set Palette(SubPreMatchDol,gloss)     [_ {Insert the portion preceding the match}];
set Palette(SubPreMatchDol,re)     [list {$\` F}];
set Palette(SubPreMatchDol,link)  [list InsertPreMatch]

set Palette(SubPreMatchLit,gloss)     [_ {Insert the portion preceding the match}];
set Palette(SubPreMatchLit,re)     [list {'pre F}];
set Palette(SubPreMatchLit,link)  [list InsertPreMatch]

set Palette(SubPostMatch,gloss)    [_ {Insert the portion following the match}];
set Palette(SubPostMatch,re)    [list {\' F}];
set Palette(SubPostMatch,link)    [list InsertPostMatch]

set Palette(SubPostMatchDol,gloss)    [_ {Insert the portion following the match}];
set Palette(SubPostMatchDol,re)    [list {$\' F}];
set Palette(SubPostMatchDol,link)  [list InsertPostMatch]

set Palette(SubPostMatchLit,gloss)    [_ {Insert the portion following the match}];
set Palette(SubPostMatchLit,re)    [list {'post F}];
set Palette(SubPostMatchLit,link)  [list InsertPostMatch]

set Palette(SubLastCapture,gloss)  [_ {Insert the last captured group}];
set Palette(SubLastCapture,re)  [list {\\+ F}];
set Palette(SubLastCapture,link)  [list InsertLastGroup]

set Palette(SubLastCaptureDol,gloss)  [_ {Insert the last captured group}];
set Palette(SubLastCaptureDol,re)  [list {$+ F}];
set Palette(SubLastCaptureDol,link)  [list InsertLastGroup]

set Palette(SubAlnum,gloss)      [_ {the alphanumeric characters (only in source)}];
set Palette(SubAlnum,re)      [list {[:alnum:]}];
set Palette(SubAlnum,link)    [list AlphaNumWord]

set Palette(SubAlpha,gloss)      [_ {the alphabetic characters (only in source)}];
set Palette(SubAlpha,re)      [list {[:alpha:]}];
set Palette(SubAlpha,link)      [list Alpha]

set Palette(SubBlank,gloss)      [_ {space or tab (only in source)}];
set Palette(SubBlank,re)      [list {[:blank:]}];
set Palette(SubBlank,link)      [list Blank]

set Palette(SubCntrl,gloss)      [_ {the control characters (only in source)}];
set Palette(SubCntrl,re)      [list {[:cntrl:]}];
set Palette(SubCntrl,link)    [list ControlCharacter]

set Palette(SubDigit,gloss)      [_ {the decimal digits (only in source)}];
set Palette(SubDigit,re)      [list {[:digit:]}];
set Palette(SubDigit,link)      [list Digit]

set Palette(SubGraph,gloss)      [_ {the `visible' characters (only in source)}];
set Palette(SubGraph,re)      [list {[:graph:]}]; 
set Palette(SubGraph,link)      [list Visible]

set Palette(SubLower,gloss)      [_ {the lower-case letters}];
set Palette(SubLower,re)      [list {[:lower:] F}];
set Palette(SubLower,link)      [list LowerCaseASCIILetter MustPair]

set Palette(SubPrint,gloss)      [_ {the `visible' characters (only in source)}];
set Palette(SubPrint,re)      [list {[:print:] F}];
set Palette(SubPrint,link)      [list Visible]

set Palette(SubPunct,gloss)      [_ {the punctuation symbols (only in source)}];
set Palette(SubPunct,re)      [list {[:punct:] F}];
set Palette(SubPunct,link)      [list ASCIIPunctuation]

set Palette(SubSpace,gloss)      [_ {the space characters (only in source)}];
set Palette(SubSpace,re)      [list {[:space:] F}];
set Palette(SubSpace,link)      [list Whitespace]

set Palette(SubUpper,gloss)      [_ {The upper-case letters}];
set Palette(SubUpper,re)      [list {[:upper:] F}];
set Palette(SubUpper,link)      [list UpperCaseASCIILetter MustPair]

set Palette(SubXdigit,gloss)     [_ {The hexadecimal digits (only in source)}];
set Palette(SubXdigit,re)     [list {[:xdigit:] F}];
set Palette(SubXdigit,link)     [list HexDigit];

set Palette(SubRange,gloss)     [_ {The letters from a through d}];
set Palette(SubRange,re)     [list {a V} {- F} {d V}];
set Palette(SubRange,link)     [list Range]

set Palette(SubCStarN,gloss)  [_ {N copies of character C (substitution only)}];
set Palette(SubCStarN,re)  [list {[ F} {C V} {* F} {N V} {] F}];
set Palette(SubCStarN,link)  [list TRStarN]

set Palette(SubCStar,gloss)   [_ {As many copies of character C as necessary (substitution only)}];
set Palette(SubCStar,re)   [list {[ F} {C V} {*] F}];
set Palette(SubCStar,link)  [list TRStar]

set Palette(SubLitString,gloss) [_ {Insert literal string}]
set Palette(SubLitString,re)   [list  {\" F} {xyz V} {\" F}]
set Palette(SubLitString,link)   [list  InsertLiteralString]

set Palette(ExactMatchWD,gloss) [_ {Require exact match of enclosed group}]
set Palette(ExactMatchWD,re)   [list {< F} {abcd V} {> F}]
set Palette(ExactMatchWD,link) [list ExactMatch]

set Palette(ExactMatchTRE,gloss) [_ {Require exact match of preceding group}]
set Palette(ExactMatchTRE,re)   [list {\{~0\} F}]
set Palette(ExactMatchTRE,link) [list ExactMatch]

set Palette(ExactMatchCgrep,gloss) [_ {Require exact match of enclosed material}]
set Palette(ExactMatchCgrep,re)   [list {< F} {abc V} {> F}]
set Palette(ExactMatchCgrep,link) [list ExactMatch]

set Palette(TRECostSetting,gloss) [_ "Set error costs for preceding group"];
set Palette(TRECostSetting,re)    [list {\{ F} {+ F} {w V} {- F} {x V} {\# F} {y V} {~ F} {z V} {{ , } F} {a V} {i F} {+ F} {b V} {d F} {+ F} {c V} {s F} {{ < } F} {k V} {\} F}]
set Palette(TRECostSetting,link) [list TRECostSetting]

set Palette(ReluctantStar,gloss) [_ "Match zero or more of preceding group (reluctant)"]
set Palette(ReluctantStar,re) [list {* F}]

set Palette(GreedyDoubleStar,gloss) [_ "Match zero or more of preceding group (greedy)"]
set Palette(GreedyDoubleStar,re) [list {** F}]

set Palette(CollationClass,gloss) [_ "The collation class of the specified character."]
set Palette(CollationClass,re)    [list {[[= F} {x V} {=]] F} ];
set Palette(CollationClass,link) [list CollationClass]

set Palette(CollatingElementMultichar,gloss) [_ "A POSIX multicharacter collating element"]
set Palette(CollatingElementMultichar,re)    [list {[[. F} {xy V} {.]] F} ];
set Palette(CollatingElementMultichar,link)  [list CollatingElementMultichar]

set Palette(CollatingElementNamed,gloss) [_ "A POSIX named collating element"]
set Palette(CollatingElementNamed,re)    [list {[[. F} {name V} {.]] F} ];
set Palette(CollatingElementNamed,link)  [list CollatingElementNamed]

#set Palette(flagm)      [_ {compiler flag m:                                    (?m)}];
#set Palette(flags)      [_ {compiler flag s:                                    (?s)}];

set ProgList [list agrep awk bash cgrep ed egrep emacs euphoria fgrep fish frink gawk glark grep guile icon java javascript jgrep judoscript ksh lua mawk nawk nrgrep perl php pike python rc rebol ruby sed sleep sleepwc tcl tclglob tcsh tr];

#Initialize the count of palette entries for each program to zero.
foreach i $ProgList {
    set UserPalette($i,0) 0;
}

set ExecCmd(agrep,match) ExecuteMatchAgrep;
set ExecCmd(agrep,match,ExactMatchTRE) "-1";#   Flag needed for palette test.
set ExecCmd(agrep,match,ExactMatchWD) "-1";#   Flag needed for palette test.
set ExecCmd(awk,match) ExecuteMatchAwk;
set ExecCmd(awk,sub) ExecuteSubAwk;
set ExecCmd(bash,match) ExecuteMatchBash;
set ExecCmd(cgrep,match) ExecuteMatchCgrep;
set ExecCmd(cgrep,match,ExactMatchCgrep) [list "-A" "1"];#   Flags needed for palette test.
set ExecCmd(ed,match)  ExecuteMatchEd;
set ExecCmd(ed,sub)  ExecuteSubEd;
set ExecCmd(egrep,match) ExecuteMatchEgrep;
set ExecCmd(emacs,match) ExecuteMatchEmacs;
set ExecCmd(emacs,sub) ExecuteSubEmacs;
set ExecCmd(euphoria,match) ExecuteMatchEuphoria;
set ExecCmd(fgrep,match) ExecuteMatchFgrep;
set ExecCmd(fish,match) ExecuteMatchFish;
set ExecCmd(frink,match) ExecuteMatchFrink;
set ExecCmd(frink,sub) ExecuteSubFrink;
set ExecCmd(gawk,match) ExecuteMatchGawk;
set ExecCmd(gawk,sub) ExecuteSubGawk;
set ExecCmd(glark,match) ExecuteMatchGlark;
set ExecCmd(grep,match) ExecuteMatchGrep;
set ExecCmd(guile,match) ExecuteMatchGuile;
set ExecCmd(guile,sub) ExecuteSubGuile;
set ExecCmd(icon,match) ExecuteMatchIcon;
set ExecCmd(java,match) ExecuteMatchJava;
set ExecCmd(java,sub) ExecuteSubJava;
set ExecCmd(javascript,match) ExecuteMatchJavascript;
set ExecCmd(javascript,sub) ExecuteSubJavascript;
set ExecCmd(jgrep,match) ExecuteMatchJgrep;
set ExecCmd(judoscript,match) ExecuteMatchJudoscript;
set ExecCmd(judoscript,sub) ExecuteSubJudoscript;
set ExecCmd(ksh,match) ExecuteMatchKsh;
set ExecCmd(lua,match) ExecuteMatchLua;
set ExecCmd(lua,sub) ExecuteSubLua;
set ExecCmd(mawk,match) ExecuteMatchMawk;
set ExecCmd(mawk,sub) ExecuteSubMawk;
set ExecCmd(nawk,match) ExecuteMatchNawk;
set ExecCmd(nawk,sub) ExecuteSubNawk;
set ExecCmd(nrgrep,match) ExecuteMatchNrgrep;
set ExecCmd(perl,match) ExecuteMatchPerl;
set ExecCmd(perl,sub) ExecuteSubPerl;
set ExecCmd(php,match) ExecuteMatchPhp;
set ExecCmd(php,sub) ExecuteSubPhp;
set ExecCmd(pike,match) ExecuteMatchPike;
set ExecCmd(pike,sub) ExecuteSubPike;
set ExecCmd(python,match) ExecuteMatchPython;
set ExecCmd(python,sub) ExecuteSubPython
set ExecCmd(rc,match) ExecuteMatchRc;
set ExecCmd(rebol,match) ExecuteMatchRebol;
set ExecCmd(ruby,match) ExecuteMatchRuby;
set ExecCmd(ruby,sub) ExecuteSubRuby;
set ExecCmd(sed,match)  ExecuteMatchSed;
set ExecCmd(sed,sub)  ExecuteSubSed;
set ExecCmd(sleep,match)  ExecuteMatchSleep;
set ExecCmd(sleep,sub)  ExecuteSubSleep;
set ExecCmd(sleepwc,match)  ExecuteMatchSleepWildcard;
set ExecCmd(tcl,match) ExecuteMatchTcl;
set ExecCmd(tcl,sub) ExecuteSubTcl;
set ExecCmd(tclglob,match) ExecuteMatchTclGlob;
set ExecCmd(tcsh,match) ExecuteMatchTcsh;
set ExecCmd(tr,sub) ExecuteSubTr;

#This maps the language name onto the name of the interpreter/program
set ExecName(agrep) agrep;
set ExecName(awk) awk;
set ExecName(bash) bash;
set ExecName(cgrep) cgrep;
set ExecName(fgrep) fgrep;
set ExecName(ed)  ed;
set ExecName(grep) grep;
set ExecName(egrep) egrep;
set ExecName(emacs) emacs;
set ExecName(euphoria) exu;
set ExecName(fish) fish;
set ExecName(frink) java;
set ExecName(gawk) gawk;
set ExecName(glark) glark;
set ExecName(guile) guile;
set ExecName(icon) icon;
set ExecName(java) javac;
set ExecName(javascript) js;
set ExecName(jgrep) jgrep;
set ExecName(judoscript) java;
set ExecName(ksh) ksh;
set ExecName(lua) lua;
set ExecName(mawk) mawk;
set ExecName(nawk) nawk;
set ExecName(nrgrep) nrgrep;
set ExecName(perl) perl;
set ExecName(php) php;
set ExecName(pike) pike;
set ExecName(python)  python;
set ExecName(rc) rc;
set ExecName(rebol) rebol;
set ExecName(ruby) ruby;
set ExecName(sed)  sed;
set ExecName(sleep) java;
set ExecName(sleepwc) java;
set ExecName(tcl) tcl;
set ExecName(tclglob) tcl;
set ExecName(tcsh) tcsh;
set ExecName(tr) tr;

#Experimental
#Test for glark boolean and
set TestData(BooleanAnd)   	"abc\nM\nN\nMN\nMbcN\nNbcM"
set Intended(BooleanAnd)	"MN\nMbcN\nNbcM"
set TestRegexp(BooleanAnd) 	"-a 0 M N"

#Test for Unicode collating classes: e, e-grave, e-acute, f, o-grave
set TestData(CollationClass)    "\u0065\n\u00E8\n\u00E9\n\u0066\n\u00F2";
set Intended(CollationClass)    "\u0065\n\u00E8\n\u00E9";
set TestRegexp(CollationClass) {[[=e=]]}

#Test for multicharacter collating element
#This presupposes that ch is a collating element in the current locale.
set TestData(CollatingElementMultichar)    "a\nb\nc\nch\nd\ne\nbh";
set Intended(CollatingElementMultichar)    "a\nch\ne"
set TestRegexp(CollatingElementMultichar) {[a[.ch.]e]}

set TestData(CollatingElementNamed)    ",\na\nb\nc\nch\nd\ne\nbh";
set Intended(CollatingElementNamed)    ","
set TestRegexp(CollatingElementNamed) {[[.comma.]]}

#Definitions of feature tests.

set TestData(embedding)         "bcd\nabcde";
set Intended(embedding)         "bcd\nabcde";
set TestRegexp(embedding)       {bcd};

set TestData(embeddingLeft)     "bcd\nabcd\nbcde";
set Intended(embeddingLeft)     "bcd\nabcd";
set TestRegexp(embeddingLeft)   {bcd};

set TestData(embeddingRight)    "bcd\nbcde\nabcd";
set Intended(embeddingRight)    "bcd\nbcde";
set TestRegexp(embeddingRight)  {bcd};

#Group.
set TestData(group)        "abcabc\nabc\nab";
set Intended(group)        "abcabc\nabc";
set TestRegexp(group)      {(abc)+};

set TestData(groupbs)      "abcabc\nabc\nab";
set Intended(groupbs)      "abcabc\nabc";
set TestRegexp(groupbs)    {\(abc\)\+};

set TestData(groupdbs)     "abcabc\nabc\nab";
set Intended(groupdbs)     "abcabc\nabc";
set TestRegexp(groupdbs)   {\\(abc\\)\\+};

#No capture group.
set TestData(ncgroup) "abcfgfg\nabcfgabc";
set Intended(ncgroup) "abcfgfg";
set TestRegexp(ncgroup)   {^(?:abc)(fg)\1$};

set TestData(ncgroupdb) "abcfgfg\nabcfgabc";
set Intended(ncgroupdb) "abcfgfg";
set TestRegexp(ncgroupdb)   {^(?:abc)(fg)\\1$};

set TestData(groupcomp) "a\nb\nc\nab\nbc\naa15d\nabc"
set Intended(groupcomp) "a\nb\nc\nab\nbc\naa15d"
set TestRegexp(groupcomp) {!(abc)}

#Maybe need to add ncgroup with single and double backslash on parentheses?

set TestData(dot) "a\nab\naxb\na4b\naxyb";
set Intended(dot) "axb\na4b";
set TestRegexp(dot)   {a.b};

set TestData(caret) "babc\nc^c\ndbab";
set Intended(caret) "babc";
set TestRegexp(caret)   {^bab.*};

set TestData(pabegin) "babc\nc^c\ndbab";
set Intended(pabegin) "babc";
set TestRegexp(pabegin)   {\Abab.*};

set TestData(pabegindb) "babc\nc^c\ndbab";
set Intended(pabegindb) "babc";
set TestRegexp(pabegindb)   {\\Abab.*};

set TestData(caretw) "babc\nc^c\ndbab";
set Intended(caretw) "babc";
set TestRegexp(caretw)   {^bab};

set TestData(boslq) "babc\nc^c\ndbab";
set Intended(boslq) "babc";
set TestRegexp(boslq)   {\`bab.*};

set TestData(dollar) "cbab\nc\$c\nbabd";
set Intended(dollar) "cbab";
set TestRegexp(dollar)   {.*bab$};

set TestData(LiteralMetachar) "a\na\$b\nab";
set Intended(LiteralMetachar) {a$b};
set TestRegexp(LiteralMetachar) {a\$b};

set TestData(eosrq) "cbab\nc\$c\nbabd";
set Intended(eosrq) "cbab";
set TestRegexp(eosrq)   {.*bab\'};

set TestData(AbsoluteEndOfString)   "a\nab"
set Intended(AbsoluteEndOfString)   "a"
set TestRegexp(AbsoluteEndOfString) "a\n$"

set TestData(pzendbs) "cbab\nc\$c\nbabd";
set Intended(pzendbs) "cbab";
set TestRegexp(pzendbs)   {.*bab\z};

set TestData(pZendbs) "cbab\nc\$c\nbabd";
set Intended(pZendbs) "cbab";
set TestRegexp(pZendbs)   {.*bab\Z};

set TestData(pzenddbs) "cbab\nc\$c\nbabd";
set Intended(pzenddbs) "cbab";
set TestRegexp(pzenddbs)   {.*bab\\z};

set TestData(pZenddbs) "cbab\nc\$c\nbabd";
set Intended(pZenddbs) "cbab";
set TestRegexp(pZenddbs)   {.*bab\\Z};

set TestData(dollarw) "cbab\nc\$c\nbabd";
set Intended(dollarw) "cbab";
set TestRegexp(dollarw)   {bab$};

set TestData(langle)  "abc\na abc\na\tabc\naxabc";
set Intended(langle)  "abc\na abc\na\tabc";
set TestRegexp(langle)    {\<abc};

set TestData(rangle)  "abc\nabc d\nabc\td\nabcxd";
set Intended(rangle)  "abc\nabc d\nabc\td";
set TestRegexp(rangle)    {abc\>};

set TestData(WordBoundary) "ab\n ab \n\tab\t\n;ab;\n3ab\nab_\nxab\nabx\nxabx"
set Intended(WordBoundary) "ab\n ab \n\tab\t\n;ab;"
set TestRegexp(WordBoundary) {\bab\b}

set TestData(WordBoundaryBs) "ab\n ab \n\tab\t\n;ab;\n3ab\nab_\nxab\nabx\nxabx"
set Intended(WordBoundaryBs) "ab\n ab \n\tab\t\n;ab;"
set TestRegexp(WordBoundaryBs) {\\bab\\b}

set TestData(WordBoundaryY) "ab\n ab \n\tab\t\n;ab;\n3ab\nab_\nxab\nabx\nxabx"
set Intended(WordBoundaryY) "ab\n ab \n\tab\t\n;ab;"
set TestRegexp(WordBoundaryY) {\yab\y}

set TestData(WordBoundaryYBs) "ab\n ab \n\tab\t\n;ab;\n3ab\nab_\nxab\nabx\nxabx"
set Intended(WordBoundaryYBs) "ab\n ab \n\tab\t\n;ab;"
set TestRegexp(WordBoundaryYBs) {\\yab\\y}

set TestData(NonWordBoundary) "ab\n ab \n\tab\t\n;ab;\n3ab4\n_ab_\nxabx"
set Intended(NonWordBoundary) "3ab4\n_ab_\nxabx"
set TestRegexp(NonWordBoundary) {\Bab\B}

set TestData(NonWordBoundaryBs) "ab\n ab \n\tab\t\n;ab;\n3ab4\n_ab_\nxabx"
set Intended(NonWordBoundaryBs) "3ab4\n_ab_\nxabx"
set TestRegexp(NonWordBoundaryBs) {\\Bab\\B}

#Disjunctions

set TestData(pipe)  "xaz\nxbz\nxcz\nxz\xooz";
set Intended(pipe)  "xaz\nxbz";
set TestRegexp(pipe)    {x(a|b)z};

set TestData(pipebs)  "xaz\nxbz\nxcz\nxz\nxooz";
set Intended(pipebs)  "xaz\nxbz";
set TestRegexp(pipebs)   {x(a\|b)z};

set TestData(pipedbs)  "xaz\nxbz\nxcz\nxz\nxooz";
set Intended(pipedbs)  "xaz\nxbz";
set TestRegexp(pipedbs)   {x(a\\|b)z};

set TestData(pipedbsall)     "xaz\nxbz\nxcz\nxz\nxooz";
set Intended(pipedbsall)     "xaz\nxbz";
set TestRegexp(pipedbsall)   {x\\(a\\|b\\)z};

set TestData(piperebol)    "xaz\nxbz\nxcz\nxz\xooz";
set Intended(piperebol)    "xaz\nxbz";
set TestRegexp(piperebol)  {"x"["a"|"b"]"z"};

set TestData(altcomma)  "xaz\nxbz\nxcz\nxdz";
set Intended(altcomma)  "xaz\nxbz\nxcz";
set TestRegexp(altcomma)    {x{a,b,c}z}

#Test for the case in which ? matches zero or one of the preceding regexp.
set TestData(qmopt) "ababcd\nabcd\nabab?cd";
set Intended(qmopt) "ababcd\nabcd";
set TestRegexp(qmopt)   {ab(ab)?cd};

set TestData(qmoptclass) "a\na3\nab\na;";
set Intended(qmoptclass) "a\na3";
set TestRegexp(qmoptclass)   {a%d?$};

#Test for the case in which ? matches zero or one of the preceding regexp.
set TestData(qmoptbs) "ababcd\nabcd\nabab?cd";
set Intended(qmoptbs) "ababcd\nabcd";
set TestRegexp(qmoptbs)   {ab\(ab\)\?cd};

#Test for the case in which ? matches zero or one of the following group
set TestData(qmoptnext) "ababcd\nabcd\nabab?cd";
set Intended(qmoptnext) "ababcd\nabcd";
set TestRegexp(qmoptnext)   {ab?(ab)cd};

#Test for the case in which ? matches any single character.
set TestData(qm1) "fag\nfabg\nfasg\nfabcg\nfdag";
set Intended(qm1) "fabg\nfasg";
set TestRegexp(qm1)   {fa?g};

#Test for the case in which ? matches any single character.
set TestData(qm1bs) "fag\nfabg\nfasg\nfabcg\nfdag";
set Intended(qm1bs) "fabg\nfasg";
set TestRegexp(qm1bs)   {fa\?g};

#Test for the case in which * matches zero or more copies of the preceding re
set TestData(starprev) "xz\nxbz\nxbbz\nxbbbz\nxaz\nxb*z";
set Intended(starprev) "xz\nxbz\nxbbz\nxbbbz"
set TestRegexp(starprev)   {xb*z};

#Test for the case in which * matches zero or more copies of the following group
set TestData(starnext) "xz\nxabz\nxababz\nx*(ab)z\nabz\nxab\nxaz\n3d"
set Intended(starnext) "xz\nxabz\nxababz"
set TestRegexp(starnext)   {x*(ab)z};

#Test for the case in which * matches zero or more copies of the preceding class
set TestData(starclass) "xz\nx1z\nx22z\nx867z\nxdz\nx%dz";
set Intended(starclass) "xz\nx1z\nx22z\nx867z"
set TestRegexp(starclass)   {x%d*z};

#Test for the case in which - matches zero or more copies of the preceding class (reluctant)
set TestData(SubHyphenClass)     "aBBBBa";
set Intended(SubHyphenClass)     "BBBB";
set TestRegexp(SubHyphenClass)   {(a)(%u-)(%u*)(a)};
set TestSubexp(SubHyphenClass)   {%3};

#Test for the case in which * matches zero or more of any character
set TestData(starany) "xaz\nxbz\nxabz\nxabbz\nxabbbz\nxabbbbz\nxabbbbbz\nxabcz\nxabdz";
set Intended(starany)           "xabz\nxabbz\nxabbbz\nxabbbbz\nxabbbbbz\nxabcz\nxabdz";
set TestRegexp(starany)   {xab*z};

#Test for the case in which + matches one or more copies of the preceding re
set TestData(plusprev) "xz\nxbz\nxbbz\nxbbbz\nxaz\nxb*z";
set Intended(plusprev) "xbz\nxbbz\nxbbbz"
set TestRegexp(plusprev) {xb+z};

#Test for the case in which + matches one or more copies of the following group
set TestData(plusnext) "xz\nxabz\nxababz\nx*(ab)z\nabz\nxab\nxaz\n3d"
set Intended(plusnext) "xabz\nxababz"
set TestRegexp(plusnext)   {x+(ab)z};

#Test for the case in which + matches one or more copies of the following group
set TestData(atsignonenext) "xabz\nxcdz\nxz\nxabcdz\nef"
set Intended(atsignonenext) "xabz\nxcdz"
set TestRegexp(atsignonenext)   {x@(ab|cd)z};

#Test for the case in which \+ matches one or more copies of the preceding re
set TestData(plusprevbs) "xz\nxbz\nxbbz\nxbbbz\nxaz\nxb+z";
set Intended(plusprevbs) "xbz\nxbbz\nxbbbz"
set TestRegexp(plusprevbs) {xb\+z};

#Test for the case in which + matches one or more copies of the preceding class
set TestData(plusclass) "xz\nx1z\nx22z\nx867z\nxdz\nx%dz";
set Intended(plusclass) "x1z\nx22z\nx867z"
set TestRegexp(plusclass)  {x%d+z}; 

#Test for the case in which \+ matches one or more copies of any character
set TestData(plusany) "xaz\nxabz\nxabbz\nxabbbz\nxabbbbz\nxabbbbbz\nxabcz\nxbz\nxabdz";
set Intended(plusany) "xabz\nxabbz\nxabbbz\nxabbbbz\nxabbbbbz\nxabcz\nxabdz";
set TestRegexp(plusany) {xab\+z};

#Test for the case in which crosshatch matches one or more copies of any character
set TestData(crosshatchany) "xaz\nxabz\nxabbz\nxabbbz\nxabbbbz\nxabbbbbz\nxabcz\nxbz\nxabdz";
set Intended(crosshatchany) "xabz\nxabbz\nxabbbz\nxabbbbz\nxabbbbbz\nxabcz\nxabdz";
set TestRegexp(crosshatchany) {xab#z};

#Test for construction in which exactly n copies of preceding group are matched.
set TestData(repfixed) "xbz\nxbbz\nxbbbz\nxbbbbz\nxb3z";
set Intended(repfixed) "xbbbz";
set TestRegexp(repfixed)   {xb{3}z};

#Test for Lua balanced delimiter construct
set TestData(baldlim) "ab<cd>ef\nabcdef";
set Intended(baldlim) "ab<cd>ef";
set TestRegexp(baldlim)   {%b<>};

#Test for construction in which exactly n copies of preceding group are matched.
set TestData(repfixedbs) "xbz\nxbbz\nxbbbz\nxbbbbz";
set Intended(repfixedbs) "xbbbz";
set TestRegexp(repfixedbs)   {xb\{3\}z};

#Test for construction in which at least n copies of preceding group are matched.
set TestData(repmin) "xbz\nxbbz\nxbbbz\nxbbbbz";
set Intended(repmin) "xbbbz\nxbbbbz";
set TestRegexp(repmin)   {xb{3,}z};

#Test for construction in which at least n copies of preceding group are matched.
set TestData(repminbs) "xbz\nxbbz\nxbbbz\nxbbbbz";
set Intended(repminbs) "xbbbz\nxbbbbz";
set TestRegexp(repminbs)   {xb\{3,\}z};

#Test for construction in which from m to n copies of preceding group are matched.
set TestData(reprange) "xbz\nxbbz\nxbbbz\nxbaz\nxaaaz";
set Intended(reprange) "xbbz\nxbbbz";
set TestRegexp(reprange)  {xb{2,3}z};

#Test for construction in which from m to n copies of preceding group are matched.
#Here, curly brackets must be escaped.
set TestData(reprangebs) "xbz\nxbbz\nxbbbz\nxbaz\nxaaaz";
set Intended(reprangebs) "xbbz\nxbbbz";
set TestRegexp(reprangebs)  {xb\{2,3\}z};

#Test for construction in which from m to n copies of preceding group are matched.
#Here, curly brackets must be escaped by double backslashes..
set TestData(reprangedbs) "xbz\nxbbz\nxbbbz\nxbaz\nxaaaz";
set Intended(reprangedbs) "xbbz\nxbbbz";
set TestRegexp(reprangedbs)  {xb\\{2,3\\}z};

#Test whether bracket notation for sets is supported
set TestData(set) "x\ny\nz\na\nf\n4";
set Intended(set) "x\ny\nz";
set TestRegexp(set)   {[xyz]};

#Test whether caret-bracket notation for the complement of sets is supported
set TestData(setcomp) "x\ny\nz\na\nf\n4";
set Intended(setcomp) "a\nf\n4";
set TestRegexp(setcomp)   {[^xyz]};

#Test whether tilde-bracket notation for the complement of sets is supported
set TestData(setcomptilde) "x\ny\nz\na\nf\n4";
set Intended(setcomptilde) "a\nf\n4";
set TestRegexp(setcomptilde)   {[~xyz]};

#Test whether bang-bracket notation for the complement of sets is supported
set TestData(setcompbang) "x\ny\nz\na\nf\n4";
set Intended(setcompbang) "a\nf\n4";
set TestRegexp(setcompbang)   {[!xyz]};

#Test whether character ranges are supported
set TestData(range) "x\ny\nz\na\nf\n4";
set Intended(range) "x\ny\nz";
set TestRegexp(range)   {[x-z]};

#Test whether multiple character ranges are supported
set TestData(multirange) "x\ny\nz\na\nb\nc\ns\nf\n4";
set Intended(multirange) "x\ny\nz\na\nb\nc\ns";
set TestRegexp(multirange)   {[a-csx-z]};

#Test whether match back references are supported
set TestData(backref) "abcdedebc\nabcdeedcba";
set Intended(backref) "abcdedebc";
set TestRegexp(backref)   {a(bc)(de)\2\1};

set TestData(backrefAtLeastTen) "abcdefghijklj\nabcdefghijkl";
set Intended(backrefAtLeastTen) "abcdefghijklj";
set TestRegexp(backrefAtLeastTen) {(a)(b)(c)(d)(e)(f)(g)(h)(i)(j)(k)(l)\10}

set TestData(backrefdbs) "abcdedebc\nabcdeedcba";
set Intended(backrefdbs) "abcdedebc";
set TestRegexp(backrefdbs)   {a(bc)(de)\\2\\1};

set TestData(backrefdbsAtLeastTen) "abcdefghijklj\nabcdefghijkl";
set Intended(backrefdbsAtLeastTen) "abcdefghijklj";
set TestRegexp(backrefdbsAtLeastTen) {(a)(b)(c)(d)(e)(f)(g)(h)(i)(j)(k)(l)\\10}

set TestData(backrefksh) "abcdedebc\nabcdeedcba";
set Intended(backrefksh) "abcdedebc";
set TestRegexp(backrefksh)   {a@(bc|pq)@(de|sr)\2\1};

set TestData(backrefkshAtLeastTen) "abcdefghijklj\nabcdefghijkl";
set Intended(backrefkshAtLeastTen) "abcdefghijklj";
set TestRegexp(backrefkshAtLeastTen) {@(a|z)@(b|y)@(c|x)@(d|w)@(e|v)@(f|u)@(g|t)@(h|s)@(i|r)@(j|q)@(k|p)@(l|o)\10}

set TestData(backrefper) "abcdedebc\nabcdeedcba";
set Intended(backrefper) "abcdedebc";
set TestRegexp(backrefper)   {a(bc)(de)%2%1};

set TestData(backrefperAtLeastTen) "abcdefghijklj\nabcdefghijkl";
set Intended(backrefperAtLeastTen) "abcdefghijklj";
set TestRegexp(backrefperAtLeastTen) {(a)(b)(c)(d)(e)(f)(g)(h)(i)(j)(k)(l)%10}

set TestData(backrefbsall)       "abcdedebc\nabcdeedcba";
set Intended(backrefbsall)       "abcdedebc";
set TestRegexp(backrefbsall)     {a\(bc\)\(de\)\2\1};

set TestData(backrefbsallAtLeastTen) "abcdefghijklj\nabcdefghijkl";
set Intended(backrefbsallAtLeastTen) "abcdefghijklj";
set TestRegexp(backrefbsallAtLeastTen) {\(a\)\(b\)\(c\)\(d\)\(e\)\(f\)\(g\)\(h\)\(i\)\(j\)\(k\)\(l\)\10}

set TestData(backrefdbsall)       "abcdedebc\nabcdeedcba";
set Intended(backrefdbsall)       "abcdedebc";
set TestRegexp(backrefdbsall)     {a\\(bc\\)\\(de\\)\\2\\1};

set TestData(backrefdbsallAtLeastTen) "abcdefghijklj\nabcdefghijkl";
set Intended(backrefdbsallAtLeastTen) "abcdefghijklj";
set TestRegexp(backrefdbsallAtLeastTen) {\\(a\\)\\(b\\)\\(c\\)\\(d\\)\\(e\\)\\(f\\)\\(g\\)\\(h\\)\\(i\\)\\(j\\)\\(k\\)\\(l\\)\\10}

set TestData(commaor)      "dog\ncat\ndogcat\ndogncat\ncatndog\ndigncat\ndeogbcant\ndig";
set Intended(commaor)      "dog\ncat\ndogcat\ndogncat\ncatndog\ndigncat";
set TestRegexp(commaor)     {dog,cat};

set TestData(semiand)      "dog\ncat\ndogcat\ndogncat\ncatndog\ndig\ndigncat\ndeogbcant"
set Intended(semiand)      "dogcat\ndogncat\ncatndog";
set TestRegexp(semiand)     {dog;cat};

#This is for agrep and requires using the command line flag allowing errors.
set TestData(anglestrict)      "abc\naxc\nbbc\nabd";
set Intended(anglestrict)      "abc";
set TestRegexp(anglestrict)   {<abc>};


#Test the various named character sets
		    
set TestData(alnum) "a\nB\nc\nZ\n+\n4\n:\n?\n_";
set Intended(alnum) "a\nB\nc\nZ\n4";
set TestRegexp(alnum)   {[[:alnum:]]};

set TestData(alnumrebol) "a\nB\nc\nZ\n+\n4\n:\n?\n_";
set Intended(alnumrebol) "a\nB\nc\nZ\n4";
set TestRegexp(alnumrebol)   {[alnum]};

set TestData(lalnum) "a\nB\nc\nZ\n+\n4\n:\n?\n_";
set Intended(lalnum) "a\nB\nc\nZ\n4";
set TestRegexp(lalnum)   {%w};

set TestData(lalnumc) "aac\naBc\nacc\naZc\na+c\na4c\na:c\na?c\na\040c\na_c";
set Intended(lalnumc) "a+c\na:c\na?c\na\040c\na_c";
set TestRegexp(lalnumc)   {a%Wc};

set TestData(bsw)   "abc\n4bc\n:bc\n bc\n\tbc\n_bc";
set Intended(bsw)   "abc\n4bc";
set TestRegexp(bsw)     {^\wbc};

set TestData(pbsw)   "abc\n4bc\n:bc\n bc\n\tbc\n_bc";
set Intended(pbsw)   "abc\n4bc\n_bc";
set TestRegexp(pbsw)     {^\wbc};

set TestData(pbbsw)   "abc\n4bc\n:bc\n bc\n\tbc\n_bc";
set Intended(pbbsw)   "abc\n4bc\n_bc";
set TestRegexp(pbbsw)     {^\\wbc};


set TestData(bsW)   "abc\n4bc\n:bc\n bc\n\tbc\n_bc";
set Intended(bsW)   ":bc\n bc\n\tbc\n_bc";
set TestRegexp(bsW)   {^\Wbc};

set TestData(bsWdb)   "abc\n4bc\n:bc\n bc\n\tbc\n_bc";
set Intended(bsWdb)   ":bc\n bc\n\tbc\n_bc";
set TestRegexp(bsWdb)   {^\\Wbc};

set TestData(pbsW)   "abc\n4bc\n:bc\n bc\n\tbc\n_bc";
set Intended(pbsW)   ":bc\n bc\n\tbc";
set TestRegexp(pbsW)  {^\Wbc};

set TestData(alpha) "a\nB\nc\nZ\n+\n4\n:\n?";
set Intended(alpha) "a\nB\nc\nZ";
set TestRegexp(alpha)   {[[:alpha:]]};

set TestData(alpharebol) "a\nB\nc\nZ\n+\n4\n:\n?";
set Intended(alpharebol) "a\nB\nc\nZ";
set TestRegexp(alpharebol)   {alpha};

set TestData(lalpha) "a\nB\nc\nZ\n+\n4\n:\n?";
set Intended(lalpha) "a\nB\nc\nZ";
set TestRegexp(lalpha)   {%a};

set TestData(lalphac) "a\nB\nc\nZ\n+\n4\n:\n?";
set Intended(lalphac) "+\n4\n:\n?";
set TestRegexp(lalphac)   {%A};

set TestData(lower) "AaZ\nABZ\nAcZ\nAZZ\nA+Z\nA4Z\nA:Z\nA?Z";
set Intended(lower) "AaZ\nAcZ";
set TestRegexp(lower)   {A[[:lower:]]Z};

set TestData(lowerrebol) "AaZ\nABZ\nAcZ\nAZZ\nA+Z\nA4Z\nA:Z\nA?Z";
set Intended(lowerrebol) "AaZ\nAcZ";
set TestRegexp(lowerrebol)   {#"A"[lower]#"Z"};

set TestData(llower) "AaZ\nABZ\nAcZ\nAZZ\nA+Z\nA4Z\nA:Z\nA?Z";
set Intended(llower) "AaZ\nAcZ";
set TestRegexp(llower)   {A%lZ};

set TestData(llowerc) "AAZ\nA:Z\nA2Z\nAaB\nAbZ";
set Intended(llowerc) "AAZ\nA:Z\nA2Z";
set TestRegexp(llowerc)   {A%LZ};

set TestData(upper) "aaz\naBz\nacz\naZz\na+z\na4z\na:z\na?z";
set Intended(upper) "aBz\naZz";
set TestRegexp(upper)   {a[[:upper:]]z};

set TestData(upperrebol) "aaz\naBz\nacz\naZz\na+z\na4z\na:z\na?z";
set Intended(upperrebol) "aBz\naZz";
set TestRegexp(upperrebol)   {#"a"[upper]#"z"};

#Lua character classes
set TestData(lupper) "aaz\naBz\nacz\naZz\na+z\na4z\na:z\na?z";
set Intended(lupper) "aBz\naZz";
set TestRegexp(lupper)   {a%uz};

set TestData(lupperc) "aaz\naBz\nacz\naZz\na+z\na4z\na:z\na?z";
set Intended(lupperc) "aaz\nacz\na+z\na4z\na:z\na?z";
set TestRegexp(lupperc)   {a%Uz};

set TestData(punct) "aaz\naBz\nacz\naZz\na4z\na:z\na?z\na!z\na\#z\na\$z\na%z\na&z\na*z\na(z\na)z\na-z\na,z\na.z\na/z";
set Intended(punct) "a:z\na?z\na!z\na\#z\na\$z\na%z\na&z\na*z\na(z\na)z\na-z\na,z\na.z\na/z";
set TestRegexp(punct)   {a[[:punct:]]z};

set TestData(lpunct) "aaz\naBz\nacz\naZz\na4z\na:z\na?z\na!z\na\#z\na\$z\na%z\na&z\na*z\na(z\na)z\na-z\na,z\na.z\na/z";
set Intended(lpunct) "a:z\na?z\na!z\na\#z\na\$z\na%z\na&z\na*z\na(z\na)z\na-z\na,z\na.z\na/z";
set TestRegexp(lpunct)   {a%pz};

set TestData(lpunctc) "aaz\naBz\nacz\naZz\na4z\na:z\na?z\na!z\na\#z\na\$z\na%z\na&z\na*z\na(z\na)z\na-z\na,z\na.z\na/z\na\040z";
set Intended(lpunctc) "aaz\naBz\nacz\naZz\na4z\na\040z";
set TestRegexp(lpunctc)   {a%Pz};

set TestData(blank) "a\040b\na\011b\na\n4\n:";
set Intended(blank) "a\040b\na\011b";
set TestRegexp(blank)   {a[[:blank:]]b};

set TestData(space) "a\040b\na\014b\na\011b\na\013b\na4b\na:b\nacb";
set Intended(space) "a\040b\na\014b\na\011b\na\013b";
set TestRegexp(space)   {a[[:space:]]b};

set TestData(lspace) "a\040b\na\014b\na\011b\na\013b\na4b\na:b\nacb";
set Intended(lspace) "a\040b\na\014b\na\011b\na\013b";
set TestRegexp(lspace)   {a%sb};

set TestData(pspace) "a\040b\na\014b\na\011b\na\013b\na4b\na:b\nacb";
set Intended(pspace) "a\040b\na\014b\na\011b\na\013b";
set TestRegexp(pspace)   {a\sb};

set TestData(pspacedb) "a\040b\na\014b\na\011b\na\013b\na4b\na:b\nacb";
set Intended(pspacedb) "a\040b\na\014b\na\011b\na\013b";
set TestRegexp(pspacedb)   {a\\sb};

set TestData(lspacec) "a\040b\na\014b\na\011b\na\013b\na4b\na:b\nacb";
set Intended(lspacec) "a4b\na:b\nacb";
set TestRegexp(lspacec)   {a%Sb};

set TestData(pspacec) "a\040b\na\014b\na\011b\na\013b\na4b\na:b\nacb";
set Intended(pspacec) "a4b\na:b\nacb";
set TestRegexp(pspacec)   {a\Sb};

set TestData(pspacedbc) "a\040b\na\014b\na\011b\na\013b\na4b\na:b\nacb";
set Intended(pspacedbc) "a4b\na:b\nacb";
set TestRegexp(pspacedbc)   {a\\Sb};

set TestData(graph) "aab\naAb\na4b\na:b\na\040b\na\011b\na\023b";
set Intended(graph) "aab\naAb\na4b\na:b";
set TestRegexp(graph)   {a[[:graph:]]b};

set TestData(print) "aab\naAb\na4b\na:b\na\040b\na\011b\na\023b";
set Intended(print) "aab\naAb\na4b\na:b\na\040b";
set TestRegexp(print)   {a[[:print:]]b};

set TestData(cntrl) "aab\naAb\na4b\na:b\na\040b\na\011b\na\023b\na\177b";
set Intended(cntrl) "a\011b\na\023b\na\177b";
set TestRegexp(cntrl)   {a[[:cntrl:]]b};

set TestData(lcntrl) "aab\naAb\na4b\na:b\na\040b\na\011b\na\023b\na\177b";
set Intended(lcntrl) "a\011b\na\023b\na\177b";
set TestRegexp(lcntrl)   {a%cb};

set TestData(lcntrlc) "aab\naAb\na4b\na:b\na\040b\na\011b\na\023b\na\177b";
set Intended(lcntrlc) "aab\naAb\na4b\na:b\na\040b";
set TestRegexp(lcntrlc)   {a%Cb};

set TestData(digit) "A\n:\nB\nb\n1\n2\n3\n4\n5\n6\n7\n8\n9\n0\n?\n\023";
set Intended(digit) "1\n2\n3\n4\n5\n6\n7\n8\n9\n0";
set TestRegexp(digit)  {[[:digit:]]};

set TestData(compposixclassinner) "A\n:\nB\nb\n1\n2\n3\n4\n5\n6\n7\n8\n9\n0\n?\n\023";
set Intended(compposixclassinner) "A\n:\nB\nb\n?\n\023";
set TestRegexp(compposixclassinner)  {[[:^digit:]]};

set TestData(compposixclassouter) "A\n:\nB\nb\n1\n2\n3\n4\n5\n6\n7\n8\n9\n0\n?\n\023";
set Intended(compposixclassouter) "A\n:\nB\nb\n?\n\023";
set TestRegexp(compposixclassouter)  {[^[:digit:]]};

set TestData(digitrebol) "A\n:\nB\nb\n1\n2\n3\n4\n5\n6\n7\n8\n9\n0\n?\n\023";
set Intended(digitrebol) "1\n2\n3\n4\n5\n6\n7\n8\n9\n0";
set TestRegexp(digitrebol)  {[digit]};

set TestData(ldigit) "A\n:\nB\nb\n1\n2\n3\n4\n5\n6\n7\n8\n9\n0\n?\n\023";
set Intended(ldigit) "1\n2\n3\n4\n5\n6\n7\n8\n9\n0";
set TestRegexp(ldigit)  {%d};

set TestData(pdigit) "A\n:\nB\nb\n1\n2\n3\n4\n5\n6\n7\n8\n9\n0\n?\n\023";
set Intended(pdigit) "1\n2\n3\n4\n5\n6\n7\n8\n9\n0";
set TestRegexp(pdigit)  {\d};

set TestData(pdigitdb) "A\n:\nB\nb\n1\n2\n3\n4\n5\n6\n7\n8\n9\n0\n?\n\023";
set Intended(pdigitdb) "1\n2\n3\n4\n5\n6\n7\n8\n9\n0";
set TestRegexp(pdigitdb)  {\\d};

set TestData(ldigitc) "A\n:\nB\nb\n1\n2\n3\n4\n5\n6\n7\n8\n9\n0\n?\n\023";
set Intended(ldigitc) "A\n:\nB\nb\n?\n\023";
set TestRegexp(ldigitc)  {%D};

set TestData(pdigitc) "A\n:\nB\nb\n1\n2\n3\n4\n5\n6\n7\n8\n9\n0\n?\n\023";
set Intended(pdigitc) "A\n:\nB\nb\n?\n\023";
set TestRegexp(pdigitc)  {\D};

set TestData(pdigitdbc) "A\n:\nB\nb\n1\n2\n3\n4\n5\n6\n7\n8\n9\n0\n?\n\023";
set Intended(pdigitdbc) "A\n:\nB\nb\n?\n\023";
set TestRegexp(pdigitdbc)  {\\D};

set TestData(xdigit) "A\nB\nC\nD\nE\nF\na\nb\nc\nd\ne\nf\n1\n2\n3\n4\n5\n6\n7\n8\n9\n0\nj\nk\n;\n?";
set Intended(xdigit) "A\nB\nC\nD\nE\nF\na\nb\nc\nd\ne\nf\n1\n2\n3\n4\n5\n6\n7\n8\n9\n0";
set TestRegexp(xdigit) {[[:xdigit:]]};

set TestData(xdigitrebol) "A\nB\nC\nD\nE\nF\na\nb\nc\nd\ne\nf\n1\n2\n3\n4\n5\n6\n7\n8\n9\n0\nj\nk\n;\n?";
set Intended(xdigitrebol) "A\nB\nC\nD\nE\nF\na\nb\nc\nd\ne\nf\n1\n2\n3\n4\n5\n6\n7\n8\n9\n0";
set TestRegexp(xdigitrebol) { [xdigit]};

set TestData(lxdigit) "A\nB\nC\nD\nE\nF\na\nb\nc\nd\ne\nf\n1\n2\n3\n4\n5\n6\n7\n8\n9\n0\nj\nk\n;\n?";
set Intended(lxdigit) "A\nB\nC\nD\nE\nF\na\nb\nc\nd\ne\nf\n1\n2\n3\n4\n5\n6\n7\n8\n9\n0";
set TestRegexp(lxdigit) {%x};

set TestData(lxdigitc) "g\na\n:\nb\n1\n2\n3\n4\n5\n6\n7\n8\n9\n0\nk\n?\023";
set Intended(lxdigitc) "g\n:\nk\n?\023";
set TestRegexp(lxdigitc) {%X};

set TestData(octal) "m\na\n155";
set Intended(octal) "m";
set TestRegexp(octal) {\155};

set TestData(octaldb) "m\na\n155";
set Intended(octaldb) "m";
set TestRegexp(octaldb) {\\155};

set TestData(octalo) "m\na\no155";
set Intended(octalo) "m";
set TestRegexp(octalo) {\o155};

set TestData(decimald) "m\na\nd109";
set Intended(decimald) "m";
set TestRegexp(decimald) {\d109};

set TestData(hexl) "m\na\nx6e";
set Intended(hexl) "m";
set TestRegexp(hexl) {\x6d};

set TestData(hexldb) "m\na\nx6e";
set Intended(hexldb) "m";
set TestRegexp(hexldb) {\\x6d};

set TestData(hexu) "m\na\nx6E";
set Intended(hexu) "m";
set TestRegexp(hexu) {\x6D};

set TestData(hexudb) "m\na\nx6E";
set Intended(hexudb) "m";
set TestRegexp(hexudb) {\\x6D};

set TestData(tab) "m\na\n\t";
set Intended(tab) "\t";
set TestRegexp(tab) {\t};

set TestData(tabdb) "m\na\n\t";
set Intended(tabdb) "\t";
set TestRegexp(tabdb) {\\t};

set TestData(escape) "m\na\n\033";
set Intended(escape) "\033";
set TestRegexp(escape) {\e};

set TestData(escapedb) "m\na\n\033";
set Intended(escapedb) "\033";
set TestRegexp(escapedb) {\\e};

set TestData(bell) "m\na\n\007";
set Intended(bell) "\007";
set TestRegexp(bell) {\a};

set TestData(belldb) "m\na\n\007";
set Intended(belldb) "\007";
set TestRegexp(belldb) {\\a};

set TestData(backspace) "\u0008\nb\n\\b";
set Intended(backspace) "\u0008";
set TestRegexp(backspace) {\b};

set TestData(cr) "m\na\n\r";
set Intended(cr) "\r";
set TestRegexp(cr) {\r};

set TestData(crdb) "m\na\n\r";
set Intended(crdb) "\r";
set TestRegexp(crdb) {\\r};

set TestData(unicodebmp) "AaZ\nbac\nA\u4E09\u58EBZ\nA\u4E09Z\nA\u58EBZ\nA\u10024Z";
set Intended(unicodebmp) "AaZ\nA\u4E09Z\nA\u58EBZ";
set TestRegexp(unicodebmp) {A.Z};

set TestData(unicodefull) "AaZ\nbac\nA\u4E09\u58EBZ\nA\u4E09Z\nA\u58EBZ\nA\u10024Z";
set Intended(unicodefull) "AaZ\nA\u4E09Z\nA\u58EBZ\nA\u10024Z";
set TestRegexp(unicodefull) {A.Z};

set TestData(controlc) "m\na\n\007";
set Intended(controlc) "\007";
set TestRegexp(controlc) {\cG};

set TestData(controlcdb)   "m\na\n\007";
set Intended(controlcdb)   "\007";
set TestRegexp(controlcdb) {\\cG};

set TestData(some) "a\nab\naa\nb\nba\naba\nc\nabc\naab\naaab";
set Intended(some) "ab\naab\naaab";
set TestRegexp(some) {[some "a" "b"]};

set TestData(any)  "a\nab\naa\nb\nba\naba\nc\nabc\naab\naaab";
set Intended(any)  "ab\nb\naab\naaab";
set TestRegexp(any) {[any "a" "b"]};

set TestData(rangerebol) "a\naa\naaa\naaaa\nb\nbb\nab\nba\nc";
set Intended(rangerebol) "a\naa\naaa";
set TestRegexp(rangerebol) {[1 3 "a"]};

#Test for inline comment
set TestData(comment) "ab\nafoob\na?\#foob\na(?\#foo)b";
set Intended(comment) "ab";
set TestRegexp(comment) {a(?#foo)b};

#Tests for inline case-insensitive flag

set TestData(flagiAsciiLiteral) "aB\nAb\nAB\nab"
set Intended(flagiAsciiLiteral) "aB\nAb\nAB\nab"
set TestRegexp(flagiAsciiLiteral) {(?i)aB}

set TestData(flagiNonAsciiLiteral) "\u0531\u0561\n\u0531\u0531"
set Intended(flagiNonAsciiLiteral) "\u0531\u0561\n\u0531\u0531"
set TestRegexp(flagiNonAsciiLiteral) "(?i)\u0531\u0561"

set TestData(flagiAsciiClass) "a\nA"
set Intended(flagiAsciiClass) "a\nA"
set TestRegexp(flagiAsciiClass) {(?i)[[:lower:]]};

set TestData(flagiNonAsciiClass) "\u0561\n\u0531"
set Intended(flagiNonAsciiClass) "\u0561\n\u0531"
set TestRegexp(flagiNonAsciiClass) {(?i)[[:lower:]]};

set TestData(flagiAsciiClassSymmetric) "aB\nAB\nab";
set Intended(flagiAsciiClassSymmetric) "aB\nAB\nab";
set TestRegexp(flagiAsciiClassSymmetric) {(?i)[[:lower:]][[:upper:]]};

set TestData(flagiNonAsciiClassSymmetric) "\u0561\u0531\n\u0531\u0531\n\u0561\u0561";
set Intended(flagiNonAsciiClassSymmetric) "\u0561\u0531\n\u0531\u0531\n\u0561\u0561";
set TestRegexp(flagiNonAsciiClassSymmetric) {(?i)[[:lower:]][[:upper:]]};

set TestData(flagiuNonAsciiLiteral) "\u0531\u0561\n\u0531\u0531"
set Intended(flagiuNonAsciiLiteral) "\u0531\u0561\n\u0531\u0531"
set TestRegexp(flagiuNonAsciiLiteral) "(?iu)\u0531\u0561"

set TestData(flagiuNonAsciiClass) "\u0561\n\u0531"
set Intended(flagiuNonAsciiClass) "\u0561\n\u0531"
set TestRegexp(flagiuNonAsciiClass) {(?iu)[[:lower:]]};

set TestData(flagiuNonAsciiClassSymmetric) "\u0561\u0531\n\u0531\u0531\n\u0561\u0561";
set Intended(flagiuNonAsciiClassSymmetric) "\u0561\u0531\n\u0531\u0531\n\u0561\u0561";
set TestRegexp(flagiuNonAsciiClassSymmetric) {(?iu)[[:lower:]][[:upper:]]};

set TestData(flagx) "abc\na\tb c\na b c\na2b\nab c\nab c\#foo";
set Intended(flagx) {ab c};
set TestRegexp(flagx) {(?x)^a b\ c$#foo};

set TestData(flagq) "a*b\naab\nacb";
set Intended(flagq) {a*b};
set TestRegexp(flagq) {(?q)a*b};

set TestData(flagb) "t\n\u0009";
set Intended(flagb) "t";
set TestRegexp(flagb) {(?b)\t};

set TestData(flage) "xy\nab"
set Intended(flage) "xy";
set TestRegexp(flage) {(?e)xy};

set TestData(UnsetFlag) "AA\naA\nAa\naa";
set Intended(UnsetFlag) "AA\naA";
set TestRegexp(UnsetFlag) {(?i)a(?-i)A}

set TestData(FlagWideScope) "AA\naA\nAa\naa";
set Intended(FlagWideScope) "AA\naA\nAa\naa";
set TestRegexp(FlagWideScope) {a(?i)A}

set TestData(taggedgroup) "xyyyx\nxxyyyxx\nxxxyyyxxx\nxyyyxx\nxyx";
set Intended(taggedgroup) "xyyyx\nxxyyyxx\nxxxyyyxxx";
set TestRegexp(taggedgroup) {^(?P<exes>x+)yyy(?P=exes)$};

set TestData(uname) "x\u05DCy";
set Intended(uname) "x\u05DCy";
set TestRegexp(uname) {x\N{HEBREW LETTER LAMED}y};

set TestData(unamedb)   "x\u05DCy";
set Intended(unamedb)   "x\u05DCy";
set TestRegexp(unamedb) {x\\N{HEBREW LETTER LAMED}y};

set TestData(jLower) "AaZ\nABZ\nAcZ\nAZZ\nA+Z\nA4Z\nA:Z\nA?Z";
set Intended(jLower) "AaZ\nAcZ";
set TestRegexp(jLower)   {A\p{Lower}Z};

set TestData(jLowerdb)     "AaZ\nABZ\nAcZ\nAZZ\nA+Z\nA4Z\nA:Z\nA?Z";
set Intended(jLowerdb)     "AaZ\nAcZ";
set TestRegexp(jLowerdb)   {A\\p{Lower}Z};

set TestData(jLowerc) "AaZ\nABZ\nAcZ\nAZZ\nA+Z\nA4Z\nA:Z\nA?Z";
set Intended(jLowerc) "ABZ\nAZZ\nA+Z\nA4Z\nA:Z\nA?Z";
set TestRegexp(jLowerc)   {A\P{Lower}Z};

set TestData(jLowercdb) "AaZ\nABZ\nAcZ\nAZZ\nA+Z\nA4Z\nA:Z\nA?Z";
set Intended(jLowercdb) "ABZ\nAZZ\nA+Z\nA4Z\nA:Z\nA?Z";
set TestRegexp(jLowercdb)   {A\\P{Lower}Z};

set TestData(jUpper)    "aaz\naBz\nacz\naZz\na+z\na4z\na:z\na?z";
set Intended(jUpper)    "aBz\naZz";
set TestRegexp(jUpper)  {a\p{Upper}z};

set TestData(jUpperdb)   "aaz\naBz\nacz\naZz\na+z\na4z\na:z\na?z";
set Intended(jUpperdb)   "aBz\naZz";
set TestRegexp(jUpperdb) {a\\p{Upper}z};

set TestData(jUpperc)     "aaz\naBz\nacz\naZz\na+z\na4z\na:z\na?z";
set Intended(jUpperc)     "aaz\nacz\na+z\na4z\na:z\na?z";
set TestRegexp(jUpperc)   {a\P{Upper}z};

set TestData(jUppercdb)     "aaz\naBz\nacz\naZz\na+z\na4z\na:z\na?z";
set Intended(jUppercdb)     "aaz\nacz\na+z\na4z\na:z\na?z";
set TestRegexp(jUppercdb)   {a\\P{Upper}z};

set TestData(jAscii)     "aaz\naBz\nacz\naZz\na+z\na4z\na:z\na?z\na\tz\na\222z";
set Intended(jAscii)     "aaz\naBz\nacz\naZz\na+z\na4z\na:z\na?z\na\tz";
set TestRegexp(jAscii)   {a\p{ASCII}z};

set TestData(jAsciidb)    "aaz\naBz\nacz\naZz\na+z\na4z\na:z\na?z\na\tz\na\222z";
set Intended(jAsciidb)    "aaz\naBz\nacz\naZz\na+z\na4z\na:z\na?z\na\tz";
set TestRegexp(jAsciidb)  {a\\p{ASCII}z};

set TestData(jAsciic)     "aaz\naBz\nacz\naZz\na+z\na4z\na:z\na?z\na\tz\na\222z";
set Intended(jAsciic)     "a\222z";
set TestRegexp(jAsciic)   {a\P{ASCII}z};

set TestData(jAsciicdb)    "aaz\naBz\nacz\naZz\na+z\na4z\na:z\na?z\na\tz\na\222z";
set Intended(jAsciicdb)    "a\222z";
set TestRegexp(jAsciicdb)  {a\\P{ASCII}z};

set TestData(jAlpha) "a\nB\nc\nZ\n+\n4\n:\n?";
set Intended(jAlpha) "a\nB\nc\nZ";
set TestRegexp(jAlpha)  {\p{Alpha}};

set TestData(jAlphadb)    "a\nB\nc\nZ\n+\n4\n:\n?";
set Intended(jAlphadb)    "a\nB\nc\nZ";
set TestRegexp(jAlphadb)  {\\p{Alpha}};

set TestData(jAlphac)    "a\nB\nc\nZ\n+\n4\n:\n?";
set Intended(jAlphac)    "+\n4\n:\n?";
set TestRegexp(jAlphac)  {\P{Alpha}};

set TestData(jAlphacdb)    "a\nB\nc\nZ\n+\n4\n:\n?";
set Intended(jAlphacdb)    "+\n4\n:\n?";
set TestRegexp(jAlphacdb)  {\\P{Alpha}};

set TestData(jDigit) "A\n:\nB\nb\n1\n2\n3\n4\n5\n6\n7\n8\n9\n0\n?\n\023";
set Intended(jDigit) "1\n2\n3\n4\n5\n6\n7\n8\n9\n0";
set TestRegexp(jDigit)  {\p{Digit}};

set TestData(jDigitdb) "A\n:\nB\nb\n1\n2\n3\n4\n5\n6\n7\n8\n9\n0\n?\n\023";
set Intended(jDigitdb) "1\n2\n3\n4\n5\n6\n7\n8\n9\n0";
set TestRegexp(jDigitdb)  {\\p{Digit}};

set TestData(jDigitc) "A\n:\nB\nb\n1\n2\n3\n4\n5\n6\n7\n8\n9\n0\n?\n\023";
set Intended(jDigitc) "A\n:\nB\nb\n?\n\023";
set TestRegexp(jDigitc) {\P{Digit}};

set TestData(jDigitcdb) "A\n:\nB\nb\n1\n2\n3\n4\n5\n6\n7\n8\n9\n0\n?\n\023";
set Intended(jDigitcdb) "A\n:\nB\nb\n?\n\023";
set TestRegexp(jDigitcdb) {\\P{Digit}};

set TestData(jXdigit) "A\nB\nC\nD\nE\nF\na\nb\nc\nd\ne\nf\n1\n2\n3\n4\n5\n6\n7\n8\n9\n0\nj\nk\n;\n?";
set Intended(jXdigit) "A\nB\nC\nD\nE\nF\na\nb\nc\nd\ne\nf\n1\n2\n3\n4\n5\n6\n7\n8\n9\n0";
set TestRegexp(jXdigit) {\p{XDigit}};

set TestData(jXdigitdb)   "A\nB\nC\nD\nE\nF\na\nb\nc\nd\ne\nf\n1\n2\n3\n4\n5\n6\n7\n8\n9\n0\nj\nk\n;\n?";
set Intended(jXdigitdb)   "A\nB\nC\nD\nE\nF\na\nb\nc\nd\ne\nf\n1\n2\n3\n4\n5\n6\n7\n8\n9\n0";
set TestRegexp(jXdigitdb) {\\p{XDigit}};

set TestData(jXdigitc)  "A\nB\nC\nD\nE\nF\na\nb\nc\nd\ne\nf\n1\n2\n3\n4\n5\n6\n7\n8\n9\n0\nj\nk\n;\n?";
set Intended(jXdigitc)  "j\nk\n;\n?";
set TestRegexp(jXdigitc) {\P{XDigit}};

set TestData(jXdigitcdb)  "A\nB\nC\nD\nE\nF\na\nb\nc\nd\ne\nf\n1\n2\n3\n4\n5\n6\n7\n8\n9\n0\nj\nk\n;\n?";
set Intended(jXdigitcdb)  "j\nk\n;\n?";
set TestRegexp(jXdigitcdb) {\\P{XDigit}};

set TestData(jAlnum) "a\nB\nc\nZ\n+\n4\n:\n?\n_";
set Intended(jAlnum) "a\nB\nc\nZ\n4";
set TestRegexp(jAlnum)   {\p{Alnum}};

set TestData(jAlnumdb) "a\nB\nc\nZ\n+\n4\n:\n?\n_";
set Intended(jAlnumdb) "a\nB\nc\nZ\n4";
set TestRegexp(jAlnumdb)   {\\p{Alnum}};

set TestData(jAlnumc) "a\nB\nc\nZ\n+\n4\n:\n?\n_";
set Intended(jAlnumc) "+\n:\n?\n_";
set TestRegexp(jAlnumc)   {\P{Alnum}};

set TestData(jAlnumcdb) "a\nB\nc\nZ\n+\n4\n:\n?\n_";
set Intended(jAlnumcdb) "+\n:\n?\n_";
set TestRegexp(jAlnumcdb)   {\\P{Alnum}};

set TestData(jPunct) "aaz\naBz\nacz\naZz\na4z\na:z\na?z\na!z\na\#z\na\$z\na%z\na&z\na*z\na(z\na)z\na-z\na,z\na.z\na/z";
set Intended(jPunct) "a:z\na?z\na!z\na\#z\na\$z\na%z\na&z\na*z\na(z\na)z\na-z\na,z\na.z\na/z";
set TestRegexp(jPunct)   {a\p{Punct}z};

set TestData(jPunctdb)    "aaz\naBz\nacz\naZz\na4z\na:z\na?z\na!z\na\#z\na\$z\na%z\na&z\na*z\na(z\na)z\na-z\na,z\na.z\na/z";
set Intended(jPunctdb)    "a:z\na?z\na!z\na\#z\na\$z\na%z\na&z\na*z\na(z\na)z\na-z\na,z\na.z\na/z";
set TestRegexp(jPunctdb)  {a\\p{Punct}z};

set TestData(jPunctc) "aaz\naBz\nacz\naZz\na4z\na:z\na?z\na!z\na\#z\na\$z\na%z\na&z\na*z\na(z\na)z\na-z\na,z\na.z\na/z\na\040z";
set Intended(jPunctc) "aaz\naBz\nacz\naZz\na4z\na\040z";
set TestRegexp(jPunctc)   {a\P{Punct}z};

set TestData(jPunctcdb) "aaz\naBz\nacz\naZz\na4z\na:z\na?z\na!z\na\#z\na\$z\na%z\na&z\na*z\na(z\na)z\na-z\na,z\na.z\na/z\na\040z";
set Intended(jPunctcdb) "aaz\naBz\nacz\naZz\na4z\na\040z";
set TestRegexp(jPunctcdb)   {a\\P{Punct}z};

set TestData(jGraph) "aab\naAb\na4b\na:b\na\040b\na\011b\na\023b";
set Intended(jGraph) "aab\naAb\na4b\na:b";
set TestRegexp(jGraph)   {a\p{Graph}b};

set TestData(jGraphdb) "aab\naAb\na4b\na:b\na\040b\na\011b\na\023b";
set Intended(jGraphdb) "aab\naAb\na4b\na:b";
set TestRegexp(jGraphdb)   {a\\p{Graph}b};

set TestData(jGraphc) "aab\naAb\na4b\na:b\na\040b\na\011b\na\023b";
set Intended(jGraphc) "a\040b\na\011b\na\023b";
set TestRegexp(jGraphc)   {a\P{Graph}b};

set TestData(jGraphcdb) "aab\naAb\na4b\na:b\na\040b\na\011b\na\023b";
set Intended(jGraphcdb) "a\040b\na\011b\na\023b";
set TestRegexp(jGraphcdb)   {a\\P{Graph}b};

set TestData(jPrint) "aab\naAb\na4b\na:b\na\040b\na\011b\na\023b";
set Intended(jPrint) "aab\naAb\na4b\na:b\na\040b";
set TestRegexp(jPrint)   {a\p{Print}b};

set TestData(jPrintdb) "aab\naAb\na4b\na:b\na\040b\na\011b\na\023b";
set Intended(jPrintdb) "aab\naAb\na4b\na:b\na\040b";
set TestRegexp(jPrintdb)   {a\\p{Print}b};

set TestData(jPrintc) "aab\naAb\na4b\na:b\na\040b\na\011b\na\023b";
set Intended(jPrintc) "a\011b\na\023b";
set TestRegexp(jPrintc)   {a\P{Print}b};

set TestData(jPrintcdb) "aab\naAb\na4b\na:b\na\040b\na\011b\na\023b";
set Intended(jPrintcdb) "a\011b\na\023b";
set TestRegexp(jPrintcdb)   {a\\P{Print}b};

set TestData(jBlank) "a\040b\na\011b\nacb\na:b";
set Intended(jBlank) "a\040b\na\011b";
set TestRegexp(jBlank)   {a\p{Blank}b};

set TestData(jBlankdb) "a\040b\na\011b\nacb\na:b";
set Intended(jBlankdb) "a\040b\na\011b";
set TestRegexp(jBlankdb)   {a\\p{Blank}b};

set TestData(jBlankc) "a\040b\na\011b\nacb\na:b";
set Intended(jBlankc) "acb\na:b";
set TestRegexp(jBlankc)   {a\P{Blank}b};

set TestData(jBlankcdb) "a\040b\na\011b\nacb\na:b";
set Intended(jBlankcdb) "acb\na:b";
set TestRegexp(jBlankcdb)   {a\\P{Blank}b};

set TestData(jSpace) "a\040b\na\014b\na\011b\na\013b\na4b\na:b\nacb";
set Intended(jSpace) "a\040b\na\014b\na\011b\na\013b";
set TestRegexp(jSpace)  {a\p{Space}b};

set TestData(jSpacedb) "a\040b\na\014b\na\011b\na\013b\na4b\na:b\nacb";
set Intended(jSpacedb) "a\040b\na\014b\na\011b\na\013b";
set TestRegexp(jSpacedb)  {a\\p{Space}b};

set TestData(jSpacec) "a\040b\na\014b\na\011b\na\013b\na4b\na:b\nacb";
set Intended(jSpacec) "a4b\na:b\nacb";
set TestRegexp(jSpacec)  {a\P{Space}b};

set TestData(jSpacecdb) "a\040b\na\014b\na\011b\na\013b\na4b\na:b\nacb";
set Intended(jSpacecdb) "a4b\na:b\nacb";
set TestRegexp(jSpacecdb)  {a\\P{Space}b};

set TestData(jCntrl) "aab\naAb\na4b\na:b\na\040b\na\011b\na\023b\na\177b";
set Intended(jCntrl) "a\011b\na\023b\na\177b";
set TestRegexp(jCntrl)   {a\p{Cntrl}b};
			
set TestData(jCntrldb) "aab\naAb\na4b\na:b\na\040b\na\011b\na\023b\na\177b";
set Intended(jCntrldb) "a\011b\na\023b\na\177b";
set TestRegexp(jCntrldb)   {a\\p{Cntrl}b};
		
set TestData(jCntrlc) "aab\naAb\na4b\na:b\na\040b\na\011b\na\023b\na\177b";
set Intended(jCntrlc) "aab\naAb\na4b\na:b\na\040b";
set TestRegexp(jCntrlc)   {a\P{Cntrl}b};

set TestData(jCntrlcdb) "aab\naAb\na4b\na:b\na\040b\na\011b\na\023b\na\177b";
set Intended(jCntrlcdb) "aab\naAb\na4b\na:b\na\040b";
set TestRegexp(jCntrlcdb)   {a\\P{Cntrl}b};

#Java Unicode range
set TestData(jUBlock)  "a\u3042b\na\u3057b\na\u309db\naXb\na7b\na:b\na\u0B86b";
set Intended(jUBlock)  "a\u3042b\na\u3057b\na\u309db";
set TestRegexp(jUBlock)   {a\p{InHiragana}b};

#Java Unicode range - double backslash
set TestData(jUBlockdb)  "a\u3042b\na\u3057b\na\u309db\naXb\na7b\na:b\na\u0B86b";
set Intended(jUBlockdb)  "a\u3042b\na\u3057b\na\u309db";
set TestRegexp(jUBlockdb)   {a\\p{InHiragana}b};

#Java Unicode range - complement
set TestData(jUBlockc)  "a\u3042b\na\u3057b\na\u309db\naXb\na7b\na:b\na\u0B86b";
set Intended(jUBlockc)   "aXb\na7b\na:b\na\u0B86b";
set TestRegexp(jUBlockc)   {a\P{InHiragana}b};

#Java Unicode range - complement -db
set TestData(jUBlockcdb)  "a\u3042b\na\u3057b\na\u309db\naXb\na7b\na:b\na\u0B86b";
set Intended(jUBlockcdb)   "aXb\na7b\na:b\na\u0B86b";
set TestRegexp(jUBlockcdb)   {a\\P{InHiragana}b};

#Java Unicode general character property
set TestData(jUCat) "a\u3042b\naXb\na7b\na:b\na\u0B86b\na+b\na\u00ACb\na\u2044b";
set Intended(jUCat) "a+b\na\u00ACb\na\u2044b";
set TestRegexp(jUCat)   {a\p{Sm}b};

#Java Unicode general character property -db
set TestData(jUCatdb) "a\u3042b\naXb\na7b\na:b\na\u0B86b\na+b\na\u00ACb\na\u2044b";
set Intended(jUCatdb) "a+b\na\u00ACb\na\u2044b";
set TestRegexp(jUCatdb)   {a\\p{Sm}b};

#Java Unicode general character property - complement
set TestData(jUCatc) "a\u3042b\naXb\na7b\na:b\na\u0B86b\na+b\na\u00ACb\na\u2044b";
set Intended(jUCatc) "a\u3042b\naXb\na7b\na:b\na\u0B86b";
set TestRegexp(jUCatc)   {a\P{Sm}b};

#Java Unicode general character property - complement -db
set TestData(jUCatcdb) "a\u3042b\naXb\na7b\na:b\na\u0B86b\na+b\na\u00ACb\na\u2044b";
set Intended(jUCatcdb) "a\u3042b\naXb\na7b\na:b\na\u0B86b";
set TestRegexp(jUCatcdb)   {a\\P{Sm}b};

#Java character set union
set TestData(jUnion)    "a1b\na2b\na3b\nadb\naeb\nafb\nagb\na8b\na:b";
set Intended(jUnion)    "a1b\na2b\na3b\nadb\naeb\nafb";
set TestRegexp(jUnion)  {a[1-3[d-f]]b};

#Java character set intersection
set TestData(jInter)    "adb\naeb\nafb\nayb\na7b\na:b";
set Intended(jInter)    "adb\naeb\nafb";
set TestRegexp(jInter)  {a[a-z&&[d-f]]b};

#Positive forward assertion
set TestData(plookahead)    "abc lkj\nabc\nabc \nabc lk\nabc (?=lkj)";
set Intended(plookahead)    "abc lkj";
set TestRegexp(plookahead)  {abc (?=lkj).*};

#Negative forward assertion
set TestData(nlookahead)    "abclkj\nabc\nabclk\nabc(?!lkj)";
set Intended(nlookahead)    "abc\nabclk\nabc(?!lkj)";
set TestRegexp(nlookahead)  {abc(?!lkj).*};

#Positive backward assertion
set TestData(plookback)    "abc lkj\nabc\nabc \nabc lk\n(?<=abc) lkj";
set Intended(plookback)    "abc lkj";
set TestRegexp(plookback)  {.*(?<=abc) lkj};

#Positive backward assertion
#set TestData(plookbackbs)    "abc lkj\nabc\nabc \nabc lk\n(?<=abc) lkj";
#set Intended(plookbackbs)    "abc lkj";
#set TestRegexp(plookbackbs)  {.*(?\<=abc) lkj};

#Negative backward assertion
set TestData(nlookback)    "abclkj\nlkj\nbclkj\n(?<!abc)lkj";
set Intended(nlookback)    "lkj\nbclkj\n(?<!abc)lkj";
set TestRegexp(nlookback)  {.*(?<!abc)lkj};

#Negative backward assertion
#set TestData(nlookbackbs)    "abclkj\nlkj\nbclkj\n(?<!abc)lkj";
#set Intended(nlookbackbs)    "lkj\nbclkj\n(?<!abc)lkj";
#set TestRegexp(nlookbackbs)  {.*(?\<!abc)lkj};

#conditionals
set TestData(CondGroupSimple)    "<user@host.com>\nuser@host.com\n<user@host.com\nuser@host.com>";
set Intended(CondGroupSimple)    "<user@host.com>\nuser@host.com";
set TestRegexp(CondGroupSimple)  {^(<)?(\w+@\w+(?:\.\w+)+)(?(1)>)$};

set TestData(CondGroupElse)     "<user@host.com>\nuser@host.com:\nuser@host.com";
set Intended(CondGroupElse)     "<user@host.com>\nuser@host.com:";
set TestRegexp(CondGroupElse)  {^(<)?(\w+@\w+(?:\.\w+)+)(?(1)>|:)$};

set TestData(CondLookaroundSimple) "abxy\nxy\naxyc\ncdwz"
set Intended(CondLookaroundSimple) "abxy\nxy\naxyc"
set TestRegexp(CondLookaroundSimple) {.*(?(?<!ab)xy).*}

set TestData(CondLookaroundElse) "abxy\nxy\naxyc\nabwz";
set Intended(CondLookaroundElse) "xy\naxyc\nabwz";
set TestRegexp(CondLookaroundElse)  {.*(?(?<!ab)xy|wz).*}

set TestData(SelfishNoCaptureGroupA)    "aaaa"
set Intended(SelfishNoCaptureGroupA)    "aaaa"
set TestRegexp(SelfishNoCaptureGroupA)    {(?>a+)}

set TestData(SelfishNoCaptureGroupB)    "aaaa"
set Intended(SelfishNoCaptureGroupB)    "aaaa"
set TestRegexp(SelfishNoCaptureGroupB)    {(a+)a}

set TestData(SelfishNoCaptureGroupC)    "aaaa"
set Intended(SelfishNoCaptureGroupC)    ""
set TestRegexp(SelfishNoCaptureGroupC)    {(?>a+)a}

#Substitution tests

#Test for substitution backreference with k
set TestData(SubBackRefBare)   "abcdef";
set Intended(SubBackRefBare)   "abef";
set TestRegexp(SubBackRefBare) {(a.)(c.)(e.)};
set TestSubexp(SubBackRefBare) {1 3};

#Test for limit on number of groups in substitution backreference with k
set TestData(SubBackRefBareAtLeastTen)   "abcdefghijklmnopqrstuvwxyz";
set Intended(SubBackRefBareAtLeastTen)   "ajmnopqrstuvwxyz";
set TestRegexp(SubBackRefBareAtLeastTen) {(a)(b)(c)(d)(e)(f)(g)(h)(i)(j)(k)(l)}
set TestSubexp(SubBackRefBareAtLeastTen) {1 10};

#Test for substitution backreference with $k
set TestData(SubBackReferenceDol)   "abcdef";
set Intended(SubBackReferenceDol)   "abef";
set TestRegexp(SubBackReferenceDol) {(a.)(c.)(e.)};
set TestSubexp(SubBackReferenceDol) {$1$3};

#Test for substitution backreference with $0
set TestData(SubBackReferenceDolZero)   "abcdef";
set Intended(SubBackReferenceDolZero)   "ab abcdef";
set TestRegexp(SubBackReferenceDolZero) {(a.)(c.)(e.)};
set TestSubexp(SubBackReferenceDolZero) {$1 $0};

#Test for limit on number of groups in substitution backreference with $k
set TestData(SubBackReferenceDolAtLeastTen)   "abcdefghijklmnopqrstuvwxyz";
set Intended(SubBackReferenceDolAtLeastTen)   "ajmnopqrstuvwxyz";
set TestRegexp(SubBackReferenceDolAtLeastTen) {(a)(b)(c)(d)(e)(f)(g)(h)(i)(j)(k)(l)}
set TestSubexp(SubBackReferenceDolAtLeastTen) {$1$10};

#Test for substitution backreference with %k
set TestData(SubBackReferencePercent)  "abcdef";
set Intended(SubBackReferencePercent)  "abef";
set TestRegexp(SubBackReferencePercent) {(a.)(c.)(e.)};
set TestSubexp(SubBackReferencePercent) {%1%3};

#Test for substitution backreference with %0
set TestData(SubBackReferencePercentZero)  "abcdef";
set Intended(SubBackReferencePercentZero)  "ab abcdef";
set TestRegexp(SubBackReferencePercentZero) {(a.)(c.)(e.)};
set TestSubexp(SubBackReferencePercentZero) {%1 %0};

#Test for limit on number of groups in substitution backreference with %k
set TestData(SubBackReferencePercentAtLeastTen)   "abcdefghijklmnopqrstuvwxyz";
set Intended(SubBackReferencePercentAtLeastTen)   "ajmnopqrstuvwxyz";
set TestRegexp(SubBackReferencePercentAtLeastTen) {(a)(b)(c)(d)(e)(f)(g)(h)(i)(j)(k)(l)}
set TestSubexp(SubBackReferencePercentAtLeastTen) {%1%10};

#Test for substitution backreference with \k
set TestData(SubBackRefbs)   "abcdef";
set Intended(SubBackRefbs)  "abef";
set TestRegexp(SubBackRefbs) {(a.)(c.)(e.)};
set TestSubexp(SubBackRefbs) {\1\3};

#Test for substitution backreference with \0
set TestData(SubBackRefbsZero)   "abcdef";
set Intended(SubBackRefbsZero)  "ab abcdef";
set TestRegexp(SubBackRefbsZero) {(a.)(c.)(e.)};
set TestSubexp(SubBackRefbsZero) {\1 \0};

#Test for limit on number of groups in substitution backreference with \k
set TestData(SubBackRefbsAtLeastTen)   "abcdefghijklmnopqrstuvwxyz";
set Intended(SubBackRefbsAtLeastTen)   "ajmnopqrstuvwxyz";
set TestRegexp(SubBackRefbsAtLeastTen)  {(a)(b)(c)(d)(e)(f)(g)(h)(i)(j)(k)(l)}
set TestSubexp(SubBackRefbsAtLeastTen) {\1\10};

#Test for substitution backreference with \k and \(
set TestData(SubBackRefParbs)   "abcdef";
set Intended(SubBackRefParbs)  "abef";
set TestRegexp(SubBackRefParbs) {\(a.\)\(c.\)\(e.\)};
set TestSubexp(SubBackRefParbs) {\1\3};

#Test for substitution backreference with \0 and \(
set TestData(SubBackRefParbsZero)   "abcdef";
set Intended(SubBackRefParbsZero)  "ab abcdef";
set TestRegexp(SubBackRefParbsZero) {\(a.\)\(c.\)\(e.\)};
set TestSubexp(SubBackRefParbsZero) {\1 \0};

#Test for limit on number of groups in substitution backreference with \k and \(
set TestData(SubBackRefParbsAtLeastTen)   "abcdefghijklmnopqrstuvwxyz";
set Intended(SubBackRefParbsAtLeastTen)   "ajmnopqrstuvwxyz";
set TestRegexp(SubBackRefParbsAtLeastTen)  {\(a\)\(b\)\(c\)\(d\)\(e\)\(f\)\(g\)\(h\)\(i\)\(j\)\(k\)\(l\)}
set TestSubexp(SubBackRefParbsAtLeastTen) {\1\10};

#Test for substitution backreference with \\k
set TestData(SubBackRefdbs)   "abcdef";
set Intended(SubBackRefdbs)   "abef";
set TestRegexp(SubBackRefdbs) {(a.)(c.)(e.)};
set TestSubexp(SubBackRefdbs) {\\1\\3};

#Test for substitution backreference with \\0
set TestData(SubBackRefdbsZero)   "abcdef";
set Intended(SubBackRefdbsZero)  "ab abcdef";
set TestRegexp(SubBackRefdbsZero) {(a.)(c.)(e.)};
set TestSubexp(SubBackRefdbsZero) {\\1 \\0};

#Test for limit on number of groups in substitution backreference with \\k and 
set TestData(SubBackRefdbsAtLeastTen)   "abcdefghijklmnopqrstuvwxyz";
set Intended(SubBackRefdbsAtLeastTen)   "ajmnopqrstuvwxyz";
set TestRegexp(SubBackRefdbsAtLeastTen) {(a)(b)(c)(d)(e)(f)(g)(h)(i)(j)(k)(l)};
set TestSubexp(SubBackRefdbsAtLeastTen) {\\1\\10};

#Test for substitution backreference with \\k and \\(\\)
set TestData(SubBackRefPardbsdbs)   "abcdef";
set Intended(SubBackRefPardbsdbs)   "abef";
set TestRegexp(SubBackRefPardbsdbs) {\\(a.\\)\\(c.\\)\\(e.\\)};
set TestSubexp(SubBackRefPardbsdbs) {\\1\\3};

#Test for substitution backreference with \\0 and \\(\\)
set TestData(SubBackRefPardbsdbsZero)   "abcdef";
set Intended(SubBackRefPardbsdbsZero)   "ab abcdef";
set TestRegexp(SubBackRefPardbsdbsZero) {\\(a.\\)\\(c.\\)\\(e.\\)};
set TestSubexp(SubBackRefPardbsdbsZero) {\\1 \\0};

#Test for limit on number of groups in substitution backreference with \\k and  \\(\\)
set TestData(SubBackRefPardbsdbsAtLeastTen)   "abcdefghijklmnopqrstuvwxyz";
set Intended(SubBackRefPardbsdbsAtLeastTen)   "ajmnopqrstuvwxyz";
set TestRegexp(SubBackRefPardbsdbsAtLeastTen) {\\(a\\)\\(b\\)\\(c\\)\\(d\\)\\(e\\)\\(f\\)\\(g\\)\\(h\\)\\(i\\)\\(j\\)\\(k\\)\\(l\\)};
set TestSubexp(SubBackRefPardbsdbsAtLeastTen) {\\1\\10};

#Test for substitution backreference to entire match with 0
set TestData(SubEntBackRefZero)   "abcdef";
set Intended(SubEntBackRefZero)   "abcdefabcdef";
set TestRegexp(SubEntBackRefZero) {(ab)(cdef)};
set TestSubexp(SubEntBackRefZero) {0 0};

#Test for substitution backreference to entire match with \\&
set TestData(Subampentbackrefsdbs)   "abcdef";
set Intended(Subampentbackrefsdbs)   "abcdefabcdef";
set TestRegexp(Subampentbackrefsdbs) {(ab)(cdef)};
set TestSubexp(Subampentbackrefsdbs) {\\&\\&};

#Test for substitution backreference to entire match with $&
set TestData(SubDolAmpEntBackRef)   "abcdef";
set Intended(SubDolAmpEntBackRef)   "abcdefabcdef";
set TestRegexp(SubDolAmpEntBackRef) {(ab)(cdef)};
set TestSubexp(SubDolAmpEntBackRef) {$&$&};

#Test for substitution backreference to entire match with \\& where
#parentheses must be double-backslashed.
set TestData(SubampentbackrefsPardbsdbs)   "abcdef";
set Intended(SubampentbackrefsPardbsdbs)   "abcdefabcdef";
set TestRegexp(SubampentbackrefsPardbsdbs) {\\(ab\\)\\(cdef\\)};
set TestSubexp(SubampentbackrefsPardbsdbs) {\\&\\&};

#Test for backreference to pre-match
set TestData(SubPreMatch)   "abcdef";
set Intended(SubPreMatch)   "ababef";
set TestRegexp(SubPreMatch) {cd};
set TestSubexp(SubPreMatch) {\`};

#Test for backreference to pre-match
set TestData(SubPreMatchDol)   "abcdef";
set Intended(SubPreMatchDol)   "ababef";
set TestRegexp(SubPreMatchDol) {cd};
set TestSubexp(SubPreMatchDol) {$`};

#Test for backreference to pre-match with 'pre
set TestData(SubPreMatchLit)   "abcdef";
set Intended(SubPreMatchLit)   "ab";
set TestRegexp(SubPreMatchLit) {cd};
set TestSubexp(SubPreMatchLit) {'pre};

#Test for backreference to post-match
set TestData(SubPostMatch)   "abcdef";
set Intended(SubPostMatch)   "abefef";
set TestRegexp(SubPostMatch) {cd};
set TestSubexp(SubPostMatch) {\'};

#Test for backreference to post-match
set TestData(SubPostMatchDol)   "abcdef";
set Intended(SubPostMatchDol)   "abefef";
set TestRegexp(SubPostMatchDol) {cd};
set TestSubexp(SubPostMatchDol) {$'};

#Test for backreference to post-match with post
set TestData(SubPostMatchLit)   "abcdef";
set Intended(SubPostMatchLit)   "ef";
set TestRegexp(SubPostMatchLit) {cd};
set TestSubexp(SubPostMatchLit) {'post};

#Test for backreference to last captured subgroup
set TestData(SubLastCapture)   "abcdef";
set Intended(SubLastCapture)   "ef";
set TestRegexp(SubLastCapture) {((ab)cd)(ef)};
set TestSubexp(SubLastCapture) {\+};

#Test for backreference to last captured subgroup
set TestData(SubLastCaptureDol)   "abcdef";
set Intended(SubLastCaptureDol)   "ef";
set TestRegexp(SubLastCaptureDol) {((ab)cd)(ef)};
set TestSubexp(SubLastCaptureDol) {$+};

#Test for tr style repetition notation C*N
set TestData(SubCStarN)   "starz";
set Intended(SubCStarN)   "aaaaz";
set TestRegexp(SubCStarN) {abcdefghijklmnopqrstuvwxyz};
set TestSubexp(SubCStarN) {[a*25]z};

#Test for tr style repetition notation C*
set TestData(SubCStar)   "starz";
set Intended(SubCStar)   "aaaaa";
set TestRegexp(SubCStar) {abcdefghijklmnopqrstuvwxyz};
set TestSubexp(SubCStar) {[a*]};

#Tests for tr versions of POSIX character classes

set TestData(SubAlnum) "a\nB\nc\nZ\n+\n4\n:\n?";
set Intended(SubAlnum)  "x\nx\nx\nx\n+\nx\n:\n?";
set TestRegexp(SubAlnum)   {[:alnum:]};
set TestSubexp(SubAlnum)   {xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx};

set TestData(SubAlpha) "a\nB\nc\nZ\n+\n4\n:\n?";
set Intended(SubAlpha)  "x\nx\nx\nx\n+\n4\n:\n?";
set TestRegexp(SubAlpha)   {[:alpha:]};
set TestSubexp(SubAlpha)   {xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx};

set TestData(SubBlank) "a\040b\na\011b\na\n4\n:";
set Intended(SubBlank) "axb\naxb\na\n4\n:";
set TestRegexp(SubBlank)   {[:blank:]};
set TestSubexp(SubBlank)   {xxxxxxxxxx};

set TestData(SubCntrl) "aabaAba4ba:ba\040ba\011ba\023ba\177b";
set Intended(SubCntrl) "aabaAba4ba:ba\040baXbaXbaXbX"; #Last X is for newline added to data
set TestRegexp(SubCntrl)   {[:cntrl:]};
set TestSubexp(SubCntrl)   {XXXXXXXXXXXXXXXXXXXXXXXXXX};

set TestData(SubDigit) "A\n:\nB\nb\n1\n2\n3\n4\n5\n6\n7\n8\n9\n0\n?";
set Intended(SubDigit) "A\n:\nB\nb\nD\nD\nD\nD\nD\nD\nD\nD\nD\nD\n?";
set TestRegexp(SubDigit)  {[:digit:]};
set TestSubexp(SubDigit)  {DDDDDDDDDD};

set TestData(SubGraph) "aab\naAb\na4b\na:b\na\040b\na\011b\na\023b";
set Intended(SubGraph) "ggg\nggg\nggg\nggg\ng\040g\ng\011g\ng\023g";
set TestRegexp(SubGraph)   {[:graph:]};
set TestSubexp(SubGraph)   {gggggggggggggggggggggggggggggggggggggggggggggggggggggggggggggggggggggggggggggggggggggggggggggggggggggggggggggggggggggggggggggggg};

set TestData(SubLower) "AaZ\nABZ\nAcZ\nAZZ\nA+Z\nA4Z\nA:Z\nA?Z";
set Intended(SubLower) "AAZ\nABZ\nACZ\nAZZ\nA+Z\nA4Z\nA:Z\nA?Z";
set TestRegexp(SubLower)  {[:lower:]};
set TestSubexp(SubLower)  {[:upper:]};

set TestData(SubPrint) "aab\naAb\na4b\na:b\na\040b\na\011b\na\023b";
set Intended(SubPrint) "ggg\nggg\nggg\nggg\nggg\ng\011g\ng\023g";
set TestRegexp(SubPrint)   {[:print:]};
set TestSubexp(SubPrint)   {gggggggggggggggggggggggggggggggggggggggggggggggggggggggggggggggggggggggggggggggggggggggggggggggggggggggggggggggggggggggggggggggg};

set TestData(SubPunct) "aaz\naBz\nacz\naZz\na4z\na:z\na?z\na!z\na\#z\na\$z\na%z\na&z\na*z\na(z\na)z\na-z\na,z\na.z\na/z";
set Intended(SubPunct)  "aaz\naBz\nacz\naZz\na4z\naPz\naPz\naPz\naPz\naPz\naPz\naPz\naPz\naPz\naPz\naPz\naPz\naPz\naPz";
set TestRegexp(SubPunct)   {[:punct:]};
set TestSubexp(SubPunct)   {PPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPP};

set TestData(SubSpace) "a\040ba\014ba\011ba\013ba4ba:bacb";
set Intended(SubSpace) "axbaxbaxbaxba4ba:bacbx"; #Last X is for newline added to data
set TestRegexp(SubSpace)   {[:space:]};
set TestSubexp(SubSpace)   {xxxxxxxxxx};

set TestData(SubUpper)     "aaz\naBz\nacz\naZz\na+z\na4z\na:z\na?z";
set Intended(SubUpper)     "aaz\nabz\nacz\nazz\na+z\na4z\na:z\na?z";
set TestRegexp(SubUpper)   {[:upper:]};
set TestSubexp(SubUpper)   {[:lower:]};

set TestData(SubXdigit) "A\nB\nC\nD\nE\nF\na\nb\nc\nd\ne\nf\n1\n2\n3\n4\n5\n6\n7\n8\n9\n0\nj\nk\n;\n?";
set Intended(SubXdigit) "D\nD\nD\nD\nD\nD\nD\nD\nD\nD\nD\nD\nD\nD\nD\nD\nD\nD\nD\nD\nD\nD\nj\nk\n;\n?";
set TestRegexp(SubXdigit) {[:xdigit:]};
set TestSubexp(SubXdigit) {DDDDDDDDDDDDDDDDDDDDDD};

set TestData(SubRange) "x\ny\nz\na\nf\n4";
set Intended(SubRange) "F\nF\nF\na\nf\n4";
set TestRegexp(SubRange)   {[x-z]};
set TestSubexp(SubRange) {FFF};

#Tests for reluctant quantifiers
#These work for Java and Perl.
#To generalize them, turn them into templates and generate the actual expressions using our knowledge
#of what backreference notation the program uses and what quoting is necessary for
#capture groups.

set TestData(SubReluctantStarPrevDollar)     "abbbba";
set Intended(SubReluctantStarPrevDollar)     "bbbb";
set TestRegexp(SubReluctantStarPrevDollar)   {(a)(b*?)(b*)(a)};
set TestSubexp(SubReluctantStarPrevDollar)   {$3};

set TestData(SubReluctantPlusPrevDollar)     "abbbba";
set Intended(SubReluctantPlusPrevDollar)     "b";
set TestRegexp(SubReluctantPlusPrevDollar)   {(a)(b+?)(b+)(a)};
set TestSubexp(SubReluctantPlusPrevDollar)   {$2};

set TestData(SubReluctantQuestionMarkPrevDollar)     "abbbba";
set Intended(SubReluctantQuestionMarkPrevDollar)     "bbbb";
set TestRegexp(SubReluctantQuestionMarkPrevDollar)   {(a)(b??)(b+)(a)};
set TestSubexp(SubReluctantQuestionMarkPrevDollar)   {$3};

set TestData(SubReluctantIntegerRangeDollar)     "abbbba";
set Intended(SubReluctantIntegerRangeDollar)     "bb";
set TestRegexp(SubReluctantIntegerRangeDollar)   {(a)(b{2,4}?)(b+)(a)};
set TestSubexp(SubReluctantIntegerRangeDollar)   {$3};

# For Ruby
set TestData(SubReluctantStarPrevBackslash)     "abbbba";
set Intended(SubReluctantStarPrevBackslash)     "bbbb";
set TestRegexp(SubReluctantStarPrevBackslash)   {(a)(b*?)(b*)(a)};
set TestSubexp(SubReluctantStarPrevBackslash)   {\3};

set TestData(SubReluctantPlusPrevBackslash)     "abbbba";
set Intended(SubReluctantPlusPrevBackslash)     "b";
set TestRegexp(SubReluctantPlusPrevBackslash)   {(a)(b+?)(b+)(a)};
set TestSubexp(SubReluctantPlusPrevBackslash)   {\2};

set TestData(SubReluctantQuestionMarkPrevBackslash)     "abbbba";
set Intended(SubReluctantQuestionMarkPrevBackslash)     "bbbb";
set TestRegexp(SubReluctantQuestionMarkPrevBackslash)   {(a)(b??)(b+)(a)};
set TestSubexp(SubReluctantQuestionMarkPrevBackslash)   {\3};

set TestData(SubReluctantIntegerRangeBackslash)     "abbbba";
set Intended(SubReluctantIntegerRangeBackslash)     "bb";
set TestRegexp(SubReluctantIntegerRangeBackslash)   {(a)(b{2,4}?)(b+)(a)};
set TestSubexp(SubReluctantIntegerRangeBackslash)   {\3};

set TestData(PossStarA)     "aaaa";
set Intended(PossStarA)     "aaaa";
set TestRegexp(PossStarA)   "a*+";

set TestData(PossStarB)     "aaaa";
set Intended(PossStarB)     "";
set TestRegexp(PossStarB)   "a*+a";

set TestData(PossPlusA)     "aaaa";
set Intended(PossPlusA)     "aaaa";
set TestRegexp(PossPlusA)   "a++";

set TestData(PossPlusB)     "aaaa";
set Intended(PossPlusB)     "";
set TestRegexp(PossPlusB)   "a++a";

set TestData(PossQMarkA)     "a";
set Intended(PossQMarkA)     "a";
set TestRegexp(PossQMarkA)   "a?+";

set TestData(PossQMarkB)     "a";
set Intended(PossQMarkB)     "";
set TestRegexp(PossQMarkB)   "a?+a";

set TestData(PossAtLeastMA)     "aaaa";
set Intended(PossAtLeastMA)     "aaaa";
set TestRegexp(PossAtLeastMA)   "a{1,}+";

set TestData(PossAtLeastMB)     "aaaa";
set Intended(PossAtLeastMB)     "";
set TestRegexp(PossAtLeastMB)   "a{1,}+a";

set TestData(PossMToNA)     "aa\na";
set Intended(PossMToNA)     "aa\na";
set TestRegexp(PossMToNA)   "a{1,2}+";

set TestData(PossMToNB)     "aa\na";
set Intended(PossMToNB)     "";
set TestRegexp(PossMToNB)   "a{1,2}+a";

set TestData(PossMToNC)     "aaa\naa\na";
set Intended(PossMToNC)     "aaa";
set TestRegexp(PossMToNC)   "a{1,2}+a";

set TestData(SubLitString)    "abcde";
set Intended(SubLitString)    "GH";
set TestRegexp(SubLitString)  ".*cd.*";
set TestSubexp(SubLitString)  "\"GH\"";

set TestData(ExactMatchWD)      "read\nready\nbeads\nroads\nreads"
set Intended(ExactMatchWD)      "read\nready\nbeads\nreads";
set TestRegexp(ExactMatchWD)    "r<ead>s";

set TestData(ExactMatchTRE)      "read\nready\nbeads\nroads\nreads"
set Intended(ExactMatchTRE)      "read\nready\nbeads\nreads";
set TestRegexp(ExactMatchTRE)    "r(ead){~0}s";

set TestData(ExactMatchCgrep)      "read\nready\nbeads\nroads\nreads"
set Intended(ExactMatchCgrep)      "read\nready\nbeads\nreads";
set TestRegexp(ExactMatchCgrep)    "r<ead>";

set TestData(TRECostSetting)      "read\nready\nbeads\nroads\nreads\nrains"
set Intended(TRECostSetting)      "read\nready\nroads\nreads"
set TestRegexp(TRECostSetting)    "r(eads){~1,1i+1d+1s}";

#The results I get disagree with the documentation so leave this
#out until I can find out if sleep is buggy or if I have misunderstood.

#set TestData(ReluctantStar) "this is me testing with this test\nthis is me test";
#set Intended(ReluctantStar) "this is me test";
#set TestRegexp(ReluctantStar) {this*test}

#set TestData(GreedyDoubleStar) "this is me testing with this test\nthis is me test";
#set Intended(GreedyDoubleStar) "this is me testing with this test";
#set TestRegexp(GreedyDoubleStar) {this**test}


proc LayoutWindows {} {
    global SideBySideLayoutP;
    global RegSubSideBySideP;
    global DoSubstitutionsP;
    global ComparisonWindowDisplayedP;
    global MainWidth;
    global MainHeight;
    global PixelHeight;
    global UseScrollbarsP;

    pack forget .sep1;
    pack forget .sep2;
    pack forget .sep3
    pack forget .sepcmnds;
    pack forget .cmnds;
    pack forget .msg;
    pack forget .rsf;
    pack forget .dwf;
    pack forget .dwf.vwi;
    pack forget .dwf.vwo;
    pack forget .dwf.vwc;
    pack forget $::REG;
    pack forget $::SUB;
    pack forget $::IND;
    pack forget $::INDSB;
    pack forget $::OUT;
    pack forget $::OUTSB;
    pack forget $::COM;
    pack forget $::COMSB;

    if {$::AquaP} {
	pack .cmnds -side top                     -fill x
	pack .sepcmnds                            -fill x
    }
    pack .msg       -side top                     -fill x
    pack .sep2                                   -fill x
    set HeightInLines [expr $PixelHeight / [font metrics MainFont -linespace]];
    incr HeightInLines -5; #For messages, re, sub, menubar. 

    #Take care of the regexp and subexp windows.
    if {$RegSubSideBySideP && $DoSubstitutionsP} {
	set IndWidth [expr $MainWidth / 2];
	$::REG  configure -width $IndWidth;
	$::SUB configure -width $IndWidth;
    }
    pack .rsf -side top -expand 0    -fill x;
    if {$DoSubstitutionsP} {
	if {$RegSubSideBySideP} {
	    pack $::REG        -side left   -expand yes   -fill x;
	    pack $::SUB       -side right  -expand yes   -fill x;
	} else {
	    pack $::REG        -side top                 -fill x;		
	    pack $::SUB       -side top                 -fill x;
	}
    } else {
	pack $::REG        -side top                 -fill x;	
    }
    
    #Compute the heights to use for the data windows.
    if {$SideBySideLayoutP == 0} {
	if {$ComparisonWindowDisplayedP} {
	    set IndHeight [expr $HeightInLines / 3];
	} else {
	    set IndHeight [expr $HeightInLines / 2];
	}
    } else {
	set IndHeight $MainHeight;
    }
    pack .dwf -side bottom -expand 1 -fill both;

    if {$SideBySideLayoutP == 0} {
	$::IND configure -width $MainWidth  -height $IndHeight;
	$::OUT configure -width $MainWidth  -height $IndHeight;
	$::COM configure -width $MainWidth  -height $IndHeight;
	if {$ComparisonWindowDisplayedP} {
	    if {$UseScrollbarsP} {
		pack .dwf.vwi  -side top    -fill both -expand 1
		pack .dwf.vwo  -side top    -fill both -expand 1
		pack .dwf.vwc  -side bottom -fill both -expand 1
		pack $::INDSB  -side right  -fill y    -expand 0 -in .dwf.vwi;
		pack $::IND    -side left   -fill both -expand 1 -in .dwf.vwi;
		pack $::OUTSB  -side right  -fill y    -expand 0 -in .dwf.vwo;
		pack $::OUT    -side left   -fill both -expand 1 -in .dwf.vwo;
		pack $::COMSB  -side right  -fill y    -expand 0 -in .dwf.vwc;
		pack $::COM    -side left   -fill both -expand 1 -in .dwf.vwc;
	    } else {
		pack $::IND    -side top     -fill both -expand 1
		pack .sep1                   -fill x
		pack $::OUT    -side top     -fill both -expand 1
		pack .sep2                   -fill x
		pack $::COM    -side bottom  -fill both -expand 1
	    }
	} else {
	    if {$UseScrollbarsP} {
		pack .dwf.vwi  -side top    -fill both -expand 1
		pack .dwf.vwo  -side bottom -fill both -expand 1
		pack $::INDSB  -side right  -fill y    -expand 0 -in .dwf.vwi;
		pack $::IND    -side left   -fill both -expand 1 -in .dwf.vwi;
		pack $::OUTSB  -side right  -fill y    -expand 0 -in .dwf.vwo;
		pack $::OUT    -side left   -fill both -expand 1 -in .dwf.vwo;
	    } else {
		pack $::IND    -side top     -fill both -expand 1
		pack .sep1                   -fill x
		pack $::OUT    -side bottom  -fill both -expand 1
	    }
	}
    } else {
	if {$ComparisonWindowDisplayedP} {
	    set SideWidth [expr $MainWidth / 3];
	    $::IND configure -width $SideWidth -height $IndHeight;
	    $::OUT configure -width $SideWidth -height $IndHeight;
	    $::COM configure -width $SideWidth  -height $IndHeight;
	    if {$UseScrollbarsP} {pack $::INDSB  -side left  -expand 0 -fill y}
	    if {$UseScrollbarsP} {pack $::COMSB  -side right -expand 0 -fill y}
	    pack $::IND    -side left  -expand 1 -fill both
	    if {$UseScrollbarsP} {pack $::OUTSB  -side left  -expand 0 -fill y}
	    pack $::OUT    -side left  -expand 1 -fill both
	    pack $::COM    -side right -expand 1 -fill both 
	} else {
	    set SideWidth [expr $MainWidth / 2];
	    $::IND configure -width $SideWidth  -height $IndHeight;
	    $::OUT configure -width $SideWidth  -height $IndHeight;
	    if {$UseScrollbarsP} {pack $::INDSB -side left  -fill y    -expand 0}
	    if {$UseScrollbarsP} {pack $::OUTSB -side right -fill y    -expand 0}
	    pack $::IND   -side left  -fill both -expand 1
	    pack $::OUT   -side right -fill both -expand 1
	}
    }
    if {$DoSubstitutionsP} {
	InOutScrollLinkage;
    }
}

set LeftArrowImage [image create photo -data {
    R0lGODlhFAAUAIAAAAAAAL+/vyH5BAEAAAEALAAAAAAUABQAAAIqjI+py43gGIAxTVrNxXVz
    54WTIopWGZ7oRq7X4o4wm2lvbX+ZjGv9/ysAADs=
}];

namespace eval search {
    variable SearchOffset;
    variable SrchWCnt 0;
    variable GotoCharWCnt 0;
    namespace export GetSearchTarget

    proc SearchInitialize {w} {
	variable SearchOffset;
	set SearchOffset($w,f) 1.0;
	set SearchOffset($w,b) 1.0;
    }

    proc SearchResults {} {
	if {[string length [$::OUT get 1.0 end]] <= 1 } {
	    ShowMessage [_ "There is no result text to search."]
	    return
	}
	PopupSearch $::OUT  [_ "Search Results"];
    }

    proc SearchTestData {} {
	if {[string length [$::IND get 1.0 end]] <= 1 } {
	    ShowMessage [_ "There is no input text to search."]
	    return
	}
	PopupSearch $::IND  [_ "Search Input Text"];
    }

    proc GotoCharResults {} {
	if {[string length [$::OUT get 1.0 end]] <= 1 } {
	    ShowMessage [_ "There are no results to search."]
	    return
	}
	PopupGotoChar $::OUT [_ "Go to Character in Results"];
    }

    proc GotoCharTestData {} {
	if {[string length [$::IND get 1.0 end]] <= 1 } {
	    ShowMessage [_ "There is no test data to search."]
	    return
	}
	PopupGotoChar $::IND [_ "Go to Character in Test Data"];
    }

    
    proc SearchText {w re forwardp cw} {
	variable SearchOffset;
	if {$forwardp} {
	    set df "-forward";
	    set Offset $SearchOffset($w,f);
	} else {
	    set df "-backward";
	    set Offset $SearchOffset($w,b);
	}
	set CurrentLine [lindex [split $Offset "."] 0]
	set CurrentChar [lindex [split $Offset "."] 1]
	set ind [$w search $df -regexp -count MatchLen $re $CurrentLine.$CurrentChar]
	if {$ind == ""} {
	    ShowMessage [_ "No match found"];
	    return 
	} else {
	    $w tag delete match;
	    $w tag configure "match" -background $::ColorSpecs(Match,Background);
	    $w tag add match $ind "$ind + $MatchLen chars"
	    $w see $ind
	    set MatchBegin [$w index match.first]
	    set MatchEnd   [$w index match.last-1chars];
	    set MatchBeginChar [CountChars [$w get 1.0 $MatchBegin-1chars]];
	    set MatchEndChar [expr $MatchBeginChar + [CountChars [$w get $MatchBegin $MatchEnd]]];
	    set msg [format [_ "Matched \[%s-%s\]  \[%s-%s\]"] $MatchBegin $MatchEnd [DelimitNumber $MatchBeginChar] [DelimitNumber $MatchEndChar]];
	    ShowMessage $msg
	    $cw.ri configure -text $msg;
	    set SearchOffset($w,f) "$ind + $MatchLen chars + 1 chars"
	    set SearchOffset($w,b) "$ind -1 chars"
	    return
	}
    }


    proc PopupSearch {w title} {
	global MainFont;
	variable SrchWCnt;
	incr SrchWCnt;

	set pn [format ".srch%d" $SrchWCnt];
	if {[winfo exists $pn]} {
	    raise $pn
	    return
	}
	toplevel $pn -borderwidth 4 -relief raised \
	    -bg $::ColorSpecs(PopupWidgetDefault,Background);
	wm title $pn $title;
	label $pn.ri  -bg $::ColorSpecs(PopupWidgetDefault,Background);
	entry $pn.ent -width 40 -font MainFont   \
	    -bg $::ColorSpecs(PopupWidgetDefault,Background);
	button $pn.f  -text [_ "Search Forward"] \
	    -command "search::SearchForEntry $w 1 $pn"  \
	    -bg $::ColorSpecs(PopupWidgetButton,Background);
	button $pn.b  -text [_ "Search Backward"] \
	    -command "search::SearchForEntry $w 0 $pn" \
	    -bg $::ColorSpecs(PopupWidgetButton,Background);
	button $pn.d  -text [_ "Dismiss"] \
	    -command "destroy $pn" \
	    -bg $::ColorSpecs(PopupWidgetButton,Background);
	pack $pn.ri -side top
	pack $pn.ent -side top
	pack $pn.f -side right
	pack $pn.d -side left
	pack $pn.b -side right
	raise $pn;
	set AfterIdleCmd [format {update idletasks
	    set TextLeftEdge [winfo rootx %s];
	    dmsg "TextLeftEdge=$TextLeftEdge"
	    set TextRightEdge [expr $TextLeftEdge +  [winfo width %s]];
	    dmsg "TextRightEdge=$TextRightEdge"
	    set PopupWidth [winfo width %s];
	    dmsg "PopupWidth=$PopupWidth"
	    set x [expr int($TextRightEdge - ((2.0/3.0) * $PopupWidth))]
	    dmsg "x=$x"
	    set TextTopEdge  [winfo rooty %s];
	    dmsg "TextTopEdge=$TextTopEdge"
	    set TextMidHeight [expr $TextTopEdge + ([winfo height %s]/2.0)]
	    dmsg "TextMidHeight=$TextMidHeight"
	    set PopupHeight [winfo height %s];
	    dmsg "PopupHeight=$PopupHeight"
	    set y [expr int ($TextMidHeight -((2.0/3.0) * $PopupHeight))]
	    dmsg "y=$y"
	    wm geometry %s "+$x+$y"
	} $w $w $pn $w $pn $w $pn];
	after idle $AfterIdleCmd;
	BindKeys $pn;
	bind $pn <FocusIn> "SetInsertionTargets $pn.ent"
	bind $pn.ent <FocusIn> "SetInsertionTargets $pn.ent"
	bind $pn.ent <Return> "search::SearchForEntry $w 1 $pn"
    }

    proc SearchForEntry {w d pn} {
	set tgt [$pn.ent get];
	SearchText $w $tgt $d $pn;
    }

    proc PopupGotoChar {w title} {
	global MainFont;
	variable GotoCharWCnt;
	incr GotoCharWCnt;

	set pn [format ".gotochar%s" [regsub -all "\\." $w "-"]]
	if {[winfo exists $pn]} {
	    raise $pn
	    return
	}
	toplevel $pn -borderwidth 4 -relief raised \
	    -bg $::ColorSpecs(PopupWidgetDefault,Background);
	wm title $pn "";
	label $pn.title -text $title \
	    -bg $::ColorSpecs(PopupWidgetDefault,Background);
	entry $pn.ent -width 40 -font MainFont \
    	    -bg $::ColorSpecs(PopupWidgetDefault,Background);
	bind $pn <FocusIn> "SetInsertionTargets $pn.ent"
	button $pn.f  -text [_ "Go"] \
	    -command "search::GotoCharInText $w $pn" \
	    -bg $::ColorSpecs(PopupWidgetButton,Background);
	button $pn.d  -text [_ "Dismiss"] \
	    -command "destroy $pn" \
	    -bg $::ColorSpecs(PopupWidgetButton,Background);
	pack $pn.title -side top
	pack $pn.ent -side top
	pack $pn.f -side right
	pack $pn.d -side left
	raise $pn;
	set AfterIdleCmd [format {update idletasks
	    set TextLeftEdge [winfo rootx %s];
	    dmsg "TextLeftEdge=$TextLeftEdge"
	    set TextRightEdge [expr $TextLeftEdge +  [winfo width %s]];
	    dmsg "TextRightEdge=$TextRightEdge"
	    set PopupWidth [winfo width %s];
	    dmsg "PopupWidth=$PopupWidth"
	    set x [expr int($TextRightEdge - ((2.0/3.0) * $PopupWidth))]
	    dmsg "x=$x"
	    set TextTopEdge  [winfo rooty %s];
	    dmsg "TextTopEdge=$TextTopEdge"
	    set TextMidHeight [expr $TextTopEdge + ([winfo height %s]/2.0)]
	    dmsg "TextMidHeight=$TextMidHeight"
	    set PopupHeight [winfo height %s];
	    dmsg "PopupHeight=$PopupHeight"
	    set y [expr int ($TextMidHeight -((2.0/3.0) * $PopupHeight))]
	    dmsg "y=$y"
	    wm geometry %s "+$x+$y"
	} $w $w $pn $w $pn $w $pn];
	after idle $AfterIdleCmd;
	BindKeys $pn;
	bind $pn.ent <FocusIn> "SetInsertionTargets $pn.ent"
	bind $pn.ent <Return>  "search::GotoCharInText $w $pn"
    }

    #tw = text window in which to locate character
    #cw = calling window - the name of the popup from which to get the character position.
    proc GotoCharInText {tw cw} {
	#Handle both tcl line.char format indices and pure character offsets.
	set CharPos [$cw.ent get]
	$tw tag delete goto;
	$tw tag configure "goto" -background $::ColorSpecs(Match,Background);
	if {[scan $CharPos %d.%d line char] >= 2} {
	    $tw tag add goto $CharPos "$CharPos + 1 chars"
	    $tw see $CharPos;
	} else {
	    $tw tag add goto 1.0+${CharPos}chars 1.1+${CharPos}chars
	    $tw see 1.0+${CharPos}chars
	}
    }
}


namespace eval resc {
    namespace export CacheResult ResetNumberOfResultsToStore PopupCachedEntries 
    variable ResultsToKeep 5;
    variable ResultsStored 0;
    variable EntriesDisplayed 0;
    variable ResultList;
    variable CacheChecked;
    variable EventNumber 0;

    array set CacheChecked {};

    proc CacheResult {res prg re se} {
	variable ResultsToKeep;
	variable ResultsStored;
	variable ResultList;
	variable EventNumber;
	global DoSubstitutionsP;

	incr EventNumber;
	if {$ResultsStored >= $ResultsToKeep} {
	    set ResultList [lreplace $ResultList 0 0]; #Remove 1st element from list.
	    incr ResultsStored -1;
	}
	if {$DoSubstitutionsP} {
	    lappend ResultList [list $EventNumber $res $prg $re $se];
	} else {
	    lappend ResultList [list $EventNumber $res $prg $re];
	}
	incr ResultsStored;
    }

    proc DeleteCacheEntry {k} {
	variable ResultsStored;
	variable ResultList;

	set ResultList [lreplace $ResultList $k $k]
	incr ResultsStored -1;
    }

    proc DeleteCacheEntries {} {
	variable ResultList

	set SelectedEntries [list];
	set SelectedEntryCnt 0;
	foreach i [array names ::CacheChecked] {
	    if {$::CacheChecked($i) == 1} {
		lappend SelectedEntries $i;
		incr SelectedEntryCnt;
	    }
	}
	if {$SelectedEntryCnt == 0} {return}

	set SelectedEntries [lsort -decreasing $SelectedEntries];
	foreach i $SelectedEntries {
	    DeleteCacheEntry [expr $i -1];
	    .cacentry.chk$i deselect
	}
	resc::UpdateCacheDisplay;
    }

    proc ResetNumberOfResultsToStore {New} {
	variable ResultsToKeep;
	variable ResultsStored;
	variable ResultList;

	if {$New < 0} {return}
	set ResultsToKeep $New;
	if {$New < $ResultsStored} {
	    set ResultList [lreplace $ResultList 0 [expr $ResultsStored - $New - 1]];
	    set ResultsStored $ResultsToKeep;
	}
    }

    proc SaveCacheEntries {} {
	variable ResultList

	set SelectedEntries [list];
	set SelectedEntryCnt 0;
	foreach i [array names ::CacheChecked] {
	    if {$::CacheChecked($i) == 1} {
		lappend SelectedEntries $i;
		incr SelectedEntryCnt;
	    }
	}
	for {set i 0} {$i < $SelectedEntryCnt} {incr i} {
	    set Entry [lindex $ResultList [expr [lindex $SelectedEntries $i] -1]]
	    set EntryEventNumber [lindex $Entry 0];
	    set SaveFile [tk_getSaveFile -initialfile \
			      [format [_ "Result-%03d"] $EntryEventNumber]];
	    if {[string equal $SaveFile ""] == 1} {
		ShowMessage [_ "File selection cancelled."];
		return ;
	    } else {
		if { [catch {open $SaveFile "w+"} fh] != 0} {
		    ShowMessage [format [_ "Unable to open file %s in which to save result."] \
				     [MinimizeFileName $SaveFile]];
		    return ;
		}
	    }
	    puts $fh [lindex $Entry 1];
	    close $fh;
	}
    }

    proc CompareCacheEntries {} {
	variable ResultList;
	set SelectedEntries [list];
	set SelectedEntryCnt 0;
	foreach i [array names ::CacheChecked] {
	    if {$::CacheChecked($i) == 1} {
		lappend SelectedEntries $i;
		incr SelectedEntryCnt;
	    }
	}
	if {$SelectedEntryCnt < 2} {
	    ShowMessage [_ "There's no point in comparing fewer than two results."]
	    return ;
	}

	for {set i 0} {$i < $SelectedEntryCnt} {incr i} {
	    for {set j [expr $i + 1]} {$j < $SelectedEntryCnt} {incr j} {
		set a [lindex $SelectedEntries $i]
		set b [lindex $SelectedEntries $j]
		if {[string equal [lindex [lindex $ResultList [expr $a -1]] 1]\
			 [lindex [lindex $ResultList [expr $b -1]] 1]]} {
		    lappend ol [format "%d=%d  "  $a $b];
		} else {
		    lappend ol [format "%d!=%d  " $a $b];
		}
	    }
	}
	if {$SelectedEntryCnt <=5} {
	    ShowMessage [join $ol]
	} else {
	    foreach i $ol {
		puts $i;
	    }
	    FlushJournal; #So that the results of multiple comparisons can be seen.
	}
    }

    proc FormatPopupString {k entry} {
	set MaxRELength 15;

	set EventNum [lindex $entry 0]; 
	set prog [lindex $entry 2]
	set lines [DelimitNumber [CountLines [lindex $entry 1]]] 
	set rexp [lindex $entry 3]
	if {[string length $rexp] > $MaxRELength} {
	    set rexp [string range $rexp 0 [expr $MaxRELength -1]]
	}
	if {[llength $entry] > 4} {
	    set sexp [lindex $entry 4]
	    if {[string length $sexp] > $MaxRELength} {
		set sexp [string range $sexp 0 [expr $MaxRELength -1]]
	    }
	    set txt\
		[format "%d  %3d %-10s %6s  %-*s %*s" $k $EventNum $prog $lines $MaxRELength $rexp $MaxRELength $sexp] 
	} else {
	    set txt \
		[format "%d  %3d %-10s %6s  %-*s" $k $EventNum $prog $lines $MaxRELength $rexp]
	}
	return $txt;
    }

    option add *cacentry*.background $::ColorSpecs(PopupWidgetDefault,Background) 100
    option add *cacentry*.foreground $::ColorSpecs(PopupWidgetDefault,Foreground) 100
    option add *cacentry*Button.background $::ColorSpecs(PopupWidgetButton,Background) 100
    option add *cacentry*Button.foreground $::ColorSpecs(PopupWidgetButton,Foreground) 100
    option add *cacentry*Checkbutton.background $::ColorSpecs(PopupWidgetDefault,Background) 100
    option add *cacentry*Checkbutton.foreground $::ColorSpecs(PopupWidgetCheckbutton,Foreground) 100
    option add *cacentry*Label.background $::ColorSpecs(PopupWidgetLabel,Background) 100
    option add *cacentry*Label.foreground $::ColorSpecs(PopupWidgetLabel,Foreground) 100
    
    proc PopupCachedEntries {} {
	if {[winfo exists .cacentry]} {
	    ShowMessage [_ "A recent result window already exists."]
	    return;
	}
	toplevel .cacentry -borderwidth 4 -relief raised \
	    -bg $::ColorSpecs(PopupWidgetDefault,Background)
	wm title .cacentry "";
	label .cacentry.title -text "Recent Results"
	grid .cacentry.title    -row 0 -column 0 -sticky ew -columnspan 5 

	button .cacentry.compare -text [_ "Compare"]    -command {resc::CompareCacheEntries}
	button .cacentry.save    -text [_ "Save"]       -command {resc::SaveCacheEntries}
	button .cacentry.delete  -text [_ "Delete"]     -command {resc::DeleteCacheEntries}
	button .cacentry.cancel  -text [_ "Dismiss"]     -command {destroy .cacentry}

	balloonhelp_for .cacentry.compare  [_ "Compare the selected entries."]
	balloonhelp_for .cacentry.save    [_ "Write the selected entries to a file."]
	balloonhelp_for .cacentry.delete    [_ "Delete the selected entries."]
	balloonhelp_for .cacentry.cancel   [_ "Dismiss the popup."]

	frame .cacentry.sep -height 10 -bg $::ColorSpecs(PopupWidgetDefault,Background)
	grid .cacentry.sep      -row 6 -column 0 -sticky ew  -columnspan 5
	grid .cacentry.compare  -row 7 -column 0
	grid .cacentry.save     -row 7 -column 1
	grid .cacentry.delete   -row 7 -column 3
	grid .cacentry.cancel   -row 7 -column 4
	UpdateCacheDisplay;
    }

    proc UpdateCacheDisplay {} {
	variable ResultList;
	variable ResultsStored;
	variable ResultsToKeep;
	variable EntriesDisplayed;

	for {set i 0} {$i < $EntriesDisplayed} {incr i} {
	    set I [expr $i + 1];
	    destroy .cacentry.chk$I
	    destroy .cacentry.txt$I
	}
	
	if {$ResultsStored < $ResultsToKeep} {
	    set EntriesToDisplay $ResultsStored;
	} else {
	    set EntriesToDisplay $ResultsToKeep;
	}

	for {set i 0} {$i < $EntriesToDisplay} {incr i} {
	    set I [expr $i + 1];
	    set ckbName .cacentry.chk$I
	    set labName .cacentry.txt$I
	    checkbutton $ckbName -width 2 -onvalue 1 -offvalue 0 -variable CacheChecked($I) \
		-relief sunken
	    label $labName  -justify left  -text \
		[FormatPopupString $I [lindex $ResultList $i]]
	    balloonhelp_for $labName  [lindex [lindex $ResultList $i] 2]
	    grid $ckbName  -row $I -column 0
	    grid $labName  -row $I -column 1 -sticky w  -columnspan 4
	}
	set EntriesDisplayed $EntriesToDisplay
    }
}

proc ExplainAlpha {} {
    global HPWidth;
    global HPLines;
    global HelpPopups;
    if {[PopupDown Alpha] ==1} {return}
    set po [CreateTextDisplay [_ "Alpha Characters"] $HPWidth $HPLines]
    BindKeys $po;
    set HelpPopups(Alpha) $po;
    AppendToTextDisplay $po [_ "The ASCII alpha characters are the letters a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q,r,s,t,u,v,w,x,y,z and their upper-case counterparts. In other writing systems the alpha characters are the characters considered equivalent in function, that is, in having primarily phonological content, as opposed to punctuation, numerals, spaces, and so forth. The definition of this class depends on the locale."];
    AppendToTextDisplay $po "\n\n";
    AppendToTextDisplay $po [_ "For details on the POSIX character classes, including\
an ASCII chart color-coded for the POSIX classes, see the reference manual section "];
    set url [PathToFileURL [file join $::ManualDirectory builtincharclass.html]]
    AppendLinkToTextDisplay $po "Builtin Character Classes" [list ShowWebPage $url]
    AppendToTextDisplay $po ".\n"
}

proc ExplainAlphaNumWord {} {
    global HPWidth;
    global HPLines;
    global HelpPopups;
    if {[PopupDown AlphaNumWord] ==1} {return}
    set po [CreateTextDisplay [_ "Alphanumeric and Word Characters"] $HPWidth $HPLines]
    BindKeys $po;
    set HelpPopups(AlphaNumWord) $po;
    AppendToTextDisplay $po [_ "Two subtly different classes of characters are used in regular expressions. The more traditional class is the \`alphanumeric\' class, which is the union of the letters and the digits. In the ASCII character set and in, e.g., the C locale, the alphanumeric class consists therefore of the 52 letters of the alphabet, upper- and lower-case, and the ten digits 0-9. In other locales the membership of the alpha characters and digits may vary, but the alphanumeric class always consists of the union of the two sets."];
    AppendToTextDisplay $po "\n\n";
    AppendToTextDisplay $po [_ "The related class of characters, sometimes confused with the alphanumerics and given the same name, is what are sometimes called the \`word\' characters. These are the characters that may be used in words, that is, in identifiers such as variables and function names, in certain programming languages. The word characters consist of the alphanumeric characters together with the underscore character."];
    AppendToTextDisplay $po "\n"
    AppendToTextDisplay $po [_ "For details on the POSIX character classes, including\
an ASCII chart color-coded for the POSIX classes, see the reference manual section "];
    set url [PathToFileURL [file join $::ManualDirectory builtincharclass.html]]
    AppendLinkToTextDisplay $po "Builtin Character Classes" [list ShowWebPage $url]
    AppendToTextDisplay $po ".\n"
}

proc ExplainAny {} {
    global HPWidth;
    global HPLines;
    global HelpPopups;
    if {[PopupDown Any] ==1} {return}
    set po [CreateTextDisplay [_ "Any"] $HPWidth $HPLines]
    BindKeys $po;
    set HelpPopups(Any) $po;
    AppendToTextDisplay $po [_ "This matches any number of repetitions, including zero, of the folowing character or block."];
}

proc ExplainBooleanAnd {} {
    global HPWidth;
    global HPLines;
    global HelpPopups;
    if {[PopupDown BooleanAnd] ==1} {return}
    set po [CreateTextDisplay [_ "And"] $HPWidth $HPLines]
    BindKeys $po;
    set HelpPopups(BooleanAnd) $po;
    AppendToTextDisplay $po [_ "This notation is used to require that the text match two regular expressions. The zero indicates that the two matches must be be located within zero lines of each other, that is, on the same line. In normal use, this program allows other values in this position, but since Redet is line-oriented these alternatives are not available."];
}


proc ExplainControlCharacter {} {
    global HPWidth;
    global HPLines;
    global HelpPopups;
    if {[PopupDown ControlCharacter] ==1} {return}
    set po [CreateTextDisplay [_ "ControlCharacter"] $HPWidth $HPLines]
    BindKeys $po;
    set HelpPopups(ControlCharacter) $po;
    AppendToTextDisplay $po [_ {The control characters are usually the ASCII control characters, namely the first 32 characters (0x00-0x1F) and the last ASCII character (0x7F). They are so named because their original purpose was to control actions of teletype machines, such as ringing the bell, as opposed to denoting printable characters. Many control characters are no longer routinely seen in text, but some are common since they include such characters as tab and linefeed. On many keyboards, pressing the Control key at the same time as typing another letter generates a code in the ASCII control range. Control characters are sometimes referred to by the combination of keys that generates them.  0x01 is Control-A, 0x02 is Control-B, through 0x26, which is control Z.  (The other keyboard equivalents are 0x00 = Control-@, 0x1B = Control-[, 0x1C = Control-\, 0x1D = Control-], 0x1E = Control-^, and 0x1F = Control-_.) The space character 0x20 is sometimes also considered a control character.}];
    AppendToTextDisplay $po "\n\n";
    AppendToTextDisplay $po [_ "Additional control characters are defined in some encodings. For instance, in the ISO-8859-1 extension of ASCII (also known as Latin-1) widely used for European languages, codepoints 0x80-0x9F are also control characters. The named class of control characters used in regular expressions refers either to just the ASCII control characters or to additional control characters from the ISO-8859-1 range depending on the locale. Unicode does not introduce any control characters beyond those defined in ISO-8859-1.\n"];
    AppendToTextDisplay $po "\n"
    AppendToTextDisplay $po [_ "For details on the POSIX character classes, including\
an ASCII chart color-coded for the POSIX classes, see the reference manual section "];
    set url [PathToFileURL [file join $::ManualDirectory builtincharclass.html]]
    AppendLinkToTextDisplay $po "Builtin Character Classes" [list ShowWebPage $url]
    AppendToTextDisplay $po ".\n"
}

proc ExplainCrosshatchAny {} {
    global HPWidth;
    global HPLines;
    global HelpPopups;
    if {[PopupDown CrosshatchAny] ==1} {return}
    set po [CreateTextDisplay [_ "Crosshatch"] $HPWidth $HPLines]
    BindKeys $po;
    set HelpPopups(CrosshatchAny) $po;
    AppendToTextDisplay $po [_ "This matches one or more tokens of the preceding character."];
}


proc ExplainOrString {} {
    global HPWidth;
    global HPLines;
    global HelpPopups;
    if {[PopupDown OrString] ==1} {return}
    set po [CreateTextDisplay [_ "String Disjunction"] $HPWidth $HPLines]
    BindKeys $po;
    set HelpPopups(OrString) $po;
    AppendToTextDisplay $po [_ "This matches a string that contains either or both of the two argument strings."];
}

proc ExplainAndString {} {
    global HPWidth;
    global HPLines;
    global HelpPopups;
    if {[info exists HelpPopups(AndString)]} {
	if {[winfo exists $HelpPopups(AndString)]} {
	    destroy $HelpPopups(AndString);
	    return;
	}
    }
    set po [CreateTextDisplay [_ "String Conjunction"] $HPWidth $HPLines]
    BindKeys $po;
    set HelpPopups(AndString) $po;
    AppendToTextDisplay $po [_ "This matches a string that contains both of the two argument strings."];
}

proc ExplainDigit {} {
    global HPWidth;
    global HPLines;
    global HelpPopups;
    if {[info exists HelpPopups(Digit)]} {
	if {[winfo exists $HelpPopups(Digit)]} {
	    destroy $HelpPopups(Digit);
	    return;
	}
    }
    set po [CreateTextDisplay [_ "Digit"] $HPWidth $HPLines]
    BindKeys $po;
    set HelpPopups(Digit) $po;
    AppendToTextDisplay $po [_ "Digit here refers specifically to the decimal digits: 0 1 2 3 4 5 6 7 8 and 9. In some locales, additional local numerals may be included."];
    AppendToTextDisplay $po "\n\n"
    AppendToTextDisplay $po [_ "For details on the POSIX character classes, including\
an ASCII chart color-coded for the POSIX classes, see the reference manual section "];
    set url [PathToFileURL [file join $::ManualDirectory builtincharclass.html]]
    AppendLinkToTextDisplay $po "Builtin Character Classes" [list ShowWebPage $url]
    AppendToTextDisplay $po ".\n"
}

proc ExplainLiteralMetachar {} {
    global HPWidth;
    global HPLines;
    global HelpPopups;
    if {[info exists HelpPopups(LiteralMetachar)]} {
	if {[winfo exists $HelpPopups(LiteralMetachar)]} {
	    destroy $HelpPopups(LiteralMetachar);
	    return;
	}
    }
    set po [CreateTextDisplay [_ "Literal Metacharacter"] $HPWidth $HPLines]
    BindKeys $po;
    set HelpPopups(LiteralMetachar) $po;
    AppendToTextDisplay $po [_ "It is sometimes necessary to give their ordinary meaning to\
metacharacters, that is, characters that have a special meaning in regular expressions.\
For example, we may want to match the character *, not any number of characters or any\
number of the preceding regular expression.  When a character is a metacharacter,\
prefixing it with an escape character gives it its literal meaning. For example,\
if * is a metacharacter, in many programs \\* is a literal star."];
}

proc ExplainDot {} {
    global HPWidth;
    global HPLines;
    global HelpPopups;
    if {[info exists HelpPopups(Dot)]} {
	if {[winfo exists $HelpPopups(Dot)]} {
	    destroy $HelpPopups(Dot);
	    return;
	}
    }
    set po [CreateTextDisplay [_ "Dot"] $HPWidth $HPLines]
    BindKeys $po;
    set HelpPopups(Dot) $po;
    AppendToTextDisplay $po [_ "This matches any single character except, possibly, newline.\
Whether it matches newline depends on the program and sometimes can be set by the user.\
If you want dot to match newline, see if the matcher you are using supports the inline\
flag \`s\'. In several matchers, including Perl, Python, and Java, this flag causes dot\
to match newline."];
}

proc ExplainExactMatch {} {
    global HPWidth;
    global HPLines;
    global HelpPopups;
    if {[info exists HelpPopups(ExactMatch)]} {
	if {[winfo exists $HelpPopups(ExactMatch)]} {
	    destroy $HelpPopups(ExactMatch);
	    return;
	}
    }
    set po [CreateTextDisplay [_ "Exact Matching"] $HPWidth $HPLines]
    BindKeys $po;
    set HelpPopups(ExactMatch) $po;
    AppendToTextDisplay $po [_ "Some programs that support approximate matching provide ways of restricting the permissible location of inexact matches. One such device is to mark a substring as requiring an exact match by surrounding it with angle brackets. For example, with the total error level set to 1, \`r<ead>s\' matches \`ready\' and \`beads\', since in both cases the errors fall outside the marked substring, but does not match \`roads\', since the error (o instead of e) falls within the marked substring. The other device is the \{~0\} operator, which requires the preceding group to match exactly. In this notation, our example is: \`r(ead)\{~0\}s\'"];
}


proc ExplainHexDigit {} {
    global HPWidth;
    global HPLines;
    global HelpPopups;
    if {[info exists HelpPopups(HexDigit)]} {
	if {[winfo exists $HelpPopups(HexDigit)]} {
	    destroy $HelpPopups(HexDigit);
	    return;
	}
    }
    set po [CreateTextDisplay [_ "Hexadecimal Digits"] $HPWidth $HPLines]
    BindKeys $po;
    set HelpPopups(HexDigit) $po;
    AppendToTextDisplay $po [_ "The hexadecimal digits are the characters used to write numbers in base 16.\
 These are: 0,1,2,3,4,5,6,7,8,9,a,b,c,d,e, and f. The letters a-f may be either lower or upper case."];
    AppendToTextDisplay $po "\n\n"
    AppendToTextDisplay $po [_ "For details on the POSIX character classes, including\
an ASCII chart color-coded for the POSIX classes, see the reference manual section "];
    set url [PathToFileURL [file join $::ManualDirectory builtincharclass.html]]
    AppendLinkToTextDisplay $po "Builtin Character Classes" [list ShowWebPage $url]
    AppendToTextDisplay $po ".\n"
}

proc ExplainHyphenPrev {} {
    global HPWidth;
    global HPLines;
    global HelpPopups;
    if {[info exists HelpPopups(HyphenPrev)]} {
	if {[winfo exists $HelpPopups(HyphenPrev)]} {
	    destroy $HelpPopups(HyphenPrev);
	    return;
	}
    }
    set po [CreateTextDisplay [_ "Hyphen"] $HPWidth $HPLines]
    BindKeys $po;
    set HelpPopups(HyphenPrev) $po;
    AppendToTextDisplay $po [_ "This matches any number of repetitions, including zero, of the preceding group. The group may be explicitly marked or it may be an implicit group consisting of a single character. For example, \`sing-\' means \`the letters sin followed by any number, including zero, of gs\'. \`sing*\'therefore matches \`sin\' but does not match \`sings\, \`singlet\', or \`singer\'."]
}

proc ExplainPlus {} {
    global HPWidth;
    global HPLines;
    global HelpPopups;
    if {[info exists HelpPopups(Plus)]} {
	if {[winfo exists $HelpPopups(Plus)]} {
	    destroy $HelpPopups(Plus);
	    return;
	}
    }
    set po [CreateTextDisplay [_ "Plus"] $HPWidth $HPLines]
    BindKeys $po;
    set HelpPopups(Plus) $po;
    AppendToTextDisplay $po [_ "This matches one or more repetitions of the preceding group. The group may be explicitly marked or it may be an implicit group consisting of a single character. Thus \a+`\' matches \`a\', \`aa\', \`aaa\', \`aaaa\' and so forth, while, in a program in which parentheses are used for grouping, \`(abc)+\' matches \`abc\', \`abcabc\', \`abcabcabc\' and so forth. Since + quantifies another regular expression, it cannot stand alone. This usage should be distinguished from the alternative, found primarily in filename globbing, in which plus matches any string containing one or more characters. In that usage, plus does not quantify another regular expression and can therefore stand alone. For example, in the present usage \`sin+\' means matches \`match the sequence si followed by one or more ns\'. It therefore matches \`sin\' and \`sinn\' (if we include non-English words), but does not match \`sing\', \`sins\', or \`singlet\'. In the alternative usage, \`sing\', \`sins\', and \`singlet\' all match, but \`sin\' does not match, since the + requires that at least one character follow \`sin\'."]}

proc ExplainPlusAny {} {
    global HPWidth;
    global HPLines;
    global HelpPopups;
    if {[info exists HelpPopups(PlusAny)]} {
	if {[winfo exists $HelpPopups(PlusAny)]} {
	    destroy $HelpPopups(PlusAny);
	    return;
	}
    }
    set po [CreateTextDisplay [_ "Plus"] $HPWidth $HPLines]
    BindKeys $po;
    set HelpPopups(PlusAny) $po;
    AppendToTextDisplay $po [_ "This matches any string containing at least one character. Since it does not quantify another regular expression, it can stand alone. This usage should be distinguished from the more common usage in which the + sign represents one or more repetitions of the preceding regular expression and therefore cannot stand alone. In the present usage, \`sing\', \`sins\', and \`singlet\' all match, but \`sin\' does not match, since the + requires that at least one character follow \`sin\'. In the alternative usage, \`sin+\' means \`match the sequence si followed by one or more ns\'. It therefore matches \`sin\' and \`sinn\' (if we include non-English words), but does not match \`sing\', \`sins\', or \`singlet\'."]}

proc ExplainSelfishQuantifier {} {
    global HPWidth;
    global HPLines;
    global HelpPopups;
    if {[info exists HelpPopups(SelfishQuantifier)]} {
	if {[winfo exists $HelpPopups(SelfishQuantifier)]} {
	    destroy $HelpPopups(SelfishQuantifier);
	    return;
	}
    }
    set po [CreateTextDisplay [_ "Selfish Quantifier"] $HPWidth $HPLines]
    BindKeys $po;
    set HelpPopups(SelfishQuantifier) $po;
    AppendToTextDisplay $po [_ "Quantiers in regular expressions may be\
reluctant (also known as \`lazy\'), greedy, or selfish (also known as \`possessive\'.\
The traditional quantifiers are greedy. The distinction depends on how the quantifier interacts\
with other parts of the regular expression.\
An ordinary \`greedy\' quantifier matches as much as it can\
while still allowing other parts of the regular expression to match.\
A selfish quantifier matches the largest substring that it can, even\
if that causes other parts of the regular expression to fail to match and\
therefore causes the expression as a whole to fail to match."];
    AppendToTextDisplay $po "\n\n";
    AppendToTextDisplay $po [_ "
For example, consider the regular expression\
\`(a)(b++)(b+)(a)\', where\
\`+\' is the ordinary quantifier meaning \`one or more  repetitions of the preceding\
group\' and \`++\' is its selfish counterpart. What will happen when this\
expression is applied to the string \`abbbba\'? The \`a\'s at either end\
will match. The question is, how will the two terms with \`b\'s divide\
up the four \`b\'s in the string between them? Since the first b-term is\
selfish, it will match the largest substring that satisfies it, which is\
all four \`b\'s. This will leave no \`b\' to be matched by the third term,\
so the regular expression as a whole will fail to match. If we change\
the quantifier in the second term from selsifh to ordinary, the regular\
expression will match since the non-selfish quantifier in the second\
term will cede the last \`b\' to the third term."];
}

proc ExplainReluctantQuantifier {} {
    global HPWidth;
    global HPLines;
    global HelpPopups;
    if {[info exists HelpPopups(ReluctantQuantifier)]} {
	if {[winfo exists $HelpPopups(ReluctantQuantifier)]} {
	    destroy $HelpPopups(ReluctantQuantifier);
	    return;
	}
    }
    set po [CreateTextDisplay [_ "Reluctant Quantifier"] $HPWidth $HPLines]
    BindKeys $po;
    set HelpPopups(ReluctantQuantifier) $po;
    AppendToTextDisplay $po [_ "Quantiers in regular expressions may be\
reluctant (also known as \`lazy\'), greedy, or selfish (also known as \`possessive\'.\
The traditional quantifiers are greedy. The distinction depends on how the quantifier interacts\
with other parts of the regular expression.\
A reluctant quantifier matches the smallest substring that it can.\
An ordinary \`greedy\' quantifier matches as much as it can\
while still allowing other parts of the regular expression to match."];
    AppendToTextDisplay $po "\n\n";
    AppendToTextDisplay $po [_ "For example, consider the regular expression\
\`(a)(b+?)(b+)(a)\', where\
\`+\' is the ordinary quantifier meaning \`one or more  repetitions of the preceding\
group\' and \`+?\' is its reluctant counterpart. What will happen when this\
expression is applied to the string \`abbbba\'? The \`a\'s at either end\
will match. The question is, how will the two terms with \`b\'s divide\
up the four \`b\'s in the string between them? Since the first b-term is\
reluctant, it will match the smallest substring that satisfies it, which is\
a single \`b\'. The other three \`b\'s will be matched by the third term.\
How the \`b\'s are divided up makes no difference to the success of the match\
in this case, but it is relevant when doing substitutions and for backreferences."];
}

proc ExplainStar {} {
    global HPWidth;
    global HPLines;
    global HelpPopups;
    if {[info exists HelpPopups(Star)]} {
	if {[winfo exists $HelpPopups(Star)]} {
	    destroy $HelpPopups(Star);
	    return;
	}
    }
    set po [CreateTextDisplay [_ "Star"] $HPWidth $HPLines]
    BindKeys $po;
    set HelpPopups(Star) $po;
    AppendToTextDisplay $po [_ "This matches any number of repetitions, including zero, of the preceding group. The group may be explicitly marked or it may be an implicit group consisting of a single character. This usage of star should be distinguished from the alternative, familiar especially from filename globbing, in which the star stands for any number of any character. In the present usage, star cannot stand alone; it quantifies another regular expression. In the usage typical of filename globbing, star can stand alone. In other words, star in the globbing usage is equivalent to .* in the non-globbing usage (assuming that the program is one in which dot stands for any character). For example, in the present usage, \`sing*\' means \`the letters sin followed by any number, including zero, of gs\'. \`sing*\'therefore matches \`sin\' but does not match \`sings\, \`singlet\', or \`singer\'. in the other usage, \`sing*\' matches \`sings\, \`singlet\', and \`singer\', since the star indicates that anything may follow \`sing\', but not \`sin\', since the \`g\' is a fixed part of the expression."];
}

proc ExplainStarAny {} {
    global HPWidth;
    global HPLines;
    global HelpPopups;
    if {[info exists HelpPopups(StarAny)]} {
	if {[winfo exists $HelpPopups(StarAny)]} {
	    destroy $HelpPopups(StarAny);
	    return;
	}
    }
    set po [CreateTextDisplay [_ "Star"] $HPWidth $HPLines]
    BindKeys $po;
    set HelpPopups(StarAny) $po;
    AppendToTextDisplay $po [_ "This matches an arbitrary sequence of characters of any length, including zero. It should be distinguished from the more common usage of star in which a regular expression followed by star matches any number of repetitions of the regular expression. In that usage, star may not stand alone since it quantifies another regular expression. In the present usage, star may stand alone. For example, in the present usage, \`sing*\' matches \`sings\, \`singlet\', and \`singer\', since the star indicates that anything may follow \`sing\', but not \`sin\', since the \`g\' is a fixed part of the expression. In the other usage, \`sing*\' means \`the letters sin followed by any number, including zero, of gs\'. \`sing*\'therefore matches \`sin\' but does not match \`sings\, \`singlet\', or \`singer\'."];
}


proc ExplainBackReferenceSub {} {
    global HPWidth;
    global HPLines;
    global HelpPopups;
    if {[info exists HelpPopups(BackReferenceSub)]} {
	if {[winfo exists $HelpPopups(BackReferenceSub)]} {
	    destroy $HelpPopups(BackReferenceSub);
	    return;
	}
    }
    set po [CreateTextDisplay [_ "Substitution Backreferences"] $HPWidth $HPLines]
    BindKeys $po;
    set HelpPopups(BackReferenceSub) $po;
    AppendToTextDisplay $po [_ "Expressions of this form insert a copy of the corresponding captured group in the regular expression."]
    AppendToTextDisplay $po [_ "For example, if the regular expression is {(.*)(ity|ness)},\
where the first parenthesis matches any string and the second parenthesis matches either \"ity\"\
or \"ness\", and the backreference notation is \$k, the expression \$2 in the substitution\
will insert whichever of the two suffixes was matched and \$1 will insert the part of the\
string  preceding the suffix. The substitution expression \"\$2 \$1-\$2 \" will produce\
a copy of the string preceded by the suffix and with the suffix separated from the\
rest of the word by a hyphen. For example, the input \"ability\" will produce the\
output \"ity abil-ity\"."];
    if {[string equal $::program perl]} {
	AppendToTextDisplay $po "\n\n";
	AppendToTextDisplay $po [_ "In Perl, backreferences within the regular expression proper use backslash followed by the group number. Backreferences from the substitution expression to the regular expression use dollar sign instead of backslash. Backslash works in some circumstances, but it is only sure to work within the match expression, so to be safe you should use dollar sign in substitutions."];
    }
    AppendToTextDisplay $po "\n\n";
    foreach x  [list \
		    SubBackRefBare\
		    SubBackReferenceDol\
		    SubBackReferencePercent\
		    SubBackRefbs\
		    SubBackRefParbs\
		    SubBackRefdbs\
		    SubBackRefPardbsdbs] {
	if {$::Features($x,$::program,$::Locale)} {
	    if {$::Features(${x}AtLeastTen,$::program,$::Locale) == 0} {
		if {![string equal $::Palette($x,Prefix) ""]} {
		    AppendToTextDisplay $po [format \
			 [_ "The back reference index with prefix %s must be no greater than 9."] \
					     $::Palette($x,Prefix)];
		} else {
		    AppendToTextDisplay $po \
			[_ "The back reference index must be no greater than 9."];
		}
	    } else {
		if {![string equal $::Palette($x,Prefix) ""]} {
		    AppendToTextDisplay $po [format \
			 [_ "The back reference index with prefix %s may exceed 9."] \
					     $::Palette($x,Prefix)];
		} else {
		    AppendToTextDisplay $po \
			[_ "The back reference index may exceed 9."];
		}
	    }
	}
    }
}

proc ExplainTRECostSetting {} {
    global HPWidth;
    global HPLines;
    global HelpPopups;
    if {[info exists HelpPopups(TRECostSetting)]} {
	if {[winfo exists $HelpPopups(TRECostSetting)]} {
	    destroy $HelpPopups(TRECostSetting);
	    return;
	}
    }
    set po [CreateTextDisplay [_ "TRE Cost Setting"] $HPWidth $HPLines]
    BindKeys $po;
    set HelpPopups(TRECostSetting) $po;
    AppendToTextDisplay $po [_ "This construction sets the error costs for the immediately preceding group. When using approximate matching, it is necessary to decide when an imperfect match is to count as good enough. This construction allows you to specify how to make this decision on a group-by-group basis."];
    AppendToTextDisplay $po [_ "\n\n"];
    AppendToTextDisplay $po [_ "Each cost specification consists of two parts, both optional. If both are present, they are separated by a comma. The first part sets limits on the number of different types of errors directly. The second part specifies a formula for computing the total error cost and setting a limit on it."];
    AppendToTextDisplay $po [_ "\n\n"];
    AppendToTextDisplay $po [_ "
Three types of error are recognized. An error is an insertion if the target string may be obtained from the match pattern by adding one character to it. For example, \`red\' becomes \`read\' by the insertion of an \`a\'. An error is a deletion if the target string may be obtained from the match pattern by removing one character from it. For example, \`read\' becomes \`red\' by deletion of an \`a\'. Two strings differing in that one contains one character more than the other may be regarded as related by either insertion or deletion, depending on which string is taken to be the source. In this case, the pattern is taken to be the source and the target string is taken to be the result of the transformation. Thus, the pattern \`red\' matches the string \`read\' if ane insertion is permitted but not if only deletions are permitted. An error is a substitution if one string may be obtained from the other by substituting one character for another. For example, \`read\' becomes \`road\' by substitution of \`o\' for \`e\'."];
    AppendToTextDisplay $po [_ "\n\n"];
    AppendToTextDisplay $po [_ "Limits on error numbers may be set on insertions, deletions, and substitutions individually or on the total number of errors, or both. The maximum permitted number of insertions takes the form \`+k\', where \`k\' is a non-negative integer. Similarly, the limit on deletions takes the form \`-k\', the number of substitutions the form \`\#k\', and the total number of errors of any type the form \`~k\'. The cost specification \`{+2-3\#1~4}\' therefore means that a maximum of two insertions, three deletions, and one substitution are permitted and that the total number of errors must not exceed four."];
    AppendToTextDisplay $po [_ "\n\n"];
    AppendToTextDisplay $po [_ "The cost equation (which is not really an equation) specifies the weight to be given to each of the three types of errors and sets a maximum total cost. The weights are specified by writing a non-negative integer before \`i\' for insertions, \`d\' for deletions, and \`s\' for substitutions. If more than one is specified, they may be separated by plus signs. The total cost, which is not optional (if a cost equation is given at all) consists of a less-than sign followed by a positive integer. Note that the less-than sign here does not have its usual mathematical meaning.  \`<k\' means that \`k\' is the maximum permitted, which is to say that the maximum total cost must be less than or equal to \`k\'. The cost equation \`1i + 3d + 2s < 4\' says that insertions count one unit, deletions three units, and substitutions two units, and that the total cost must be no greater than four. With this cost equation, \`reads\' matches \`brads\' because the total cost is one insertion and one deletion, for a permissible total of four, but not \`red\', because this requires two deletions, for an impermissible  total cost of six."];}

proc ExplainUnicodeCategory {} {
    global HPWidth;
    global HPLines;
    global HelpPopups;
    if {[info exists HelpPopups(UnicodeCategory)]} {
	if {[winfo exists $HelpPopups(UnicodeCategory)]} {
	    destroy $HelpPopups(UnicodeCategory);
	    return;
	}
    }
    set po [CreateTextDisplay [_ "Unicode Categories"] $HPWidth $HPLines]
    BindKeys $po;
    set HelpPopups(UnicodeCategory) $po;
    AppendToTextDisplay $po [_ "Unicode characters are classified according to a number of properties, such as whether they are upper case letters, mathematical symbols, and so forth. Some programs allow you to refer to the classes of characters defined by these properties. For example, in Java \`\\p{Sm}\' matches any mathematical symbol.\n\n"];
    AppendToTextDisplay $po [_ "A list of the Unicode categories and their abbreviations is available under the \`Unicode General Character Properties\' on the \`Help\' menu. The classification of every character can be found in the file \`UnicodeData.txt\', which is distributed by the Unicode Consortium."];
    AppendToTextDisplay $po [_ "You can download a copy (approximately 950kb) here: "];
    AppendLinkToTextDisplay $po "UnicodeData.txt" {ShowWebPage http://www.unicode.org/Public/UNIDATA/UnicodeData.txt};
    AppendToTextDisplay $po [_ "\nIn Python this information is provided by the \`unicodedata\' module. Read the documentation: "];
    AppendLinkToTextDisplay $po "Python unicodedata module" {ShowWebPage http://www.python.org/doc/current/lib/module-unicodedata.html};
}

proc ExplainUnicodeRange {} {
    global HPWidth;
    global HPLines;
    global HelpPopups;
    if {[info exists HelpPopups(UnicodeRange)]} {
	if {[winfo exists $HelpPopups(UnicodeRange)]} {
	    destroy $HelpPopups(UnicodeRange);
	    return;
	}
    }
    set po [CreateTextDisplay [_ "Unicode Range"] $HPWidth $HPLines]
    BindKeys $po;
    set HelpPopups(UnicodeRange) $po;
    AppendToTextDisplay $po [_ "Unicode characters are divided into \`ranges\', such as \`Basic Latin\', \`Armenian\', \`Georgian\' and \`Nebrew\'. As these names suggest, \`ranges\' correspond roughly to writing systems. For example, the Tamil range contains the characters specific to Tamil. However, the correspondance is only approximate. Many languages use characters drawn from two or more ranges. For example, Tamil uses the letters in the Tamil range but spaces and punctuation from the Basic Latin range, while Japanese uses the several ranges containng Chinese characters plus the Hiragana and Katakana ranges and the Basic Latin range. Conversely, many ranges contain characters from more than one writing system. The Canadian Aboriginal Syllabics range, for example, combines the historically related but distinct writing systems of Cree, Inuktitut, Carrier and severalother languages. Unicode ranges are therefore useful for some purposes, but it is a mistake to assume that they can be used straightforwardly to identiy text in a particular writing system or language.\n\n"];
    AppendToTextDisplay $po [_ "A list of the Unicode ranges is available under \`Unicode Ranges\' on the \`Help\' menu. PDF files showing the contents of the various ranges may be downloaded from the Unicode Consortium: "];
    AppendLinkToTextDisplay $po "here" {ShowWebPage http://www.unicode.org/charts/PDF/};
    AppendToTextDisplay $po [_ " A list of ranges with links to web pages displaying the range and the above PDF files is available: "];
    AppendLinkToTextDisplay $po "here" {ShowWebPage http://www.ling.upenn.edu/courses/ling538/UnicodeRanges.html};
}

proc ExplainUnicodeName {} {
    global HPWidth;
    global HPLines;
    global HelpPopups;
    if {[info exists HelpPopups(UnicodeName)]} {
	if {[winfo exists $HelpPopups(UnicodeName)]} {
	    destroy $HelpPopups(UnicodeName);
	    return;
	}
    }
    set po [CreateTextDisplay [_ "Unicode Name"] $HPWidth $HPLines]
    BindKeys $po;
    set HelpPopups(UnicodeName) $po;
    AppendToTextDisplay $po [_ "Every Unicode character has an official name by which it is designated in the Unicode standard. One way to include an arbitrary Unicode character in a regular expression is to refer to it by this name. (The other is to refer to it by its code number.)\n\n"];
    AppendToTextDisplay $po [_ "A list of Unicode characters and their names can be found in the file \`NamesList.txt\', which is distributed by the Unicode Consortium."];
    AppendToTextDisplay $po [_ "You can download a copy (approximately 786k) here: "];
    AppendLinkToTextDisplay $po "NamesList.txt" {ShowWebPage http://www.unicode.org/Public/UNIDATA/NamesList.txt};
    AppendToTextDisplay $po [_ " However, this file does not illustrate the characters. If you need to look at examples of the characters to determine their names, you can consult the PDF files containing the sections of the Unicode standard devoted to the various ranges "];
    AppendLinkToTextDisplay $po "here" {ShowWebPage http://www.unicode.org/charts/PDF/};
    AppendToTextDisplay $po [_ " or you can use a character map program such as "];
    AppendLinkToTextDisplay $po "gucharmap" {ShowWebPage http://gucharmap.sourceforge.net/}
    AppendToTextDisplay $po [_ " You can also look at the characters as they are rendered by your browser on pages such as "];
    AppendLinkToTextDisplay $po "these" {ShowWebPage http://www.ling.upenn.edu/courses/ling538/UnicodeCharts/UnicodeIndex.html}
    AppendToTextDisplay $po [_ " (The computer program used to generate these pages is available "];
    AppendLinkToTextDisplay $po "here" {ShowWebPage http://www.billposer.org/Software/software.html#unicodechart}
    AppendToTextDisplay $po [_ ") You can then use the NamesList to convert from codepoint to name."];
}

proc ExplainWhitespace {} {
    global HPWidth;
    global HPLines;
    global HelpPopups;
    if {[info exists HelpPopups(Whitespace)]} {
	if {[winfo exists $HelpPopups(Whitespace)]} {
	    destroy $HelpPopups(Whitespace);
	    return;
	}
    }
    set po [CreateTextDisplay [_ "Whitespace"] $HPWidth $HPLines]
    BindKeys $po;
    set HelpPopups(Whitespace) $po;
    AppendToTextDisplay $po [_ "\`Whitespace\' traditionally refers to the ASCII characters: space (0x0020), tab (0x0009), vertical tab (0x000B), newline/linefeed (0x000A), carriage return (0x000D), and formfeed (0x000C). Vertical tab and formfeed will of course rarely be encountered in normal text. Carriage return and linefeed are generally encountered only as end-of-line markers (on Unix systems, linefeed alone, on Macintosh systems, carriage return alone, and on DOS and MS Windows systems, carriage return followed by linefeed). When working with line-oriented software, then, in practice \`whitespace\' will usually refer to just space and (horizontal) tab. Outside of the ASCII range, however, there are other characters that may be considered whitespace, such as 0x3000 IDEOGRAPHIC SPACE, which is commonly found in Japanese text. Whether these other characters are included depends on the locale."];
    AppendToTextDisplay $po "\n"
    AppendToTextDisplay $po [_ "For details on the POSIX character classes, including\
an ASCII chart color-coded for the POSIX classes, see the reference manual section "];
    set url [PathToFileURL [file join $::ManualDirectory builtincharclass.html]]
    AppendLinkToTextDisplay $po "Builtin Character Classes" [list ShowWebPage $url]
    AppendToTextDisplay $po ".\n"
}


proc ExplainBell {} {
    global HPWidth;
    global HPLines;
    global HelpPopups;
    if {[info exists HelpPopups(Bell)]} {
	if {[winfo exists $HelpPopups(Bell)]} {
	    destroy $HelpPopups(Bell);
	    return;
	}
    }
    set po [CreateTextDisplay [_ "Bell"] $HPWidth $HPLines]
    BindKeys $po;
    set HelpPopups(Bell) $po;
    AppendToTextDisplay $po [_ "The bell character, ASCII 0x07, is a non-printing character that used to ring the bell on teletype machines. On modern computers it will generally make a bell-like sound. On some systems it may be redefined to attract attention in some other way, such as by flashing the screen."];
}

proc ExplainASCIIChar {} {
    global HPWidth;
    global HPLines;
    global HelpPopups;
    if {[info exists HelpPopups(ASCIIChar)]} {
	if {[winfo exists $HelpPopups(ASCIIChar)]} {
	    destroy $HelpPopups(ASCIIChar);
	    return;
	}
    }
    set po [CreateTextDisplay [_ "ASCII Character"] $HPWidth $HPLines]
    BindKeys $po;
    set HelpPopups(ASCIIChar) $po;
    AppendToTextDisplay $po [_ "This matches any ASCII character. An ASCII character is one of the 128 characters defined in the American Standard for Computer Information Interchange. The international equivalent is ISO 646. The ASCII characters consist of the 26 letters used in English, upper- and lower-case, the digits 0-9, 32 punctuation symbols, 33 control characters, most of which are not used in text, and the space character. The first 128 characters of Unicode are the same as in ASCII."];
    AppendToTextDisplay $po [_ "\n\n"];
    AppendToTextDisplay $po [_ "ASCII charts are widely available. On any UNIX system the command \`man 7 ascii\' should produce an ASCII chart. Charts may be found on the web at locations including:"];
    AppendLinkToTextDisplay $po "here, " {ShowWebPage http://www.jimprice.com/jim-asc.htm}
    AppendLinkToTextDisplay $po "here, " {ShowWebPage http://www.ling.upenn.edu/courses/ling538/ascii.html}
    AppendLinkToTextDisplay $po "here, " {ShowWebPage http://ostermiller.org/calc/ascii.html}
    AppendLinkToTextDisplay $po "and here." {ShowWebPage http://www.asciitable.com}
    AppendToTextDisplay $po [_ "\n"];
     AppendToTextDisplay $po [_ "An ASCII chart color-coded for the POSIX character classes is included in the reference manual section "];
    set url [PathToFileURL [file join $::ManualDirectory builtincharclass.html]]
    AppendLinkToTextDisplay $po "Builtin Character Classes" [list ShowWebPage $url]
    AppendToTextDisplay $po "\n"
}

proc ExplainTaggedgroup {} {
    global HPWidth;
    global HPLines;
    global HelpPopups;
    if {[PopupDown TaggedGroup] ==1} {return}
    set po [CreateTextDisplay [_ "Tagged Group"] $HPWidth $HPLines]
    BindKeys $po;
    set HelpPopups(Taggedgroup) $po;
    AppendToTextDisplay $po [_ "Tagged groups provide a more mnemonic way to refer to subexpressions. Traditionally, capture groups can be identified only by their position: one specifies the first group, the third, or whatever. Tagged groups associate an identifier with each group. Backreferences may then be made using this identifier."];
}

proc ExplainTaggedBackReference {} {
    global HPWidth;
    global HPLines;
    global HelpPopups;
    if {[PopupDown TaggedBackReference] ==1} {return}
    set po [CreateTextDisplay [_ "Tagged Group Backreference"] $HPWidth $HPLines]
    BindKeys $po;
    set HelpPopups(TaggedBackReference) $po;
    AppendToTextDisplay $po [_ "This matches the preceding group with the same tag."];
}

proc ExplainEndOfString {} {
    global HPWidth;
    global HPLines;
    global HelpPopups;
    if {[PopupDown EndOfString] ==1} {return}
    set po [CreateTextDisplay [_ "End Of String"] $HPWidth $HPLines]
    BindKeys $po;
    set HelpPopups(EndOfString) $po;
    AppendToTextDisplay $po [_ "This matches the end of the string. Some regular expression matchers consider it to match only at the abolute end of the string. Others will ignore a terminating end-of-line marker."];
    AppendToTextDisplay $po [_ "\n\n"];
    AppendToTextDisplay $po [_ "If you find that patterns ending in end-of-string fail to match at the ends of lines, the problem may be the presence of end-of-line markers. This can arise in several ways. First, if you are reading data from a file line by line, readline functions vary as to whether or not they include the end-of-line marker at the end of the string. If they do, and if the regular expression matcher you are using is one in which a character is not considered to be at the end of the string if it is followed by end-of-line characters, what appears to you to be the last character in the string will not be treated as such. Second, if your data come from a DOS or MS Windows system in which end-of-line is marked by the sequence Carriage Return-Line Feed (0x0D 0x0A) and you are using a Unix system and no translation to native text format is done, even if your readline function strips the Line Feed, it will leave the Carriage Return, which from its point of view is not part of the end-of-line marker. The regular expression matcher will treat the Carriage Return as an ordinary character and so will not consider the character preceding it to be at the end of the string."];
    AppendToTextDisplay $po [_ "\n"];

}
proc ExplainAbsoluteEndOfString {} {
    global HPWidth;
    global HPLines;
    global HelpPopups;
    if {[PopupDown EndOfString] ==1} {return}
    set po [CreateTextDisplay [_ "Absolute End Of String"] $HPWidth $HPLines]
    BindKeys $po;
    set HelpPopups(EndOfString) $po;
    AppendToTextDisplay $po [_ "This matches the end of the string. Some regular expression matchers consider it to match only at the abolute end of the string. Others will ignore a terminating end-of-line marker."];
    AppendToTextDisplay $po [_ "\n\n"];
    AppendToTextDisplay $po [_ "If you find that patterns ending in end-of-string fail to match at the ends of lines, the problem may be the presence of end-of-line markers. This can arise in several ways. First, if you are reading data from a file line by line, readline functions vary as to whether or not they include the end-of-line marker at the end of the string. If they do, and if the regular expression matcher you are using is one in which a character is not considered to be at the end of the string if it is followed by end-of-line characters, what appears to you to be the last character in the string will not be treated as such. Second, if your data come from a DOS or MS Windows system in which end-of-line is marked by the sequence Carriage Return-Line Feed (0x0D 0x0A) and you are using a Unix system and no translation to native text format is done, even if your readline function strips the Line Feed, it will leave the Carriage Return, which from its point of view is not part of the end-of-line marker. The regular expression matcher will treat the Carriage Return as an ordinary character and so will not consider the character preceding it to be at the end of the string."];
    AppendToTextDisplay $po [_ "\n"];

}


proc ExplainTab {} {
    global HPWidth;
    global HPLines;
    if {[PopupDown Tab] ==1} {return}
    set po [CreateTextDisplay [_ "Tab"] $HPWidth $HPLines]
    BindKeys $po;
    set ::HelpPopups(Tab) $po;
    AppendToTextDisplay $po [_ "This matches the horizontal tab character (0x09)."];
}

proc ExplainBlank {} {
    global HPWidth;
    global HPLines;
    global HelpPopups;
    if {[PopupDown Blank] ==1} {return}
    set po [CreateTextDisplay [_ "Blank"] $HPWidth $HPLines]
    BindKeys $po;
    set HelpPopups(Blank) $po;
    AppendToTextDisplay $po [_ "The Blank class consists of just space (0x20) and horizontal tab (0x09). It is a subset of Whitespace. In some locales it may contain equivalent characters from other ranges, such as 0x3000 Ideographic Space, which is used in Chinese, Japanese, and Korean."];
    AppendToTextDisplay $po "\n"
    AppendToTextDisplay $po [_ "For details on the POSIX character classes, including\
an ASCII chart color-coded for the POSIX classes, see the reference manual section "];
    set url [PathToFileURL [file join $::ManualDirectory builtincharclass.html]]
    AppendLinkToTextDisplay $po "Builtin Character Classes" [list ShowWebPage $url]
    AppendToTextDisplay $po ".\n"
}

proc ExplainGroup {} {
    global HPWidth;
    global HPLines;
    global HelpPopups;
    if {[PopupDown Group] ==1} {return}
    set po [CreateTextDisplay [_ "Group"] $HPWidth $HPLines]
    BindKeys $po;
    set HelpPopups(Group) $po;
    AppendToTextDisplay $po [_ "Group notation serves two purposes.\
First, it groups together characters to which an\
operator such as a quantifier should apply as a unit. For example, in matchers\
in which + means \`one or more repetitions of the preceding group\', \
\`(ab)+\' matches \`ab\', \`abab\', \`ababab\', etc., whereas \`ab+\' matches\
\`ab\', \`abb\', \`abbb\', etc. Secondly, it creates subexpressions which can\
be referred to by  later portions of the same regular expression or by\
a substitution expression. For example, in matchers in which the expression\
\`(\\d{5})(-\\d{4})?)\' matches US zip codes consisting of five digits optionally\
followed by a hyphen and four digits, the parentheses create the possibility\
of backreferences to the two components of long form zip codes. A substitution\
could replace the input with just the first component, thereby converting\
any well-formed zip code into the short form. Groups that serve this second\
function are called \`capture groups\' to differentiate them from\
the \`no capture groups\' that some matchers provide, which are ignored for\
the purpose of back-references."];}

proc ExplainNoCaptureGroup {} {
    global HPWidth;
    global HPLines;
    global HelpPopups;
    if {[PopupDown NoCaptureGroup] ==1} {return}
    set po [CreateTextDisplay [_ "No Capture Group"] $HPWidth $HPLines]
    BindKeys $po;
    set HelpPopups(NoCaptureGroup) $po;
    AppendToTextDisplay $po [_ "A no capture group is like an ordinary group in that it\
groups together characters to which an operator such as a quantifier\
should apply as a unit. It differs from an ordinary group in that\
it does not create a target for backreferences. For example, in a\
matcher in which \`(abc)\' is an ordinary group, \`(?:abc)\' is a no\
capture group,  and back references are of the form\
\`\\k\', the regular expression \`(ab)(?:cd)(ef)\\2\\1\'\
will match \`abcdefefab\', not \`abcdefcdab\'. Since\
\`cd\' is in a no capture group, it is ignored by backreferences."]}

proc ExplainBackReferenceMatch {} {
    global HPWidth;
    global HPLines;
    global HelpPopups;
    if {[PopupDown BackReferenceMatch] ==1} {return}
    set po [CreateTextDisplay [_ "Match BackReference"] $HPWidth $HPLines]
    BindKeys $po;
    set HelpPopups(BackReferenceMatch) $po;
    AppendToTextDisplay $po [_ "This matches whatever was matched by the corresponding\
capture group. For example, in a matcher in which bare parentheses delimit capture groups\
and in which the notation for back reference is of the form \`\\k\', the expression\
\`(..)-\\1\'  matches any string consisting of two characters, a hyphen, and the same\
two characters, such as\`ab-ab\', \`fa-fa\', or \`oh-oh\'. "];
    if {$::Features([WhichMatchBackReference]AtLeastTen,$::program,$::Locale) == 0} {
	AppendToTextDisplay $po "\n\n";
	AppendToTextDisplay $po "The back reference index must be no greater than 9.";
    }
}


#Returns the name of the match back reference feature that
#is available for the current program and locale, or the empty string
#if there is none.
proc WhichMatchBackReference {} {
    foreach x  [list \
		    backref\
		    backrefdbs\
		    backrefper\
		    backrefbsall\
		    backrefksh\
		    backrefdbsall] {
	if {$::Features($x,$::program,$::Locale)} {
	    return $x;
	}
    }
    return "";
}

proc PopupDown {n} {
    global HelpPopups;
    if {[info exists HelpPopups($n)]} {
	if {[winfo exists $HelpPopups($n)]} {
	    destroy $HelpPopups($n);
	    return 1;
	}
    }
    return 0;
}

proc ExplainStarNext {} {
    global HPWidth;
    global HPLines;
    global HelpPopups;
    if {[PopupDown StarNext] ==1} {return}
    set po [CreateTextDisplay [_ "Star Next"] $HPWidth $HPLines]
    BindKeys $po;
    set HelpPopups(StarNext) $po;
    AppendToTextDisplay $po [_ "This expression matches zero or more occurences of the parenthesized group."];
}

proc ExplainPlusNext {} {
    global HPWidth;
    global HPLines;
    global HelpPopups;
    if {[PopupDown PlusNext] ==1} {return}
    set po [CreateTextDisplay [_ "Plus Next"] $HPWidth $HPLines]
    BindKeys $po;
    set HelpPopups(PlusNext) $po;
    AppendToTextDisplay $po [_ "This expression matches one or more occurences of the parenthesized group."];
}

proc ExplainZeroOneQMarkNext {} {
    global HPWidth;
    global HPLines;
    global HelpPopups;
    if {[PopupDown ZeroOneQMarkNext] ==1} {return}
    set po [CreateTextDisplay [_ "Question Mark Next"] $HPWidth $HPLines]
    BindKeys $po;
    set HelpPopups(ZeroOneQMarkNext) $po;
    AppendToTextDisplay $po [_ "This expression matches zero or one occurences of the parenthesized group."];
}

proc ExplainAtSignOneNext {} {
    global HPWidth;
    global HPLines;
    global HelpPopups;
    if {[PopupDown AtSignOneNext] ==1} {return}
    set po [CreateTextDisplay [_ "At Sign Next"] $HPWidth $HPLines]
    BindKeys $po;
    set HelpPopups(AtSignOneNext) $po;
    AppendToTextDisplay $po [_ "This expression matches exactly one expression from the parenthesized group. If the group is non-compound, it matches the parenthesized group. If the group contains alternatives, it matches any one of them."];
}

proc ExplainGroupComplement {} {
    global HPWidth;
    global HPLines;
    global HelpPopups;
    if {[PopupDown GroupComplement] ==1} {return}
    set po [CreateTextDisplay [_ "Group Complement"] $HPWidth $HPLines]
    BindKeys $po;
    set HelpPopups(GroupComplement) $po;
    AppendToTextDisplay $po [_ "This expression matches anything that does not match the parenthesized group."];
}
proc ExplainObligatoryQuantifierGroup {} {
    global HPWidth;
    global HPLines;
    global HelpPopups;
    if {[PopupDown ObligatoryQuantifierGroup] ==1} {return}
    set po [CreateTextDisplay [_ "Obligatorily Quantified Group"] $HPWidth $HPLines]
    BindKeys $po;
    set HelpPopups(ObligatoryQuantifierGroup) $po;
    AppendToTextDisplay $po [_ "The material within parentheses is treated as a group. The opening parenthesis must be preceded by one of the quantifiers: ?,+,*,@, or !. The parenthesized material may be a simple string, e.g. (abc) or it may be an alternative expression consisting of strings or quantified groups separated by | symbols, For example, the expression @(ab|cd) matches the strings ab and cd. The expression +(ab|cd|ef) matches strings including ab, cd, ef, abcd, cdef, abcdef, and cdabefab. It does not match bc, de, or abcde. The expression @(abc|*(cd)) matches the null string and the strings abc,cd,cdcd,cdcdcd, etc."];
    AppendToTextDisplay $po "\n\n"
    AppendToTextDisplay $po [_ "These groups may be referred to by backreferences. The difference between the expressions @(abc) and abc is that the former creates a capture group to which a backreference may refer whereas the latter does not."]
}


proc ExplainNCopies {} {
    global HPWidth;
    global HPLines;
    global HelpPopups;
    if {[PopupDown NCopies] ==1} {return}
    set po [CreateTextDisplay [_ "N Copies"] $HPWidth $HPLines]
    BindKeys $po;
    set HelpPopups(NCopies) $po;
    AppendToTextDisplay $po [_ "This matches exactly N copies of the immediately\
preceding group. For example, \`b{3}\' matches \`bbb\' but\
not \`bb\'. This notation is a special case of the more general\
\`from M to N copies\' construction."];
}

proc ExplainMNAtLeast {} {
    global HPWidth;
    global HPLines;
    global HelpPopups;
    if {[PopupDown MNAtLeast] ==1} {return}
    set po [CreateTextDisplay [_ "At Least N Copies"] $HPWidth $HPLines]
    BindKeys $po;
    set HelpPopups(MNAtLeast) $po;
    AppendToTextDisplay $po [_ "This matches at least N copies of the immediately\
preceding group. For example, \`b{3,}\' matches \`bbb\'and \`bbbb\' but\
not \`bb\'. This notation is a special case of the more general\
\`from M to N copies\' construction."];
}

proc ExplainMNRange {} {
    global HPWidth;
    global HPLines;
    global HelpPopups;
    if {[PopupDown MNRange] ==1} {return}
    set po [CreateTextDisplay [_ "Match From M to N Copies"] $HPWidth $HPLines]
    BindKeys $po;
    set HelpPopups(MNRange) $po;
    AppendToTextDisplay $po [_ "This matches at least M copies and at most N copies\
of the immediately preceding group. For example,\
\`b{2,4}\' matches \`bb\', \'bbb\', and \`bbbb\' but not \`b\' or \`bbbbb\'"];
}

proc ExplainPunctuation {} {
    global HPWidth;
    global HPLines;
    global HelpPopups;
    if {[PopupDown Punctuation] ==1} {return}
    set po [CreateTextDisplay [_ "Punctuation"] $HPWidth $HPLines]
    BindKeys $po;
    set HelpPopups(Punctuation) $po;
    AppendToTextDisplay $po [_ {In the C locale and in purely ASCII systems, the punctuation class contains the 32 ASCII punctuation symbols: \
	    \" \# $ % & ' ( ) * + , - . / : ; < = > ? @ [ \\ ] ^ _ ` \{ | \} ~ \
In other locales, additional characters may be included and some of the ASCI\
characters may be excluded. Which characters fall into the punctuation class\
in a particular combination of program and locale is variable. Note that a common\
behavior is for programs to restrict the class to the ASCII characters in\
non-Unicode locales and to expand it to include all Unicode punctuation in\
Unicode locales, including punctuation that is not relevant to the locale.\
If the details matter to you, you should run tests to determine the membership\
of this class in your environment.}];
}

proc ExplainASCIIPunctuation {} {
    global HPWidth;
    global HPLines;
    global HelpPopups;
    if {[PopupDown ASCIIPunctuation] ==1} {return}
    set po [CreateTextDisplay [_ "ASCII Punctuation"] $HPWidth $HPLines]
    BindKeys $po;
    set HelpPopups(ASCIIPunctuation) $po;
    AppendToTextDisplay $po [_ {These sets are defined purely in terms of the ASCII\
punctuation set, which consists of the 32 characters:\
	! " \# $ % & ' ( ) * + , - . / : ; < = > ? @ [ \\ ] ^ _ ` \{ | \} ~ }];
}
# "

proc ExplainOctalCode {} {
    global HPWidth;
    global HPLines;
    global HelpPopups;
    if {[PopupDown OctalCode] ==1} {return}
    set po [CreateTextDisplay [_ "Octal Character Codes"] $HPWidth $HPLines]
    BindKeys $po;
    set HelpPopups(OctalCode) $po;
    AppendToTextDisplay $po [_ "\
It is traditional to give character codes and other numbers\
relevant to the internal operation of computers in octal, that is,\
base 8. The main reason for this is that it is convenient to use numbers\
that are integral powers of two because they are easily convertible\
into the binary (base two) representation that directly reflects the\
bit patterns in the computer's memory. More recently, numbers such as\
character codes have come to be given in hexadecimal (base 16)."];
    AppendToTextDisplay $po "\n\n"
    AppendToTextDisplay $po [_ "\
In octal, each place represents a power of 8 rather than a power\
of 10. For example, the number 61 in octal is equivalent to decimal\
49 because it represents (6*8)+(1*1). The same number in binary is\
110001, representing (1*32)+(1*16)+(0*8)+(0*4)+(0*2)+(1*1). Octal\
numbers are usually written with a leading 0 as an indication that\
they are octal."];
    AppendToTextDisplay $po "\n\n"
    AppendToTextDisplay $po [_ "\
It is useful to be able to refer to characters by their\
numerical codes when they have special meaning to the language\
which will process them or for some other reason cannot appear\
as such. For example, entering a newline character directly\
may disarrange your text or trigger a command that you do not\
want to trigger. Entering the numerical code for newline\
(012) allows you to refer to a newline and pass it on\
to another program or level of processing."];
}

proc ExplainDecimalCode {} {
    global HPWidth;
    global HPLines;
    global HelpPopups;
    if {[PopupDown DecimalCode] ==1} {return}
    set po [CreateTextDisplay [_ "Decimal Character Codes"] $HPWidth $HPLines]
    BindKeys $po;
    set HelpPopups(DecimalCode) $po;
    AppendToTextDisplay $po [_ "\
It is traditional to give character codes and other numbers\
relevant to the internal operation of computers in octal, that is,\
base 8. The main reason for this is that it is convenient to use numbers\
that are integral powers of two because they are easily convertible\
into the binary (base two) representation that directly reflects the\
bit patterns in the computer's memory. More recently, numbers such as\
character codes have come to be given in hexadecimal (base 16)."];
    AppendToTextDisplay $po "\n\n"
    AppendToTextDisplay $po "This program, however, lets you use decimal\
    (base 10, like ordinary numbers) character codes if you wish to."];
    AppendToTextDisplay $po "\n\n"
    AppendToTextDisplay $po [_ "\
It is useful to be able to refer to characters by their\
numerical codes when they have special meaning to the language\
which will process them or for some other reason cannot appear\
as such. For example, entering a newline character directly\
may disarrange your text or trigger a command that you do not\
want to trigger. Entering the numerical code for newline\
(012) allows you to refer to a newline and pass it on\
to another program or level of processing."];
}


proc ExplainHexCode {} {
    global HPWidth;
    global HPLines;
    global HelpPopups;
    if {[PopupDown HexCode] ==1} {return}
    set po [CreateTextDisplay [_ "Hexadecimal Character Codes"] $HPWidth $HPLines]
    BindKeys $po;
    set HelpPopups(HexCode) $po;
    AppendToTextDisplay $po [_ "\
Character codes and other numbers relevant to the internal operation\
of computers are usually given in hexadeciaml, that is, base 16.\
The main reason for this is that it is convenient to use numbers\
that are integral powers of two because they are easily convertible\
into the binary (base two) representation that directly reflects the\
bit patterns in the computer's memory."];
    AppendToTextDisplay $po "\n\n"
    AppendToTextDisplay $po [_ "\
In hexadecimal, each place represents a power of 16 rather than a power\
of 10. For example, the number 61 in hexadecimal is equivalent to decimal\
97 because it represents (6*16)+(1*1). The same number in binary is\
01100001, representing (1*64)+(1*32)+(0*16)+(0*8)+(0*4)+(0*2)+(1*1). Hexadecimal\
numbers are usually written with a leading 0x as an indication that\
they are hexadecimal. The digits greater than nine are written with the\
first six letters of the alphabet: a = 10, b = 11, and so on.\
Some programs accept either upper- or lower-case letters, while others\
insist on one or the other."];
    AppendToTextDisplay $po "\n\n"
    AppendToTextDisplay $po [_ "\
It is useful to be able to refer to characters by their\
numerical codes when they have special meaning to the language\
which will process them or for some other reason cannot appear\
as such. For example, entering a newline character directly\
may disarrange your text or trigger a command that you do not\
want to trigger. Entering the numerical code for newline\
(0x0A) allows you to refer to a newline and pass it on\
to another program or level of processing. Similarly, using\
numerical codes you can enter Unicode characters that you cannot\
enter by other means."];
}


proc ExplainEscape {} {
    global HPWidth;
    global HPLines;
    global HelpPopups;
    if {[PopupDown Escape] ==1} {return}
    set po [CreateTextDisplay [_ "Escape"] $HPWidth $HPLines]
    BindKeys $po;
    set HelpPopups(Escape) $po;
    AppendToTextDisplay $po [_ "
\`Escape\', ASCII/Unicode 0x1B, is not found in normal text. Its usual use\
is to send commands and messages to teletypes, terminals, and other such devices.\
It alerts the device that the next character is not to be interpreted as a\
normal character but rather is a code representing a special command.\
It is called \`Escape\' because it provides for an escape from the standard\
interpretation of the character codes. On most keyboards, the key labelled \`Esc\'
generates this character code."];
}

proc ExplainCarriageReturn {} {
    global HPWidth;
    global HPLines;
    global HelpPopups;
    if {[PopupDown CarriageReturn] ==1} {return}
    set po [CreateTextDisplay [_ "Carriage Return"] $HPWidth $HPLines]
    BindKeys $po;
    AppendToTextDisplay $po [_ "Carriage Return (0x0D) is one of the characters used to\
mark end-of-line. On Unix systems, end-of-line is marked by Newline (0x0A). On Macintoshen,\
end-of-lineis marked by Carriage Return. On DOS and MS Windows sytems, end-of-line is\
marked by the sequence of Carriage Return followed by Newline."];
}

proc ExplainComment {} {
    global HPWidth;
    global HPLines;
    global HelpPopups;
    if {[PopupDown Comment] ==1} {return}
    set po [CreateTextDisplay [_ "Comment"] $HPWidth $HPLines]
    BindKeys $po;
    set HelpPopups(Comment) $po;
    AppendToTextDisplay $po [_ "Some matchers use this notation to allow you to\
put comments and whitespace inside regular expressions. A comment consists of whatever text\
you would like to insert. It is there only for the benefit of people reading the program.\
It has no effect on the match. Comments begin with a crosshatch (\#) and continue until\
the end of the line. If this flag is set whitespace within the regular expression is\
ignored. This provides greater freedom in laying out the regular expression. This is\
especially useful if you are preparing teaching materials or if the regular expression is\
complex or obscure and therefore deserves explication."];
}

proc ExplainCaseInsensitive {} {
    global HPWidth;
    global HPLines;
    global HelpPopups;
    if {[PopupDown CaseInsensitive] ==1} {return}
    set po [CreateTextDisplay [_ "Case Insensitive Comparison"] $HPWidth $HPLines]
    BindKeys $po;
    set HelpPopups(CaseInsensitiveP) $po;
    AppendToTextDisplay $po [_ "A comparison is case-sensitive if two strings\
differeing only in the case of one or more characters are considered\
different. If two strings differing only in case are considered the same, the\
comparison is case-insensitive. Case-insensitive matching can always be arranged\
by using disjunctions of upper- and lower-case pairs, e.g. \[Cc\]\[Aa\]\[Tt\], but this is\
tedious, so many matchers provide a flag for requesting case-insensitive matching.\
Matchers that support this notation allow you to set this flag from within the\
regular expression."];
    AppendToTextDisplay $po "\n\n"
    if {$::Features(FlagWideScope,$::program,$::Locale)} {
	AppendToTextDisplay $po "This flag has scope over the entire expression, including anything that precedes it."
    } else {
	AppendToTextDisplay $po "This flag takes effect where it is placed and remains in force until the end of the expression, the end of the group, or a countervailing flag."
    }
    if {!$::Features(flagiNonAsciiLiteral,$::program,$::Locale)} {
	AppendToTextDisplay $po "\n\n"
	AppendToTextDisplay $po [_ "This flag affects only the ASCII characters."]
	if {!$::Features(flagiAsciiClass,$::program,$::Locale)} {
	    AppendToTextDisplay $po "\n\n"
	    AppendToTextDisplay $po [_ "It has no effect on builtin character classes."]
	} else {
	    if {!$::Features(flagiAsciiClassSymmetric,$::program,$::Locale)} {
		AppendToTextDisplay $po "\n\n"
		AppendToTextDisplay $po [_ "It affects builtin character classes asymmetrically."];
		AppendToTextDisplay $po [_ "It makes upper-case characters match \[:lower:\] but it does not make lower-case characters match \[:upper:\]"];
	    }
	}
    } else {
	if {!$::Features(flagiAsciiClass,$::program,$::Locale)} {
	    AppendToTextDisplay $po "\n\n"
	    AppendToTextDisplay $po [_ "It has no effect on builtin character classes."];
	} else {
	    if {!$::Features(flagiNonAsciiClass,$::program,$::Locale)} {
		AppendToTextDisplay $po "\n\n"
		AppendToTextDisplay $po [_ "It has no effect on builtin character classes outside the ASCII range."];
	    } else {
		if { (!$::Features(flagiAsciiClassSymmetric,$::program,$::Locale)) && \
			 (!$::Features(flagiNonAsciiClassSymmetric,$::program,$::Locale))} {
		    AppendToTextDisplay $po "\n\n"
		    AppendToTextDisplay $po [_ "It affects builtin character classes asymmetrically."];
		    AppendToTextDisplay $po [_ "It makes upper-case characters match \[:lower:\] but it does not make lower-case characters match \[:upper:\]"];
		} else {
		    if {$::Features(flagiAsciiClassSymmetric,$::program,$::Locale)} {
			AppendToTextDisplay $po "\n\n"
			AppendToTextDisplay $po [_ "It affects builtin character classes asymmetrically outside the ASCII range."];
			AppendToTextDisplay $po [_ "It makes upper-case characters match \[:lower:\] but it does not make lower-case characters match \[:upper:\]"];
		    }
		}
	    }
	}
    }
}

proc ExplainCaseInsensitiveIU {} {
    global HPWidth;
    global HPLines;
    global HelpPopups;
    if {[PopupDown CaseInsensitiveIU] ==1} {return}
    set po [CreateTextDisplay [_ "Unicode Case Insensitive Comparison"] $HPWidth $HPLines]
    BindKeys $po;
    set HelpPopups(CaseInsensitiveIU) $po;
    AppendToTextDisplay $po [_ "A comparison is case-sensitive if two strings\
differeing only in the case of one or more characters are considered\
different. If two strings differing only in case are considered the same, the\
comparison is case-insensitive. Case-insensitive matching can always be arranged\
by using disjunctions of upper- and lower-case pairs, e.g. \[Cc\]\[Aa\]\[Tt\], but this is\
tedious, so many matchers provide a flag for requesting case-insensitive matching.\
Matchers that support this notation allow you to set this flag from within the\
regular expression."];
    AppendToTextDisplay $po "\n\n"
    if {$::Features(FlagWideScope,$::program,$::Locale)} {
	AppendToTextDisplay $po "This flag has scope over the entire expression, including anything that precedes it."
    } else {
	AppendToTextDisplay $po "This flag takes effect where it is placed and remains in force until the end of the expression, the end of the group, or a countervailing flag."
    }
    if {!$::Features(flagiuNonAsciiLiteral,$::program,$::Locale)} {
	AppendToTextDisplay $po "\n\n"
	AppendToTextDisplay $po [_ "This flag affects only the ASCII characters."]
	if {!$::Features(flagiAsciiClass,$::program,$::Locale)} {
	    AppendToTextDisplay $po "\n\n"
	    AppendToTextDisplay $po [_ "It has no effect on builtin character classes."]
	} else {
	    if {!$::Features(flagiAsciiClassSymmetric,$::program,$::Locale)} {
		AppendToTextDisplay $po "\n\n"
		AppendToTextDisplay $po [_ "It affects builtin character classes asymmetrically."];
		AppendToTextDisplay $po [_ "It makes upper-case characters match \[:lower:\] but it does not make lower-case characters match \[:upper:\]"];
	    }
	}
    } else {
	if {!$::Features(flagiAsciiClass,$::program,$::Locale)} {
	    AppendToTextDisplay $po "\n\n"
	    AppendToTextDisplay $po [_ "It has no effect on builtin character classes."];
	} else {
	    if {!$::Features(flagiuNonAsciiClass,$::program,$::Locale)} {
		AppendToTextDisplay $po "\n\n"
		AppendToTextDisplay $po [_ "It has no effect on builtin character classes outside the ASCII range."];
	    } else {
		if { (!$::Features(flagiAsciiClassSymmetric,$::program,$::Locale)) && \
			 (!$::Features(flagiuNonAsciiClassSymmetric,$::program,$::Locale))} {
		    AppendToTextDisplay $po "\n\n"
		    AppendToTextDisplay $po [_ "It affects builtin character classes asymmetrically."];
		    AppendToTextDisplay $po [_ "It makes upper-case characters match \[:lower:\] but it does not make lower-case characters match \[:upper:\]"];
		} else {
		    if {$::Features(flagiAsciiClassSymmetric,$::program,$::Locale)} {
			AppendToTextDisplay $po "\n\n"
			AppendToTextDisplay $po [_ "It affects builtin character classes asymmetrically outside the ASCII range."];
			AppendToTextDisplay $po [_ "It makes upper-case characters match \[:lower:\] but it does not make lower-case characters match \[:upper:\]"];
		    }
		}
	    }
	}
    }
}

proc ExplainVisible {} {
    global HPWidth;
    global HPLines;
    global HelpPopups;
    if {[PopupDown Visible] ==1} {return}
    set po [CreateTextDisplay [_ "Visible ASCII Characters - Graph and Print"] $HPWidth $HPLines]
    BindKeys $po;
    set HelpPopups(Visible) $po;
    AppendToTextDisplay $po [_ "\
The POSIX standard defines two similar classes of \`visible\' chracters.\
The category \`graph\' may be defined as the set of characters that leave\
ink on the page. Within the ASCII character set, this means the classes\
\`alpha\', \`digit\', and \`punct\'. It does not include the space character.\
The complement of this class therefore consists of the control characters\
and the space character."];
    AppendToTextDisplay $po "\n\n"
    AppendToTextDisplay $po [_ "\
The category \`print\' consists of all characters other than the control\
characters. In ASCII, this means that the only difference between \`graph\'\
and \`print\' is that the latter includes the space character."]
    AppendToTextDisplay $po "\n\n"
    AppendToTextDisplay $po [_ "Some documentation, both printed and on the web,\
incorrectly describes\`graph\' and \`print\' as identical. They are not."];
    AppendToTextDisplay $po "\n\n"
    AppendToTextDisplay $po [_ "For details on the POSIX character classes, including\
an ASCII chart color-coded for the POSIX classes, see the reference manual section "];
    set url [PathToFileURL [file join $::ManualDirectory builtincharclass.html]]
    AppendLinkToTextDisplay $po "Builtin Character Classes" [list ShowWebPage $url]
    AppendToTextDisplay $po ".\n"
}

proc ExplainIntersection {} {
    global HPWidth;
    global HPLines;
    global HelpPopups;
    if {[PopupDown Intersection] ==1} {return}
    set po [CreateTextDisplay [_ "Intersection"] $HPWidth $HPLines]
    BindKeys $po;
    set HelpPopups(Intersection) $po;
    AppendToTextDisplay $po [_ "\
This notation represents the intersection of two character classes, that is,\
the characters that belong to both classes.\
This is a recent innovation that most matchers do not provide."]
    AppendToTextDisplay $po "\n\n";
    AppendToTextDisplay $po [_ "Note that Redet provides a facility for intersecting\
user-defined character classes\
that does not depend on the ability of the regular expression matcher to\
do so."];
}


proc ExplainInsertPostMatch {} {
    global HPWidth;
    global HPLines;
    global HelpPopups;
    if {[PopupDown InsertPostMatch] ==1} {return}
    set po [CreateTextDisplay [_ "Insert the Portion Following the Match"] $HPWidth $HPLines]
    BindKeys $po;
    set HelpPopups(InsertPostMatch) $po;
    AppendToTextDisplay $po [_ "In matchers that treat a string as matching a\
regular expression if some substring\
matches, the match may be regarded as splitting the string into three parts: the\
substring that actually matched, the part of the string preceding the substring\
that matched, and the part of the string following the substring that matched.\
For example, if the regular expression is \`ment\' and the input string is\
\`segmentally\', the substring that actually matches is \`ment\', the\
prefix is \`seg\', and the suffix is \`ally\'.\
This notation stands for the suffix to the matching substring."];
}

proc ExplainInsertPreMatch {} {
    global HPWidth;
    global HPLines;
    global HelpPopups;
    if {[PopupDown InsertPreMatch] ==1} {return}
    set po [CreateTextDisplay [_ "Insert the Portion Preceding the Match"] $HPWidth $HPLines]
    BindKeys $po;
    set HelpPopups(InsertPreMatch) $po;
    AppendToTextDisplay $po [_ "In matchers that treat a string as matching a\
regular expression if some substring\
matches, the match may be regarded as splitting the string into three parts: the\
substring that actually matched, the part of the string preceding the substring\
that matched, and the part of the string following the substring that matched.\
For example, if the regular expression is \`ment\' and the input string is\
\`segmentally\', the substring that actually matches is \`ment\', the\
prefix is \`seg\', and the suffix is \`ally\'.\
This notation stands for the prefix to the matching substring."];
}

proc ExplainInsertEntireMatch {} {
    global HPWidth;
    global HPLines;
    global HelpPopups;
    if {[PopupDown InsertEntireMatch] ==1} {return}
    set po [CreateTextDisplay [_ "Insert Entire Match"] $HPWidth $HPLines]
    BindKeys $po;
    set HelpPopups(InsertEntireMatch) $po;
    AppendToTextDisplay $po [_ "This notation inserts into the substitution\
a copy of the entire match to the\
regular expression. It is useful when the purpose of the operation is not\
to change the matched text but to add to it in a conditional way.\
For example, if we wanted to make a list of all of the stems that occur\
with the prefix \`pre\' and the suffix \`al\' we might (using Perl notation)\
use the regular expression \`^(pre)(.*)(al)\$\' and the substitution\
expression \`\$2\\t$&\', which inserts a copy of the second captured group,\
a tab, and a copy of the entire match. The result would be two columns, first the stem,\
then the entire word."];
    AppendToTextDisplay $po [_ "For further information on substitution backreferences see: \n"]
    AppendLinkToTextDisplay $po [_ "Substitution Backreferences."] {ExplainBackReferenceSub};
}

proc ExplainUpperCaseASCIILetter {} {
    global HPWidth;
    global HPLines;
    global HelpPopups;
    if {[PopupDown UpperCaseASCIILetter] ==1} {return}
    set po [CreateTextDisplay [_ "Upper Case ASCII Letter"] $HPWidth $HPLines]
    BindKeys $po;
    set HelpPopups(UpperCaseASCIILetter) $po;
    AppendToTextDisplay $po [_ "The class of upper case ASCII letters consists of the \
26 letters: A,B,C,D,E,F,G,H,I,J,K,L,M,N,O,P,Q,R,S,T,U,V,W,X,Y,Z"];
    AppendToTextDisplay $po "\n\n"
    AppendToTextDisplay $po [_ "For details on the POSIX character classes, including\
an ASCII chart color-coded for the POSIX classes, see the reference manual section "];
    set url [PathToFileURL [file join $::ManualDirectory builtincharclass.html]]
    AppendLinkToTextDisplay $po "Builtin Character Classes" [list ShowWebPage $url]
    AppendToTextDisplay $po ".\n"
}

proc ExplainUpperCaseLetter {} {
    global HPWidth;
    global HPLines;
    global HelpPopups;
    if {[PopupDown UpperCaseLetter] ==1} {return}
    set po [CreateTextDisplay [_ "Upper Case Letter"] $HPWidth $HPLines]
    BindKeys $po;
    set HelpPopups(UpperCaseLetter) $po;
    AppendToTextDisplay $po [_ "The class of upper case letters, including not only the \
ASCII letters A, B, C, etc. but upper-case letters in other writing systems that have \
a case distinction, such as Armenian, Cyrillic, and Greek."];
    AppendToTextDisplay $po "\n\n"
    AppendToTextDisplay $po [_ "For details on the POSIX character classes, including\
an ASCII chart color-coded for the POSIX classes, see the reference manual section "];
    set url [PathToFileURL [file join $::ManualDirectory builtincharclass.html]]
    AppendLinkToTextDisplay $po "Builtin Character Classes" [list ShowWebPage $url]
    AppendToTextDisplay $po ".\n"
}

proc ExplainLowerCaseASCIILetter {} {
    global HPWidth;
    global HPLines;
    global HelpPopups;
    if {[PopupDown LowerCaseASCIILetter] ==1} {return}
    set po [CreateTextDisplay [_ "Lower Case ASCII Letter"] $HPWidth $HPLines]
    BindKeys $po;
    set HelpPopups(LowerCaseASCIILetter) $po;
    AppendToTextDisplay $po [_ "The class of lower case ASCII letters consists of the \
26: letters a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q,r,s,t,u,v,w,x,y,z"];
    AppendToTextDisplay $po "\n\n"
    AppendToTextDisplay $po [_ "For details on the POSIX character classes, including\
an ASCII chart color-coded for the POSIX classes, see the reference manual section "];
    set url [PathToFileURL [file join $::ManualDirectory builtincharclass.html]]
    AppendLinkToTextDisplay $po "Builtin Character Classes" [list ShowWebPage $url]
    AppendToTextDisplay $po ".\n"
}

proc ExplainLowerCaseLetter {} {
    global HPWidth;
    global HPLines;
    global HelpPopups;
    if {[PopupDown LowerCaseLetter] ==1} {return}
    set po [CreateTextDisplay [_ "Lower Case Letter"] $HPWidth $HPLines]
    BindKeys $po;
    set HelpPopups(LowerCaseLetter) $po;
    AppendToTextDisplay $po [_ "The class of lower case letters, including not only the \
ASCII letters a, b, c, etc. but lower-case letters in other writing systems that have \
a case distinction, such as Armenian, Cyrillic, and Greek."];
    AppendToTextDisplay $po "\n\n"
    AppendToTextDisplay $po [_ "For details on the POSIX character classes, including\
an ASCII chart color-coded for the POSIX classes, see the reference manual section "];
    set url [PathToFileURL [file join $::ManualDirectory builtincharclass.html]]
    AppendLinkToTextDisplay $po "Builtin Character Classes" [list ShowWebPage $url]
    AppendToTextDisplay $po ".\n"
}

proc ExplainMustPair {} {
    global HPWidth;
    global HPLines;
    global HelpPopups;
    if {[PopupDown MustPair] ==1} {return}
    set po [CreateTextDisplay [_ "Paired Character Sets"] $HPWidth $HPLines]
    BindKeys $po;
    set HelpPopups(MustPair) $po;
    AppendToTextDisplay $po [_ {Certain character sets cannot stand alone but must be
used in pairs, one set being mapped to the other set.\
For example, the tr command: "tr '[:upper:]' ' [:lower:]'"
is a valid command that converts upper case letters to lower case, but the\
command "tr '[:upper:]' X", intended to replace all upper case letters with the\
letter 'X', is not. (This can be accomplished by listing the characters in the\
first set explicitly: "tr 'ABCDEFGHIJKLMNOPQRSTUVWXYZ' 'X'".)}];
    AppendToTextDisplay $po "\n\n"
AppendToTextDisplay $po [_ {This restriction applies only to mappings between\
two sets of characters. The command "tr -d [:upper:]]" is a valid command which\
strips upper case letters from its input.}];
    AppendToTextDisplay $po "\n"
}

proc ExplainXYpair {} {
    global HPWidth;
    global HPLines;
    global HelpPopups;
    if {[PopupDown XYpair] ==1} {return}
    set po [CreateTextDisplay [_ "Balanced Delimiters"] $HPWidth $HPLines]
    BindKeys $po;
    set HelpPopups(XYpair) $po;
    AppendToTextDisplay $po [_ "This construction is intended for matching strings\
surrounded by balanced delimiters. The expression \`%b()\', for example, will\
a string surrounded by parentheses, such as \`(abc)\'"];
}

proc ExplainClassComplement {} {
    global HPWidth;
    global HPLines;
    global HelpPopups;
    if {[PopupDown ClassComplement] ==1} {return}
    set po [CreateTextDisplay [_ "Complements of Named Classes"] $HPWidth $HPLines]
    BindKeys $po;
    set HelpPopups(ClassComplement) $po;
    AppendToTextDisplay $po [_ "This notation denotes the complement of a named
character class, that is, the set of characters that do not belong to it. For example,
if the class is \`\[:lower:\]\', the set of lower-case letters, its complement
consists of all characters that are not lower-case letters, including upper-case
letters, digits, punctuation, and control characters."];
}

proc ExplainUnicodeCase {} {
    global HPWidth;
    global HPLines;
    global HelpPopups;
    if {[PopupDown UnicodeCase] ==1} {return}
    set po [CreateTextDisplay [_ "Unicode Case Flag"] $HPWidth $HPLines]
    BindKeys $po;
    set HelpPopups(UnicodeCase) $po;
    AppendToTextDisplay $po [_ "This flag makes matches case-insensitive for all
Unicode characters. It must be used in conjunction with the basic case-insensitive
flag, which by itself affects only the ASCII letters."];
}

proc ExplainZeroOneQMark {} {
    global HPWidth;
    global HPLines;
    global HelpPopups;
    if {[PopupDown ZeroOneQMark] ==1} {return}
    set po [CreateTextDisplay [_ "Optional Quantifier"] $HPWidth $HPLines]
    BindKeys $po;
    set HelpPopups(ZeroOneQMark) $po;
    AppendToTextDisplay $po [_ "This quantifier indicates that the preceding group\
may be either present or absent. In other words, it says that a matching string will contain\
either zero or one token of the group."];
}

proc ExplainBeginningOfString {} {
    global HPWidth;
    global HPLines;
    global HelpPopups;
    if {[PopupDown BeginningOfString] ==1} {return}
    set po [CreateTextDisplay [_ "Beginning of String"] $HPWidth $HPLines]
    BindKeys $po;
    set HelpPopups(BeginningOfString) $po;
    AppendToTextDisplay $po [_ "This matches at the beginning of the string."];
}

proc ExplainBeginningOfWord {} {
    global HPWidth;
    global HPLines;
    global HelpPopups;
    if {[PopupDown BeginningOfWord] ==1} {return}
    set po [CreateTextDisplay [_ "Beginning of Word"] $HPWidth $HPLines]
    BindKeys $po;
    set HelpPopups(BeginningOfWord) $po;
    AppendToTextDisplay $po [_ "This matches at the beginning of a word.\
A word is considered to begin at the transition from a non-word character\
to a word character, where a word character is an alphanumeric character or\
underscore."];
}

proc ExplainEndOfWord {} {
    global HPWidth;
    global HPLines;
    global HelpPopups;
    if {[PopupDown EndOfWord] ==1} {return}
    set po [CreateTextDisplay [_ "End of Word"] $HPWidth $HPLines]
    BindKeys $po;
    set HelpPopups(EndOfWord) $po;
    AppendToTextDisplay $po [_ "This matches at the end of a word.\
A word is considered to end at the transition from a word character\
to a non-word character, where a word character is an alphanumeric character or\
underscore."];
}


proc ExplainWordBoundary {} {
    global HPWidth;
    global HPLines;
    global HelpPopups;
    if {[PopupDown WordBoundary] ==1} {return}
    set po [CreateTextDisplay [_ "Word Boundary"] $HPWidth $HPLines]
    BindKeys $po;
    set HelpPopups(WordBoundary) $po;
    AppendToTextDisplay $po [_ "This matches at a word boundary, where a word\
boundary is considered to occur between any two adjacent characters of which\
one is a word character and the other is a non-word character."];
}

proc ExplainNonWordBoundary {} {
    global HPWidth;
    global HPLines;
    global HelpPopups;
    if {[PopupDown NonWordBoundary] ==1} {return}
    set po [CreateTextDisplay [_ "NonWordBoundary"] $HPWidth $HPLines]
    BindKeys $po;
    set HelpPopups(NonWordBoundary) $po;
    AppendToTextDisplay $po [_ "This matches anywhere that is not word boundary, where a word\
boundary is considered to occur between any two adjacent characters of which\
one is a word character and the other is a non-word character. In other words, it\
matches if both characters are word characters or both are non-word characters."];
}

proc ExplainSet {} {
    global HPWidth;
    global HPLines;
    global HelpPopups;
    if {[PopupDown Set] ==1} {return}
    set po [CreateTextDisplay [_ "Set"] $HPWidth $HPLines]
    BindKeys $po;
    set HelpPopups(Set) $po;
    AppendToTextDisplay $po [_ "This matches any of the characters in the set."];
}

proc ExplainSetComplement {} {
    global HPWidth;
    global HPLines;
    global HelpPopups;
    if {[PopupDown SetComplement] ==1} {return}
    set po [CreateTextDisplay [_ "SetComplement"] $HPWidth $HPLines]
    BindKeys $po;
    set HelpPopups(SetComplement) $po;
    AppendToTextDisplay $po [_ "This matches the complement of the characters in the set,\
that is, any character that is not a member of the set. If you want to include circumflex\
in the set, just put it somewhere other than first; it denotes the complement only\
when it immediately follows the left square bracket."];
}

proc ExplainRange {} {
    global HPWidth;
    global HPLines;
    global HelpPopups;
    if {[PopupDown Range] ==1} {return}
    set po [CreateTextDisplay [_ "Character Ranges"] $HPWidth $HPLines]
    BindKeys $po;
    set HelpPopups(Range) $po;
    AppendToTextDisplay $po [_ "This denotes the range of characters from a through d inclusive.\
Traditionally, the characters between the endpoints are those whose codes fall\
numerically between those of the endponts. For exmaple, in ASCII the range \[g-k\] consists\
of g, h, i, j, and k."];
AppendToTextDisplay $po "\n\n"
    AppendToTextDisplay $po [_ "In the locale system, the meaning of a range depends on the\
collating order (sort order) defined for the locale, which may not be the same as the\
numerical order of codepoints. If you are writing code that may be used in a variety\
of locales, it is best to avoid the use of ranges. They can always be replaced by explicit\
lists."];
AppendToTextDisplay $po "\n\n"
AppendToTextDisplay $po [_ "Character ranges may not cross Unicode range boundaries."];
}

proc ExplainMultiRange {} {
    global HPWidth;
    global HPLines;
    global HelpPopups;
    if {[PopupDown MultiRange] ==1} {return}
    set po [CreateTextDisplay [_ "Multiple Character Ranges"] $HPWidth $HPLines]
    BindKeys $po;
    set HelpPopups(MultiRange) $po;
    AppendToTextDisplay $po [_ "Multiple ranges may be included in the same character set. Each hyphen defines a range\
consisting of the the characters on either side of it. Any characters not adjacent to hyphens are individual\
members of the set. Thus, \[a-dw-z\] is the union of the ranges \[a-d\] and \[w-z\], in the C locale therefore\
a,b,c,d,w,x,y, and z. \[a-dsw-z\] is the union of the ranges \[a-d\] and \[w-z\] plus the letter \`s\', which is to\
say, the letters: a,b,c,d,s,w,x,y, and z."];
}

proc ExplainTRStar {} {
    global HPWidth;
    global HPLines;
    global HelpPopups;
    if {[PopupDown TRStar] ==1} {return}
    set po [CreateTextDisplay [_ "TR Star"] $HPWidth $HPLines]
    BindKeys $po;
    set HelpPopups(TRStar) $po;
    AppendToTextDisplay $po [_ "Insert into the target character list as many copies of the\
specified character as are necessary to make the target list as long as the source list.\
For example, if the source list is \`aeioubcdfghklmnpqrstvwxyz\' and you want to map the vowels\
onto themselves and the consonants onto X, the second list could be written\
\`aeiouX*\'."];
}

proc ExplainTRStarN {} {
    global HPWidth;
    global HPLines;
    global HelpPopups;
    if {[PopupDown TRStarN] ==1} {return}
    set po [CreateTextDisplay [_ "TR Star N"] $HPWidth $HPLines]
    BindKeys $po;
    set HelpPopups(TRStarN) $po;
    AppendToTextDisplay $po [_ "This is shorthand for N copies of a character. If N begins\
with a 0, it is taken to be in octal."];
}

proc ExplainInsertLiteralString {} {
    global HPWidth;
    global HPLines;
    global HelpPopups;
    if {[PopupDown InsertLiteralString] ==1} {return}
    set po [CreateTextDisplay [_ "Insert Literal String"] $HPWidth $HPLines]
    BindKeys $po;
    set HelpPopups(InsertLiteralString) $po;
    AppendToTextDisplay $po [_ "In a substitution, insert the string between quotes."];
}


proc ExplainPositiveForwardAssertion {} {
    global HPWidth;
    global HPLines;
    global HelpPopups;
    if {[PopupDown PositiveForwardAssertion] ==1} {return}
    set po [CreateTextDisplay [_ "Positive Forward Assertion"] $HPWidth $HPLines]
    BindKeys $po;
    set HelpPopups(PositiveForwardAssertion) $po;
    AppendToTextDisplay $po [_ "A positive forward assertion requires that the string\
match the pattern in the assertion but does not consume the characters that match."];
}

proc ExplainPositiveBackwardAssertion {} {
    global HPWidth;
    global HPLines;
    global HelpPopups;
    if {[PopupDown PositiveBackwardAssertion] ==1} {return}
    set po [CreateTextDisplay [_ "Positive Backward Assertion"] $HPWidth $HPLines]
    BindKeys $po;
    set HelpPopups(PositiveBackwardAssertion) $po;
    AppendToTextDisplay $po [_ "A positive backward assertion checks whether the
pattern in the assertion matches the string preceding the current candidate."];
}

proc ExplainNegativeForwardAssertion {} {
    global HPWidth;
    global HPLines;
    global HelpPopups;
    if {[PopupDown NegativeForwardAssertion] ==1} {return}
    set po [CreateTextDisplay [_ "Negative Forward Assertion"] $HPWidth $HPLines]
    BindKeys $po;
    set HelpPopups(NegativeForwardAssertion) $po;
    AppendToTextDisplay $po [_ "A negative forward assertion requires that the string\
not match the pattern in the asertion. It does not consume any characters."];
}

proc ExplainNegativeBackwardAssertion {} {
    global HPWidth;
    global HPLines;
    global HelpPopups;
    if {[PopupDown NegativeBackwardAssertion] ==1} {return}
    set po [CreateTextDisplay [_ "Negative Backward Assertion"] $HPWidth $HPLines]
    BindKeys $po;
    set HelpPopups(NegativeBackwardAssertion) $po;
    AppendToTextDisplay $po [_ "A negative backward assertion checks to see that the\
pattern in the assertion does not match the string preceding the current candidate."];
}

proc ExplainSelfishNoCaptureGroup {} {
    global HPWidth;
    global HPLines;
    global HelpPopups;
    if {[PopupDown SelfishNoCaptureGroup] ==1} {return}
    set po [CreateTextDisplay [_ "Selfish No Capture Group"] $HPWidth $HPLines]
    BindKeys $po;
    set HelpPopups(SelfishNoCaptureGroup) $po;
    AppendToTextDisplay $po [_ "A selfish no capture group is a no capture group\
(one that does not count for purposes of backreference) that matches without regard\
to whether the rest of the regular expression can be matched. It may absorb characters\
needed by other parts of the regular expression. An ordinary group (capture or no capture)\
will relinquish matching characters if other parts of the regular expression are\
unable to match without them."];
    AppendToTextDisplay $po "\n\n";
    AppendToTextDisplay $po [_ "For example, consider the expression \`(?>a+)a\'.
This consists of a selfish no capture group matching one or more tokens of \`a\'
followed by a single \`a\'. In order for the regular expression to match, the final\
\`a\' must match. This can never happen because the \`a+\' will absorb all of the\
\`a\'s."];
}

proc ExplainSimpleGroupConditional {} {
    global HPWidth;
    global HPLines;
    global HelpPopups;
    if {[PopupDown SimpleGroupConditional] ==1} {return}
    set po [CreateTextDisplay [_ "Simple Backreference Group Conditional"] $HPWidth $HPLines]
    BindKeys $po;
    set HelpPopups(SimpleGroupConditional) $po;
    AppendToTextDisplay $po [_ "A conditional regular expression is one in which\
whether one portion of the regular expression must match the target depends on\
whether another portion of\
the regular expression matches. Conditional regular expressions vary on two\
main dimensions: (a) what sort of condition they use; (b) whether or not\
they have an \`else\' clause."];
    AppendToTextDisplay $po "\n\n";
    AppendToTextDisplay $po [_ "This is the simplest type of conditional regular\
expression. The condition is whether or not a specified capture group matched.\
In the schema shown on the palette, k is the index of the group and x is the\
regular expression that must be matched if the specified group matched. For\
example, suppose that the entire regular expression is: \`(<)(.+)(?(1)>) \'.\
This consists of three parts: a capture group consisting of just a left\
angle bracket, another capture group consisting of \`.+\/, and a conditional\
expression. The conditional consists of a condition,\
namely that the first capture group match, and a regular expression, which in this\
case is the single character right angle bracket. This regular expression matches\
any non-null string that is either bare or enclosed by a balanced pair of\
angle brackets. No angle brackets are required, but if there is a left,\
angle bracket there must also be a right angle bracket."];
}

proc ExplainElseGroupConditional {} {
    global HPWidth;
    global HPLines;
    global HelpPopups;
    if {[PopupDown ElseGroupConditional] ==1} {return}
    set po [CreateTextDisplay [_ "Group Backreference Conditional With Else Clause"] $HPWidth $HPLines]
    BindKeys $po;
    set HelpPopups(ElseGroupConditional) $po;
    AppendToTextDisplay $po [_ "A conditional regular expression is one in which\
whether one portion of the regular expression must match the target depends on\
whether another portion of\
the regular expression matches. Conditional regular expressions vary on two\
main dimensions: (a) what sort of condition they use; (b) whether or not\
they have an \`else\' clause."];
    AppendToTextDisplay $po "\n\n";
    AppendToTextDisplay $po [_ "This schema represents the type of condition\
in which the condition is whether or not a specified capture group matched\
and in which there is an else clause.\
In the schema shown on the palette, k is the index of the group, x is the\
regular expression that must be matched if the specified group matched, and\
y is the regular expression that must be matched if the group does not match.\
For example, suppose that the entire regular expression is: \`(<)(.+)(?(1)>|\[^>\])\'.\
(Depending on the language you are using and how you are entering the regular\
expression, additional quoting may be necessary.)\
This consists of three parts: a capture group consisting of just a left\
angle bracket, another capture group consisting of \`.+\/, and a conditional\
expression. The conditional consists of a condition,\
namely that the first capture group match, and two regular expressions separated\
by a pipe symbol. The first regular expression in the conditional\
is the single character right angle bracket. The second regular expression in the\
conditional is the set of characters other than right angle bracket.\
This regular expression matches\ any non-null string that is either bare or enclosed by\
a balanced pair of angle brackets. No angle brackets are required, but if there\
is a left angle bracket, there must also be a right angle bracket.\
The else clause requires that the string\
not end in a right angle bracket if it does not begin with left angle bracket"];
}


proc ExplainSimpleLookaroundConditional {} {
    global HPWidth;
    global HPLines;
    global HelpPopups;
    if {[PopupDown SimpleLookaroundConditional] ==1} {return}
    set po [CreateTextDisplay [_ "SimpleLookaroundConditional"] $HPWidth $HPLines]
    BindKeys $po;
    set HelpPopups(SimpleLookaroundConditional) $po;
    AppendToTextDisplay $po [_ "A conditional regular expression is one in which\
whether one portion of the regular expression must match the target depends on\
whether another portion of\
the regular expression matches. Conditional regular expressions vary on two\
main dimensions: (a) what sort of condition they use; (b) whether or not\
they have an \`else\' clause."];
    AppendToTextDisplay $po "\n\n";
    AppendToTextDisplay $po [_ "This schema shown is for the case in which the\
condition is an assertion and there is no else clause. The condition may consist\
of any of the four types of assertion: positive forward, negative forward, positive backward,\
and negative backward. The general form is: \`(?(assertion)re) \', where \'re\' is\
the regular expression that must be matched if the assertion is true. The assertion\
will take the form \`?=y\', \`?<=y\', \`?!y\',\`?<!y\' where \`y\' is a regular\
expression and the preceding characters indicate which kind of assertion it is,\
just as they elsewhere."];
}

proc ExplainElseLookaroundConditional {} {
    global HPWidth;
    global HPLines;
    global HelpPopups;
    if {[PopupDown ElseLookaroundConditional] ==1} {return}
    set po [CreateTextDisplay [_ "ElseLookaroundConditional"] $HPWidth $HPLines]
    BindKeys $po;
    set HelpPopups(ElseLookaroundConditional) $po;
    AppendToTextDisplay $po [_ "A conditional regular expression is one in which\
whether one portion of the regular expression must match the target depends on\
whether another portion of\
the regular expression matches. Conditional regular expressions vary on two\
main dimensions: (a) what sort of condition they use; (b) whether or not\
they have an \`else\' clause."];
    AppendToTextDisplay $po "\n\n";
    AppendToTextDisplay $po [_ "This schema shown is for the case in which the\
condition is an assertion and there is an else clause. The condition may consist\
of any of the four types of assertion: positive forward, negative forward, positive bachkward,\
and negative backward. The general form is: \`(?(assertion)re1|re2) \', where \'re1\' is\
the regular expression that must be matched if the assertion is true and re2 is\
the regular expression that must be matched if the assertion is false. The assertion\
will take the form \`?=y\', \`?<=y\', \`?!y\',\`?<!y\' where \`y\' is a regular\
expression and the preceding characters indicate which kind of assertion it is,\
just as they elsewhere. "];
}

proc ExplainInsertLastGroup {} {
    global HPWidth;
    global HPLines;
    global HelpPopups;
    if {[PopupDown InsertLastGroup] ==1} {return}
    set po [CreateTextDisplay [_ "Insert Last Captured Group"] $HPWidth $HPLines]
    BindKeys $po;
    set HelpPopups(InsertLastGroup) $po;
    AppendToTextDisplay $po [_ "In a substitution expression, this inserts the last\
captured group from the regular expression. For example,\
if the regular expression is \`(a.*)(b.*)(c.*)\', whatever \`c.*\' matched will be inserted.\
If the regular expression is \`(a.*)(b.*)\', whatever \`b.*\' matched will be inserted."];
}

proc ExplainUnsetFlag {} {
    global HPWidth;
    global HPLines;
    global HelpPopups;
    if {[PopupDown UnsetFlag] ==1} {return}
    set po [CreateTextDisplay [_ "Inline Unset Flag"] $HPWidth $HPLines]
    BindKeys $po;
    set HelpPopups(UnsetFlag) $po;
    AppendToTextDisplay $po [_ "Where f is an inline flag,  this unsets it. For example,\
where\`?i\' sets the case-insensitive flag, \`?-i\' unsets it, making subsequent\
matches case-sensitive. It overrides any previous in-line setting of the flag as well as\
a setting from the command-line or in the argument to a function or method."];
    AppendToTextDisplay $po "\n\n"
    AppendToTextDisplay $po [_ "For further information on case-sensitivity, see: \n"]
    AppendLinkToTextDisplay $po "Case Sensitivity" {ExplainCaseInsensitive};
}

proc ExplainStarClass {} {
    global HPWidth;
    global HPLines;
    global HelpPopups;
    if {[PopupDown StarClass] ==1} {return}
    set po [CreateTextDisplay [_ "Class Star"] $HPWidth $HPLines]
    BindKeys $po;
    set HelpPopups(StarClass) $po;
    AppendToTextDisplay $po [_ "This quantifier matches zero or more tokens belonging\
to the preceding character class. For example, \`%d*\' matches a sequence of any number\
of digits."];
}

proc ExplainPlusClass {} {
    global HPWidth;
    global HPLines;
    global HelpPopups;
    if {[PopupDown PlusClass] ==1} {return}
    set po [CreateTextDisplay [_ "Class Plus"] $HPWidth $HPLines]
    BindKeys $po;
    set HelpPopups(PlusClass) $po;
    AppendToTextDisplay $po [_ "This quantifier matches one or more tokens belonging\
to the preceding character class. For example, \`%d+\' matches a sequence of one or\
more digits."];
}

proc ExplainZeroOneQMarkClass {} {
    global HPWidth;
    global HPLines;
    global HelpPopups;
    if {[PopupDown QMarkClass] ==1} {return}
    set po [CreateTextDisplay [_ "Question Mark Class"] $HPWidth $HPLines]
    BindKeys $po;
    set HelpPopups(QMarkClass) $po;
    AppendToTextDisplay $po [_ "This quantifier matches zero or one token of the\
preceding character class. For example, \`%d%d?\' matches either one or two digits."];
}

proc ExplainHyphenClass {} {
    global HPWidth;
    global HPLines;
    global HelpPopups;
    if {[PopupDown HyphenClass] ==1} {return}
    set po [CreateTextDisplay [_ "Hyphen Class"] $HPWidth $HPLines]
    BindKeys $po;
    set HelpPopups(HyphenClass) $po;
    AppendToTextDisplay $po [_ "This quantifier matches zero or more tokens belonging\
to the preceding character class. For example, \`%d-\' matches a sequence of any number\
of digits. However, unlike other similar quantifiers, it is a reluctant\
quantifier. For example, if the expression \`(a)(%u-)(%u*)(a)\' is matched against\
the string \`aBBBBa\', the third group will match \`BBBB\'. The second group\
contains nothing because the quantifier matches as little as it has to, and\
the subexpression \`(%u-)\'is satisfied with a match of the empty string."];
}

proc ExplainCollationClass {} {
    global HPWidth;
    global HPLines;
    global HelpPopups;
    if {[PopupDown CollationClass] ==1} {return}
    set po [CreateTextDisplay [_ "CollationClass"] $HPWidth $HPLines]
    BindKeys $po;
    set HelpPopups(CollationClass) $po;
    AppendToTextDisplay $po [_ "A collation class is the set of characters that are assigned the same sort rank. For example, in languages in which vowels occur with a variety of accents or with no accent, as a primary sort key all versions of the same vowel are usually assigned the same sort rank, so that, for example, e, \u00E8, and \u00E9 will be treated the same. In a regular expression, a collation class matches any member of the class. A collation class is specified by listing any of its members."];
}


proc ExplainCollatingElementNamed {} {
    global HPWidth;
    global HPLines;
    global HelpPopups;
    if {[PopupDown ExplainCollatingElementNamed] ==1} {return}
    set po [CreateTextDisplay [_ "Named Collating Element"] $HPWidth $HPLines]
    BindKeys $po;
    set HelpPopups(ExplainCollatingElementNamed) $po;
    AppendToTextDisplay $po [_ "A named collating element is a symbolic name for a collating element, which may consist of a single character or may itself be a multicharacter collating element. See section 2.2.2.33 of POSIX ISO/IEC 9945-2:1993."];
}

proc ExplainCollatingElementMultichar {} {
    global HPWidth;
    global HPLines;
    global HelpPopups;
    if {[PopupDown ExplainCollatingElementMultichar] ==1} {return}
    set po [CreateTextDisplay [_ "Multicharacter Collating Element"] $HPWidth $HPLines]
    BindKeys $po;
    set HelpPopups(ExplainCollatingElementMultichar) $po;
    AppendToTextDisplay $po [_ "A multicharacter collating element is a sequence of characters that are treated as a single unit for purposes of sorting. For example, in Spanish the sequence ch is conventionally treated as a single letter which follows c and precedes d. In a regular expression a multicharacter collating element is treated as a single character when counting letters. For example, if ch is defined as a collating element, the regular expression [[.ch.]]*c matches the string chchc. See section 2.2.2.33 of POSIX ISO/IEC 9945-2:1993."];
}



#This provides an addition to the default methods of the Scrollbar
#widget. The default method, bound to <B1>, #increments or decrements
#the value by the resolution, by default 1. If you want a larger
#increment, you can use a larger resolution, but sometimes it is
#convenient to have a finer resolutio available while also being
#able to move in larger increments. A solution is to bind to
#<B3>, or some other event if you wish, a larger movement.
#This procedure moves by the specified multiplier k times
#the resolution of the Scrollbar. 

proc ScrollbarMoveBigIncrement {w f x y} {
    set part [$w identify $x $y]
    switch -exact -- $part {
	trough1 {
	    set dir -1;
	}
	arrow1 {
	    set dir -1;
	}
	trough2 {
	    set dir  1;
	}
	arrow2 {
	    set dir  1;
	}
	default {
	    return ;
	}
    }
    set CurrentFraction [lindex [$w get] 0]
    set NewFraction [expr $CurrentFraction + ($dir * $f)]
    eval [concat [$w cget -command] moveto $NewFraction]
}

#Template
proc ExplainX {} {
    global HPWidth;
    global HPLines;
    global HelpPopups;
    if {[PopupDown X] ==1} {return}
    set po [CreateTextDisplay [_ "X"] $HPWidth $HPLines]
    BindKeys $po;
    set HelpPopups(X) $po;
    AppendToTextDisplay $po [_ ""];
}

option add *proginfo.*Background $::ColorSpecs(ProgramInfoPopup,Background)	
option add *proginfo.*Foreground $::ColorSpecs(ProgramInfoPopup,Foreground)

proc PopupProgramInfo {} {
    global ColorSpecs;
    if {[winfo exists .proginfo]} {
	destroy .proginfo;
	return
    }
    toplevel .proginfo -borderwidth 4 -relief raised 
    wm title .proginfo [_ "Program Information"];
    after idle {
	update idletasks
	set xmax [winfo screenwidth .proginfo]
	set ymax [winfo screenheight .proginfo]
	set x0 [expr int(2.4 * ($xmax -[winfo reqwidth .proginfo])/3.0)];
	set y0 [expr int(2.3 * ($ymax -[winfo reqheight .proginfo])/3.0)];
	wm geometry .proginfo "+$x0+$y0";
    }
    set txt [format [_ "Properties of %s"] [NameProgram]]
    append txt [format "\n\[%s\]" $::ProgramInfo($::program,version)]
    label .proginfo.title -text $txt

    if {$::Features(unicodefull,$::program,$::Locale)} {
	set txt [_ "Supports full Unicode in this locale."];
    } elseif {$::Features(unicodebmp,$::program,$::Locale)} {
	set txt [_ "Supports just the Basic Multilingual Plane of Unicode in this locale."];
    } else {
	set txt [_ "Does not support Unicode in this locale."];
    }
    label .proginfo.unicode -text $txt -anchor w

    if {($::Features(dollar,$::program,$::Locale) == 0) && \
	     ($::Features(AbsoluteEndOfString,$::program,$::Locale))} {
	set txt [_ "Treats newline as an ordinary character."];
    } else {
	set txt [_ "Does not treat newline as an ordinary character"];
    }
    label .proginfo.newlineordinary -text $txt -anchor w

    if {[info exists ::ExecCmd($::program,match)]} {
	if {[info exists ::ExecCmd($::program,sub)]} {
	    set txt [_ "Is capable of both matching and substitution."];
	} else {
	    set txt [_ "Is capable of matching only."];
	}
    } else {
	set txt [_ "Is capable of substitution only."];
    }
    label .proginfo.matchsub -text $txt -anchor w

    button .proginfo.dismiss -text [_ "Dismiss"] -command {destroy .proginfo} -anchor e
    pack .proginfo.title -side top -expand 1 -fill x 
    pack .proginfo.unicode -side top  -expand 1 -fill x -padx 3 -pady 2
    pack .proginfo.newlineordinary -side top  -expand 1 -fill x -padx 3 -pady 2
    pack .proginfo.matchsub -side top  -expand 1 -fill x -padx 3 -pady 2
    pack .proginfo.dismiss -side bottom -anchor e -expand 1 -fill y -padx 3 -pady 6;
    catch {.proginfo.title configure -font -*-Courier-bold-o-normal--*-140-*}
}

#If the program info popup exists, recreate it so that it will be up to date.
proc RefreshProginfo {} {
    if {[winfo exists .proginfo]} {
	destroy .proginfo;
	PopupProgramInfo;
    }
}

proc WriteExecutionInfo {ExpList CLAndProg} {
    set Regexp [lindex $ExpList 0];
    set Subexp "";
    set DaughterProgram "";
    if {[llength $ExpList] > 1} {
	set Subexp [lindex $ExpList 1];
    }
    set CommandLine [lindex $CLAndProg 0]
    if {[llength $CLAndProg] > 1} {
	set DaughterProgram [lindex $CLAndProg 1];
    }

    #Get a file to write it to 
    set ExecInfoSaveFile [tk_getSaveFile -initialfile \
			      [format [_ "%sCommandInfo"] $::Program]]
    if {[ string equal $ExecInfoSaveFile ""]} {
	ShowMessage [_ "File selection cancelled."]
	return ;
    } else {
	if { [catch {open $ExecInfoSaveFile "w+"} ExecInfoSaveHandle]} {
	    ShowMessage [format [_ "Unable to open file %s to save command information"] \
			     [MinimizeFileName $ExecInfoSaveFile]];
	    return ;
	}
    }

    #Write out the info
    puts $ExecInfoSaveHandle [format [_ "Generated by Redet using %s %s"] \
			 $::Program  [clock format [clock seconds]]];
    puts $ExecInfoSaveHandle [format [_ "Command Line\n\t%s"] $CommandLine]
    puts $ExecInfoSaveHandle [format [_ "Regular Expression:\n\t%s"] $Regexp]
    if {![string equal $Subexp ""]} {
	puts $ExecInfoSaveHandle [format [_ "Substitution Expression:\n\t%s"] $Subexp]
    }
    if {![string equal $DaughterProgram ""]} {
	puts $ExecInfoSaveHandle [format [_ "Daughter Program:\n------------------\n%s"] \
				      $DaughterProgram]
    }
    close $ExecInfoSaveHandle;
    ShowMessage [format [_ "Command information saved in file %s."] [MinimizeFileName $ExecInfoSaveFile]]
} 

proc SaveCommandInfo {} {
    set ::ExecutionFlag CommandInfo;
    ExecuteRegexp;
    set ::ExecutionFlag Normal;
}

proc ShowCommandLine {} {
    set ::ExecutionFlag CommandLine;
    ExecuteRegexp;
    set ::ExecutionFlag Normal;
}

proc GetHomeDir {} {
    set cwd [pwd];
    cd;
    set hd [pwd];
    cd $cwd;
    return $hd;
}

set CustomCharacterChartFileNameList "";
proc StoreCustomCharacterChartFileName {fn} {
    lappend ::CustomCharacterChartFileNameList $fn;
}

set CustomCharacterChartDataList "";
proc StoreCustomCharacterChartInPlace {dl} {
    lappend ::CustomCharacterChartDataList $dl;
}

#Initialization file stuff

#This creates a procedure for setting the color of each combination of
#object and feature. The procedure validates the color specification, so
#invalid color specifications are trapped in the slave interpreter.
proc DefineColorSettingProcs {} {
    global ColorProcList;
    foreach cs [array names ::ColorSpecs] {
	set csl [split $cs ","]
	set obj   [lindex $csl 0]
	set which [lindex $csl 1]
	set procname [format "Set%s%sColor" $obj $which]
	lappend ColorProcList $procname
	eval [list "proc" $procname \
		   \
		  "\{cs\}" \
		  "if \{!\[::validcolor::IsColorSpecQ \$cs\]\} \{
		  puts \[format \[_ \"\\\"%s\\\" is not a valid color specification.\"\] \$cs\]
		  return;
		 \}
		  set ::ColorSpecs($obj,$which) \$cs"]
    }
}

proc SetStandardLayoutP {b} {
    set ::StandardConfigurationP [Boolean $b];
}

proc SetUseScrollbarsP {b} {
    set ::UseScrollbarsP [Boolean $b];
}

proc SetBalloonHelpShowP {b} {
    set ::BalloonHelpP [Boolean $b];
}

proc SetFocusFollowsMouseP {b} {
    set ::FocusFollowsMouseP [Boolean $b];
    tk_focusFollowsMouse;
}

proc SetHistoryIncludeProgramP {b} {
    set hist::HistoryShowProgP [Boolean $b];
}

proc SelectBrowser {s} {
    set ::Browser $s;
}

proc SetHistoryCentralP {b} {
    set hist::LocalP [Boolean $b];
} 

proc SetAutoClearRegexpP {b} {
    set ::AutoClearRegexpP [Boolean $b];
} 

proc SetOutputOnlyChangedLinesP {b} {
    set ::OutputOnlyChangedLinesP [Boolean $b];
} 

#Commands for setting program-specific parameters

proc SetAgrepCaseInsensitiveP {b} {
    set ::ProgramInfo(Agrep,CaseInsensitiveP) [Boolean $b];
}

proc SetAgrepBestResultsP {b} {
    set ::ProgramInfo(Agrep,BestResults) [Boolean $b];
}

proc SetAgrepErrorLimit {s} {
    set ::ProgramInfo(Agrep,ErrorLimit) $s;
}

proc SetAgrepDeletionCost {s} {
    set ::ProgramInfo(Agrep,DeletionCost) $s;
}

proc SetAgrepInsertionCost {s} {
    set ::ProgramInfo(Agrep,InsertionCost) $s;
}

proc SetAgrepSubstitutionCost {s} {
    set ::ProgramInfo(Agrep,SubstitutionCost) $s;
}

proc SetCgrepCaseInsensitiveP {b} {
    set ::ProgramInfo(cgrep,CaseInsensitiveP) [Boolean $b];
}

proc SetCgrepComplementP {b} {
    set ::ProgramInfo(cgrep,Complement) [Boolean $b];
}

proc SetCgrepTotalCost {s} {
    set ::ProgramInfo(cgrep,TotalCost) $s;
}

proc SetCgrepInsertionCost {s} {
    set ::ProgramInfo(cgrep,InsertionCost) $s;
}

proc SetCgrepDeletionCost {s} {
    set ::ProgramInfo(cgrep,DeletionCost) $s;
}

proc SetCgrepSubstitutionCost {s} {
    set ::ProgramInfo(cgrep,SubstitutionCost) $s;
}

proc SetEgrepCaseInsensitiveP {b} {
    set ::ProgramInfo(egrep,CaseInsensitiveP) [Boolean $b];
}

proc SetEgrepEmitMatchOnlyP {b} {
    set ::ProgramInfo(egrep,EmitMatchOnly) [Boolean $b];
}

proc SetEgrepComplementP {b} {
    set ::ProgramInfo(egrep,Complement) [Boolean $b];
}

proc SetEmacsFoldCaseMatchP {b} {
    set ::ProgramInfo(emacs,FoldCaseMatchP) [Boolean $b];
}

proc SetEmacsFoldCaseReplaceP {b} {
    set ::ProgramInfo(emacs,FoldCaseReplaceP) [Boolean $b];
}

proc SetFgrepCaseInsensitiveP {b} {
    set ::ProgramInfo(fgrep,CaseInsensitiveP) [Boolean $b];
}

proc SetFgrepEmitMatchOnlyP {b} {
    set ::ProgramInfo(fgrep,EmitMatchOnly) [Boolean $b];
}

proc SetFgrepComplementP {b} {
    set ::ProgramInfo(fgrep,Complement) [Boolean $b];
}

proc SetGawkCaseInsensitiveP {b} {
    set ::ProgramInfo(gawk,CaseInsensitiveP) [Boolean $b];
}

proc SetGawkIntervalExpressionsP {b} {
    set ::ProgramInfo(gawk,IntervalExpressions) [Boolean $b];
}

proc SetGawkNotation {s} {
    set ::ProgramInfo(gawk,Notation) $s;
}

proc SetGlarkCaseInsensitiveP {b} {
    set ::ProgramInfo(glark,CaseInsensitiveP) [Boolean $b];
}

proc SetGlarkEmitMatchOnlyP {b} {
    set ::ProgramInfo(glark,EmitMatchOnly) [Boolean $b];
}

proc SetGlarkComplementP {b} {
    set ::ProgramInfo(glark,Complement [Boolean $b];
}

proc SetGlarkMatchEntireLineP {b} {
    set ::ProgramInfo(glark,MatchEntireLineP) [Boolean $b];
}

proc SetGrepCaseInsensitiveP {b} {
    set ::ProgramInfo(grep,CaseInsensitiveP) [Boolean $b];
}

proc SetGrepEmitMatchOnlyP {b} {
    set ::ProgramInfo(grep,EmitMatchOnly) [Boolean $b];
}

proc SetGrepComplementP {b} {
    set ::ProgramInfo(grep,Complement) [Boolean $b];
}

proc SetGrepNotation {s} {
    set ::ProgramInfo(grep,Notation) $s;
}

proc SetJavaCanonEQP {b} {
    set ::ProgramInfo(java,CanonEQ) [Boolean $b];
}

proc SetJavaCaseInsensitiveP {b} {
    set ::ProgramInfo(java,CaseInsensitiveP) [Boolean $b];
}

proc SetJavaUnicodeCaseP {b} {
    set ::ProgramInfo(java,UnicodeCase) [Boolean $b];
}

proc SetJgrepCaseInsensitiveP {b} {
    set ::ProgramInfo(jgrep,CaseInsensitiveP) [Boolean $b];
}

proc SetNrgrepCaseInsensitiveP {b} {
    set ::ProgramInfo(nrgrep,CaseInsensitiveP) [Boolean $b];
}

proc SetNrgrepComplementP {b} {
    set ::ProgramInfo(nrgrep,ComplementP) [Boolean $b];
}

proc SetNrgrepTotalCost {s} {
    set ::ProgramInfo(nrgrep,TotalCost) $s;
}

proc SetNrgrepInsertionsP {b} {
    set ::ProgramInfo(nrgrep,InsertionsP) [Boolean $b];
}

proc SetNrgrepDeletionsP {b} {
    set ::ProgramInfo(nrgrep,DeletionsP) [Boolean $b];
}

proc SetNrgrepSubstitutionsP {b} {
    set ::ProgramInfo(nrgrep,SubstitutionsP) [Boolean $b];
}

proc SetNrgrepTranspositionsP {b} {
    set ::ProgramInfo(nrgrep,TranspositionsP) [Boolean $b];
}

proc SetPerlUnicodeLocaleDependentP {b} {
    set ::ProgramInfo(perl,UnicodeLocaleDependentP) [Boolean $b];
}

proc SetPythonRawStringP {b} {
    set ::ProgramInfo(python,RawStringP) [Boolean $b];
}

proc SetSedExtendedRegexpP {b} {
    set ::ProgramInfo(sed,ExtendedRegexp) [Boolean $b];
}

proc SetTclCaseInsensitiveP {b} {
    set ::ProgramInfo(tcl,CaseInsensitiveP) [Boolean $b];
}

proc SetTclExpandedP {b} {
    set ::ProgramInfo(tcl,ExpandedP) [Boolean $b];
}

proc SetTrComplementP {b} {
    set ::ProgramInfo(tr,Complement) [Boolean $b];
}

proc SetTrSqueezeP {b} {
    set ::ProgramInfo(tr,Squeeze) [Boolean $b];
}

proc SetTrTruncateP {b} {
    set ::ProgramInfo(tr,Truncate) [Boolean $b];
}

proc SetShellItemLimit {s} {
    if {![string is integer -strict $s]} {
	return ;
    }
    if {$s < 1} {
	return
    }
    set ::ShellItemLimit $s;
}

#Returns a list of init file commands representing the current user-defined palette entries.
proc SavePaletteEntries {} {
    set cl [list]
    foreach pe [array names ::UserPalette] {
	set pel [split $pe ","]
	set EntryName [lindex $pel 1];
	if {$EntryName == 0} {continue}
	set WhichProgram [lindex $pel 0];
	set e $::UserPalette($WhichProgram,$EntryName);
	set Body [list [lindex $e 0]]
	set Etext [lindex $e 1]
	lappend cl [format "AddUserPaletteEntry %s %s %s %s" \
			$WhichProgram $EntryName $Body $Etext]
    }
    return [lsort $cl];
}


#Returns a list of init file commands representing the current color settings.
proc SaveColorSettings {} {
    set cl [list]
    foreach cs [array names ::ColorSpecs] {
	set csl [split $cs ","]
	set obj   [lindex $csl 0]
	set which [lindex $csl 1]
	set ps $::ColorSpecs($cs)
	if {[string index $ps 0] == "\#"} {
	    set ps \\$::ColorSpecs($cs)
	} else {
	    set ps [list $ps];
	}
	lappend cl [format "%s%sColor %s" $obj $which $ps]
    }
    return [lsort $cl];
}

#Check whether the argument represents a Boolean value
#and interpret it if it is.
proc Boolean {s} {
     switch -regexp $s {
	 1	{return 1}
	 T.*	{return 1}
	 t.*	{return 1}
	 Y.*	{return 1}
	 y.*	{return 1}
	 ok	{return 1}
	 on	{return 1}
	 0 	{return 0}
	 F.*	{return 0}
	 f.*	{return 0}
	 N.*	{return 0}
	 n.*	{return 0}
	 off	{return 0}
	 default {error}
     }
}

proc GetInitCommands {} {
    # We want a fresh interpreter so that we don't
    # list any commands defined in a user's init file.
    if { [interp exists init]} {
	interp delete init
    }
    InitFileSetup;
    set n 0
    #We rely on the fact that all builtin commands have lower-case
    #case names to separate the commands we provide from the builtins.
    return [interp eval init {lsort [info commands \[A-Z\]*]}]
}

proc SaveInitCommands {} {
    set SaveFile [tk_getSaveFile -initialfile [_ "InitFileCommands"]];
    if {[string equal $SaveFile ""]} {
	return ;
    } else {
        if { [catch {open $SaveFile "w+"} fh] != 0} {
	    ShowMessage [format \
		     [_ "Unable to open file %s in which to save class definitions."] \
			     [MinimizeFileName $SaveFile]];
	    return ;
        }
    }
    set n 0;
    foreach l [GetInitCommands] {
	incr n;
	puts $fh [format "\[%03d\] %s" $n $l]
    }
    close $fh;
}

proc GetInitTclCommands {} {
    # We want a fresh interpreter so that we don't
    # list any commands defined in a user's init file.
    if { [interp exists init]} {
	interp delete init
    }
    interp create -safe -- init
    set n 0
    #We rely on the fact that all builtin commands have lower-case
    #case names to separate the commands we provide from the builtins.
    return [interp eval init {lsort [info commands \[a-z\]*]}]
}

set OtherPopups(InitCommandList) "";
proc PopupInitCommandList {} {
    if {[winfo exists $::OtherPopups(InitCommandList)]} {
	raise $::OtherPopups(InitCommandList);
	return ;
    }
    set po  [CreateTextDisplay [_ "Initialization File Commands"] 65 10];
    set ::OtherPopups(InitCommandList) $po;
    BindKeys $po;
    set n 0;
    foreach l [GetInitCommands] {
	incr n;
	AppendToTextDisplay $po [format "\[%03d\] %s\n" $n $l];
    }
}

proc SaveInitTclCommands {} {
    set SaveFile [tk_getSaveFile -initialfile [_ "InitFileTclCommands"]];
    if {[string equal $SaveFile ""]} {
	return ;
    } else {
        if { [catch {open $SaveFile "w+"} fh] != 0} {
	    ShowMessage [format \
		     [_ "Unable to open file %s in which to save Tcl commands."] \
			     [MinimizeFileName $SaveFile]];
	    return ;
        }
    }
    set n 0;
    foreach l [GetInitTclCommands] {
	incr n;
	puts $fh [format "\[%03d\] %s" $n $l]
    }
    close $fh;
}

set OtherPopups(InitTclCommandList) "";
proc PopupInitTclCommandList {} {
    if {[winfo exists $::OtherPopups(InitTclCommandList)]} {
	raise $::OtherPopups(InitTclCommandList);
	return ;
    }
    set po  [CreateTextDisplay [_ "Initialization File Tcl Commands"] 65 10];
    set ::OtherPopups(InitTclCommandList) $po;
    BindKeys $po;
    set n 0;
    foreach l [GetInitTclCommands] {
	incr n;
	AppendToTextDisplay $po [format "\[%03d\] %s\n" $n $l];
    }
}

proc SaveMiscellaneousSettings {} {
    set MiscellaneousInitCommandList \
	[list \
	     [SlaveName SetAutoClearRegexpP] $::AutoClearRegexpP \
	     [SlaveName SelectBrowser] $::DefaultBrowser\
	     [SlaveName SetFocusFollowsMouseP] $::FocusFollowsMouseP \
	     [SlaveName SetHistoryCentralP] $hist::LocalP\
	     [SlaveName SetHistoryIncludeProgramP] $hist::HistoryShowProgP\
	     [SlaveName SetOutputOnlyChangedLinesP] $::OutputOnlyChangedLinesP\
	     [SlaveName SelectProgramInitFile] $::program \
	     [SlaveName SetStandardLayoutP] $::StandardConfigurationP\
	     [SlaveName SubstitutionModeInitFileP] $::DoSubstitutionsP\
	     [SlaveName SetUseScrollbarsP] $::UseScrollbarsP\
	     [SlaveName SetBalloonHelpShowP]			$::BalloonHelpP \
	     [SlaveName SetDisplayConsonantChartColumnLabelsP]	$::DisplayConsonantChartColumnLabelsP \
	     [SlaveName SetDisplayConsonantChartRowLabelsP]	$::DisplayConsonantChartRowLabelsP \
	     [SlaveName SetDisplayVowelChartColumnLabelsP]	$::DisplayVowelChartColumnLabelsP \
	     [SlaveName SetDisplayVowelChartRowLabelsP]		$::DisplayVowelChartRowLabelsP \
	     [SlaveName SetUseScrollbarsP]			$::UseScrollbarsP \
	     [SlaveName SetAgrepBestResultsP]	$::ProgramInfo(agrep,BestResults) \
	     [SlaveName SetAgrepCaseInsensitiveP]	$::ProgramInfo(agrep,CaseInsensitiveP) \
	     [SlaveName SetAgrepErrorLimit]	$::ProgramInfo(agrep,TotalCost) \
	     [SlaveName SetAgrepDeletionCost]	$::ProgramInfo(agrep,DeletionCost) \
	     [SlaveName SetAgrepInsertionCost]	$::ProgramInfo(agrep,InsertionCost) \
	     [SlaveName SetAgrepSubstitutionCost]	$::ProgramInfo(agrep,SubstitutionCost) \
	     [SlaveName SetCgrepCaseInsensitiveP]	$::ProgramInfo(cgrep,CaseInsensitiveP) \
	     [SlaveName SetCgrepComplementP]	$::ProgramInfo(cgrep,Complement) \
	     [SlaveName SetCgrepTotalCost]	$::ProgramInfo(cgrep,TotalCost) \
	     [SlaveName SetCgrepInsertionCost]	$::ProgramInfo(cgrep,InsertionCost) \
	     [SlaveName SetCgrepDeletionCost]	$::ProgramInfo(cgrep,DeletionCost) \
	     [SlaveName SetCgrepSubstitutionCost]	$::ProgramInfo(cgrep,SubstitutionCost) \
	     [SlaveName SetEgrepCaseInsensitiveP]	$::ProgramInfo(egrep,CaseInsensitiveP) \
	     [SlaveName SetEgrepEmitMatchOnlyP]	$::ProgramInfo(egrep,EmitMatchOnly) \
	     [SlaveName SetEgrepComplementP]	$::ProgramInfo(egrep,Complement) \
	     [SlaveName SetEmacsFoldCaseMatchP]	$::ProgramInfo(emacs,FoldCaseMatchP) \
	     [SlaveName SetEmacsFoldCaseReplaceP]	$::ProgramInfo(emacs,FoldCaseReplaceP) \
	     [SlaveName SetFgrepCaseInsensitiveP]	$::ProgramInfo(fgrep,CaseInsensitiveP) \
	     [SlaveName SetFgrepEmitMatchOnlyP]	$::ProgramInfo(fgrep,EmitMatchOnly) \
	     [SlaveName SetFgrepComplementP]	$::ProgramInfo(fgrep,Complement) \
	     [SlaveName SetGawkCaseInsensitiveP]	$::ProgramInfo(gawk,CaseInsensitiveP) \
	     [SlaveName SetGawkIntervalExpressionsP]	$::ProgramInfo(gawk,IntervalExpressions) \
	     [SlaveName SetGawkNotation]	$::ProgramInfo(gawk,Notation) \
	     [SlaveName SetGlarkCaseInsensitiveP]	$::ProgramInfo(glark,CaseInsensitiveP) \
	     [SlaveName SetGlarkEmitMatchOnlyP]	$::ProgramInfo(glark,EmitMatchOnly) \
	     [SlaveName SetGlarkComplementP]	$::ProgramInfo(glark,Complement) \
	     [SlaveName SetGlarkMatchEntireLineP]	$::ProgramInfo(glark,MatchEntireLine) \
	     [SlaveName SetGrepCaseInsensitiveP]	$::ProgramInfo(grep,CaseInsensitiveP) \
	     [SlaveName SetGrepEmitMatchOnlyP]	$::ProgramInfo(grep,EmitMatchOnly) \
	     [SlaveName SetGrepComplementP]	$::ProgramInfo(grep,Complement) \
	     [SlaveName SetGrepNotation]	$::ProgramInfo(grep,Notation) \
	     [SlaveName SetJavaCanonEQP]	$::ProgramInfo(java,CanonEQ) \
	     [SlaveName SetJavaCaseInsensitiveP]	$::ProgramInfo(java,CaseInsensitiveP) \
	     [SlaveName SetJavaUnicodeCaseP]	$::ProgramInfo(java,UnicodeCase) \
	     [SlaveName SetJgrepCaseInsensitiveP]	$::ProgramInfo(jgrep,CaseInsensitiveP) \
	     [SlaveName SetNrgrepCaseInsensitiveP]	$::ProgramInfo(nrgrep,CaseInsensitiveP) \
	     [SlaveName SetNrgrepComplementP]	$::ProgramInfo(nrgrep,ComplementP) \
	     [SlaveName SetNrgrepTotalCost]	$::ProgramInfo(nrgrep,TotalCost) \
	     [SlaveName SetNrgrepInsertionsP]	$::ProgramInfo(nrgrep,InsertionsP) \
	     [SlaveName SetNrgrepDeletionsP]	$::ProgramInfo(nrgrep,DeletionsP) \
	     [SlaveName SetNrgrepSubstitutionsP]	$::ProgramInfo(nrgrep,SubstitutionsP) \
	     [SlaveName SetNrgrepTranspositionsP]	$::ProgramInfo(nrgrep,TranspositionsP) \
	     [SlaveName SetPerlUnicodeLocaleDependentP]	$::ProgramInfo(perl,UnicodeLocaleDependentP) \
	     [SlaveName SetPythonRawStringP]	$::ProgramInfo(python,RawStringP) \
	     [SlaveName SetSedExtendedRegexpP]	$::ProgramInfo(sed,ExtendedRegexp) \
	     [SlaveName SetTclCaseInsensitiveP]	$::ProgramInfo(tcl,CaseInsensitiveP) \
	     [SlaveName SetTclExpandedP]	$::ProgramInfo(tcl,ExpandedP) \
	     [SlaveName SetTrComplementP]	$::ProgramInfo(tr,Complement) \
	     [SlaveName SetTrSqueezeP]	$::ProgramInfo(tr,Squeeze) \
	     [SlaveName SetTrTruncateP]	$::ProgramInfo(tr,Truncate) \
	     [SlaveName SetShellItemLimit]	$::ShellItemLimit]
    set cl [list]
    foreach {command value} $MiscellaneousInitCommandList {
	lappend cl [format "%s %s" $command $value]
    }
    foreach title [array names ::SpecialCharacterPalette] {
	if {[string match "*WidgetName" $title]} {continue}
	set info $::SpecialCharacterPalette($title);
	if {[llength $info] > 2} {
	    lappend cl [list ReadCharacterChart [lindex $info 2]];
	} else {
	    lappend cl [ReconstructCharacterChartDefinition $title];
	}
    }
    return $cl;
}

proc ReconstructCharacterChartDefinition {Title} {
    set info $::SpecialCharacterPalette($Title);
    set txt DefineCharacterChart;
    append txt " \{\n"
    append txt [format "%s" [Quote $Title]]
    set flds [llength $info];
    if {$flds > 1} {
	append txt [format "|%d" [lindex $info 1]];# Number of columns
    }
    if {$flds > 2} {
	append txt [format "|%s" [lindex $info 2]];# Font family
    }
    if {$flds > 3} {
	append txt [format "|%s" [lindex $info 3]];# Font size
    }
    append txt "\n"
    #Each entry consists of a unicode string and a gloss
    foreach x [lindex $info 0] {
	set string [lindex $x 0]
	set gloss  [lindex $x 1]
	append txt [format "%s|%s\n" [UnicodeStringToHex $string] [Quote $gloss]];
    }
    append txt "\}"
    return  $txt;
}

#This is a kludge but I encountered quoting hell trying to use (\\s) -> \\ \\1
#e.g.   regsub -all "\\s" $s {\ } r

#Escape spaces and tabs
proc Quote {s} {
    regsub -all "\u0020" $s {\ } r
    regsub -all "\t" $r {\	} ret
    return $ret
}

proc UnicodeStringToHex {s} {
    set rv "";
    foreach c [split $s ""] {
	scan $c "%c" t
	if {$t <= 0xFF} {
	    append rv $c;
	} else {
	    append rv [format "\\u%04X" $t];
	}
    }
    return $rv;
 }

#This package defines a routine IsColorSpecQ that validates X11 color specifications.
#It returns 1 if its argument is either a recognized X11 color name or
#a well formed hexadecimal RGB specification. If so desired, the two routines on
#which it is based, IsColorNameQ and IsColorNumericQ can also be exported.
namespace eval validcolor {
    namespace export IsColorSpecQ;
    variable CN;

    set CN([list ghost white]) 1
    set CN([list white smoke]) 1
    set CN([list floral white]) 1
    set CN([list antique white]) 1
    set CN([list old lace]) 1
    set CN([list papaya whip]) 1
    set CN([list blanched almond]) 1
    set CN([list peach puff]) 1
    set CN([list navajo white]) 1
    set CN([list lemon chiffon]) 1
    set CN([list mint cream]) 1
    set CN([list alice blue]) 1
    set CN([list lavender blush]) 1
    set CN([list misty rose]) 1
    set CN([list dark slate gray]) 1
    set CN([list dark slate grey]) 1
    set CN([list dim gray]) 1
    set CN([list dim grey]) 1
    set CN([list slate gray]) 1
    set CN([list slate grey]) 1
    set CN([list light slate gray]) 1
    set CN([list light slate grey]) 1
    set CN([list light grey]) 1
    set CN([list light gray]) 1
    set CN([list midnight blue]) 1
    set CN([list navy blue]) 1
    set CN([list cornflower blue]) 1
    set CN([list dark slate blue]) 1
    set CN([list slate blue]) 1
    set CN([list medium slate blue]) 1
    set CN([list light slate blue]) 1
    set CN([list medium blue]) 1
    set CN([list royal blue]) 1
    set CN([list dodger blue]) 1
    set CN([list deep sky blue]) 1
    set CN([list sky blue]) 1
    set CN([list light sky blue]) 1
    set CN([list steel blue]) 1
    set CN([list light steel blue]) 1
    set CN([list light blue]) 1
    set CN([list powder blue]) 1
    set CN([list pale turquoise]) 1
    set CN([list dark turquoise]) 1
    set CN([list medium turquoise]) 1
    set CN([list light cyan]) 1
    set CN([list cadet blue]) 1
    set CN([list medium aquamarine]) 1
    set CN([list dark green]) 1
    set CN([list dark olive green]) 1
    set CN([list dark sea green]) 1
    set CN([list sea green]) 1
    set CN([list medium sea green]) 1
    set CN([list light sea green]) 1
    set CN([list pale green]) 1
    set CN([list spring green]) 1
    set CN([list lawn green]) 1
    set CN([list medium spring green]) 1
    set CN([list green yellow]) 1
    set CN([list lime green]) 1
    set CN([list yellow green]) 1
    set CN([list forest green]) 1
    set CN([list olive drab]) 1
    set CN([list dark khaki]) 1
    set CN([list pale goldenrod]) 1
    set CN([list light goldenrod yellow]) 1
    set CN([list light yellow]) 1
    set CN([list light goldenrod]) 1
    set CN([list dark goldenrod]) 1
    set CN([list rosy brown]) 1
    set CN([list indian red]) 1
    set CN([list saddle brown]) 1
    set CN([list sandy brown]) 1
    set CN([list dark salmon]) 1
    set CN([list light salmon]) 1
    set CN([list dark orange]) 1
    set CN([list light coral]) 1
    set CN([list orange red]) 1
    set CN([list hot pink]) 1
    set CN([list deep pink]) 1
    set CN([list light pink]) 1
    set CN([list pale violet red]) 1
    set CN([list medium violet red]) 1
    set CN([list violet red]) 1
    set CN([list medium orchid]) 1
    set CN([list dark orchid]) 1
    set CN([list dark violet]) 1
    set CN([list blue violet]) 1
    set CN([list medium purple]) 1
    set CN(snow) 1
    set CN(GhostWhite) 1
    set CN(WhiteSmoke) 1
    set CN(gainsboro) 1
    set CN(FloralWhite) 1
    set CN(OldLace) 1
    set CN(linen) 1
    set CN(AntiqueWhite) 1
    set CN(PapayaWhip) 1
    set CN(BlanchedAlmond) 1
    set CN(bisque) 1
    set CN(PeachPuff) 1
    set CN(NavajoWhite) 1
    set CN(moccasin) 1
    set CN(cornsilk) 1
    set CN(ivory) 1
    set CN(LemonChiffon) 1
    set CN(seashell) 1
    set CN(honeydew) 1
    set CN(MintCream) 1
    set CN(azure) 1
    set CN(AliceBlue) 1
    set CN(lavender) 1
    set CN(LavenderBlush) 1
    set CN(MistyRose) 1
    set CN(white) 1
    set CN(black) 1
    set CN(DarkSlateGray) 1
    set CN(DarkSlateGrey) 1
    set CN(DimGray) 1
    set CN(DimGrey) 1
    set CN(SlateGray) 1
    set CN(SlateGrey) 1
    set CN(LightSlateGray) 1
    set CN(LightSlateGrey) 1
    set CN(gray) 1
    set CN(grey) 1
    set CN(LightGrey) 1
    set CN(LightGray) 1
    set CN(MidnightBlue) 1
    set CN(navy) 1
    set CN(NavyBlue) 1
    set CN(CornflowerBlue) 1
    set CN(DarkSlateBlue) 1
    set CN(SlateBlue) 1
    set CN(MediumSlateBlue) 1
    set CN(LightSlateBlue) 1
    set CN(MediumBlue) 1
    set CN(RoyalBlue) 1
    set CN(blue) 1
    set CN(DodgerBlue) 1
    set CN(DeepSkyBlue) 1
    set CN(SkyBlue) 1
    set CN(LightSkyBlue) 1
    set CN(SteelBlue) 1
    set CN(LightSteelBlue) 1
    set CN(LightBlue) 1
    set CN(PowderBlue) 1
    set CN(PaleTurquoise) 1
    set CN(DarkTurquoise) 1
    set CN(MediumTurquoise) 1
    set CN(turquoise) 1
    set CN(cyan) 1
    set CN(LightCyan) 1
    set CN(CadetBlue) 1
    set CN(MediumAquamarine) 1
    set CN(aquamarine) 1
    set CN(DarkGreen) 1
    set CN(DarkOliveGreen) 1
    set CN(DarkSeaGreen) 1
    set CN(SeaGreen) 1
    set CN(MediumSeaGreen) 1
    set CN(LightSeaGreen) 1
    set CN(PaleGreen) 1
    set CN(SpringGreen) 1
    set CN(LawnGreen) 1
    set CN(green) 1
    set CN(chartreuse) 1
    set CN(MediumSpringGreen) 1
    set CN(GreenYellow) 1
    set CN(LimeGreen) 1
    set CN(YellowGreen) 1
    set CN(ForestGreen) 1
    set CN(OliveDrab) 1
    set CN(DarkKhaki) 1
    set CN(khaki) 1
    set CN(PaleGoldenrod) 1
    set CN(LightGoldenrodYellow) 1
    set CN(LightYellow) 1
    set CN(yellow) 1
    set CN(gold) 1
    set CN(LightGoldenrod) 1
    set CN(goldenrod) 1
    set CN(DarkGoldenrod) 1
    set CN(RosyBrown) 1
    set CN(IndianRed) 1
    set CN(SaddleBrown) 1
    set CN(sienna) 1
    set CN(peru) 1
    set CN(burlywood) 1
    set CN(beige) 1
    set CN(wheat) 1
    set CN(SandyBrown) 1
    set CN(tan) 1
    set CN(chocolate) 1
    set CN(firebrick) 1
    set CN(brown) 1
    set CN(DarkSalmon) 1
    set CN(salmon) 1
    set CN(LightSalmon) 1
    set CN(orange) 1
    set CN(DarkOrange) 1
    set CN(coral) 1
    set CN(LightCoral) 1
    set CN(tomato) 1
    set CN(OrangeRed) 1
    set CN(red) 1
    set CN(HotPink) 1
    set CN(DeepPink) 1
    set CN(pink) 1
    set CN(LightPink) 1
    set CN(PaleVioletRed) 1
    set CN(maroon) 1
    set CN(MediumVioletRed) 1
    set CN(VioletRed) 1
    set CN(magenta) 1
    set CN(violet) 1
    set CN(plum) 1
    set CN(orchid) 1
    set CN(MediumOrchid) 1
    set CN(DarkOrchid) 1
    set CN(DarkViolet) 1
    set CN(BlueViolet) 1
    set CN(purple) 1
    set CN(MediumPurple) 1
    set CN(thistle) 1
    set CN(snow1) 1
    set CN(snow2) 1
    set CN(snow3) 1
    set CN(snow4) 1
    set CN(seashell1) 1
    set CN(seashell2) 1
    set CN(seashell3) 1
    set CN(seashell4) 1
    set CN(AntiqueWhite1) 1
    set CN(AntiqueWhite2) 1
    set CN(AntiqueWhite3) 1
    set CN(AntiqueWhite4) 1
    set CN(bisque1) 1
    set CN(bisque2) 1
    set CN(bisque3) 1
    set CN(bisque4) 1
    set CN(PeachPuff1) 1
    set CN(PeachPuff2) 1
    set CN(PeachPuff3) 1
    set CN(PeachPuff4) 1
    set CN(NavajoWhite1) 1
    set CN(NavajoWhite2) 1
    set CN(NavajoWhite3) 1
    set CN(NavajoWhite4) 1
    set CN(LemonChiffon1) 1
    set CN(LemonChiffon2) 1
    set CN(LemonChiffon3) 1
    set CN(LemonChiffon4) 1
    set CN(cornsilk1) 1
    set CN(cornsilk2) 1
    set CN(cornsilk3) 1
    set CN(cornsilk4) 1
    set CN(ivory1) 1
    set CN(ivory2) 1
    set CN(ivory3) 1
    set CN(ivory4) 1
    set CN(honeydew1) 1
    set CN(honeydew2) 1
    set CN(honeydew3) 1
    set CN(honeydew4) 1
    set CN(LavenderBlush1) 1
    set CN(LavenderBlush2) 1
    set CN(LavenderBlush3) 1
    set CN(LavenderBlush4) 1
    set CN(MistyRose1) 1
    set CN(MistyRose2) 1
    set CN(MistyRose3) 1
    set CN(MistyRose4) 1
    set CN(azure1) 1
    set CN(azure2) 1
    set CN(azure3) 1
    set CN(azure4) 1
    set CN(SlateBlue1) 1
    set CN(SlateBlue2) 1
    set CN(SlateBlue3) 1
    set CN(SlateBlue4) 1
    set CN(RoyalBlue1) 1
    set CN(RoyalBlue2) 1
    set CN(RoyalBlue3) 1
    set CN(RoyalBlue4) 1
    set CN(blue1) 1
    set CN(blue2) 1
    set CN(blue3) 1
    set CN(blue4) 1
    set CN(DodgerBlue1) 1
    set CN(DodgerBlue2) 1
    set CN(DodgerBlue3) 1
    set CN(DodgerBlue4) 1
    set CN(SteelBlue1) 1
    set CN(SteelBlue2) 1
    set CN(SteelBlue3) 1
    set CN(SteelBlue4) 1
    set CN(DeepSkyBlue1) 1
    set CN(DeepSkyBlue2) 1
    set CN(DeepSkyBlue3) 1
    set CN(DeepSkyBlue4) 1
    set CN(SkyBlue1) 1
    set CN(SkyBlue2) 1
    set CN(SkyBlue3) 1
    set CN(SkyBlue4) 1
    set CN(LightSkyBlue1) 1
    set CN(LightSkyBlue2) 1
    set CN(LightSkyBlue3) 1
    set CN(LightSkyBlue4) 1
    set CN(SlateGray1) 1
    set CN(SlateGray2) 1
    set CN(SlateGray3) 1
    set CN(SlateGray4) 1
    set CN(LightSteelBlue1) 1
    set CN(LightSteelBlue2) 1
    set CN(LightSteelBlue3) 1
    set CN(LightSteelBlue4) 1
    set CN(LightBlue1) 1
    set CN(LightBlue2) 1
    set CN(LightBlue3) 1
    set CN(LightBlue4) 1
    set CN(LightCyan1) 1
    set CN(LightCyan2) 1
    set CN(LightCyan3) 1
    set CN(LightCyan4) 1
    set CN(PaleTurquoise1) 1
    set CN(PaleTurquoise2) 1
    set CN(PaleTurquoise3) 1
    set CN(PaleTurquoise4) 1
    set CN(CadetBlue1) 1
    set CN(CadetBlue2) 1
    set CN(CadetBlue3) 1
    set CN(CadetBlue4) 1
    set CN(turquoise1) 1
    set CN(turquoise2) 1
    set CN(turquoise3) 1
    set CN(turquoise4) 1
    set CN(cyan1) 1
    set CN(cyan2) 1
    set CN(cyan3) 1
    set CN(cyan4) 1
    set CN(DarkSlateGray1) 1
    set CN(DarkSlateGray2) 1
    set CN(DarkSlateGray3) 1
    set CN(DarkSlateGray4) 1
    set CN(aquamarine1) 1
    set CN(aquamarine2) 1
    set CN(aquamarine3) 1
    set CN(aquamarine4) 1
    set CN(DarkSeaGreen1) 1
    set CN(DarkSeaGreen2) 1
    set CN(DarkSeaGreen3) 1
    set CN(DarkSeaGreen4) 1
    set CN(SeaGreen1) 1
    set CN(SeaGreen2) 1
    set CN(SeaGreen3) 1
    set CN(SeaGreen4) 1
    set CN(PaleGreen1) 1
    set CN(PaleGreen2) 1
    set CN(PaleGreen3) 1
    set CN(PaleGreen4) 1
    set CN(SpringGreen1) 1
    set CN(SpringGreen2) 1
    set CN(SpringGreen3) 1
    set CN(SpringGreen4) 1
    set CN(green1) 1
    set CN(green2) 1
    set CN(green3) 1
    set CN(green4) 1
    set CN(chartreuse1) 1
    set CN(chartreuse2) 1
    set CN(chartreuse3) 1
    set CN(chartreuse4) 1
    set CN(OliveDrab1) 1
    set CN(OliveDrab2) 1
    set CN(OliveDrab3) 1
    set CN(OliveDrab4) 1
    set CN(DarkOliveGreen1) 1
    set CN(DarkOliveGreen2) 1
    set CN(DarkOliveGreen3) 1
    set CN(DarkOliveGreen4) 1
    set CN(khaki1) 1
    set CN(khaki2) 1
    set CN(khaki3) 1
    set CN(khaki4) 1
    set CN(LightGoldenrod1) 1
    set CN(LightGoldenrod2) 1
    set CN(LightGoldenrod3) 1
    set CN(LightGoldenrod4) 1
    set CN(LightYellow1) 1
    set CN(LightYellow2) 1
    set CN(LightYellow3) 1
    set CN(LightYellow4) 1
    set CN(yellow1) 1
    set CN(yellow2) 1
    set CN(yellow3) 1
    set CN(yellow4) 1
    set CN(gold1) 1
    set CN(gold2) 1
    set CN(gold3) 1
    set CN(gold4) 1
    set CN(goldenrod1) 1
    set CN(goldenrod2) 1
    set CN(goldenrod3) 1
    set CN(goldenrod4) 1
    set CN(DarkGoldenrod1) 1
    set CN(DarkGoldenrod2) 1
    set CN(DarkGoldenrod3) 1
    set CN(DarkGoldenrod4) 1
    set CN(RosyBrown1) 1
    set CN(RosyBrown2) 1
    set CN(RosyBrown3) 1
    set CN(RosyBrown4) 1
    set CN(IndianRed1) 1
    set CN(IndianRed2) 1
    set CN(IndianRed3) 1
    set CN(IndianRed4) 1
    set CN(sienna1) 1
    set CN(sienna2) 1
    set CN(sienna3) 1
    set CN(sienna4) 1
    set CN(burlywood1) 1
    set CN(burlywood2) 1
    set CN(burlywood3) 1
    set CN(burlywood4) 1
    set CN(wheat1) 1
    set CN(wheat2) 1
    set CN(wheat3) 1
    set CN(wheat4) 1
    set CN(tan1) 1
    set CN(tan2) 1
    set CN(tan3) 1
    set CN(tan4) 1
    set CN(chocolate1) 1
    set CN(chocolate2) 1
    set CN(chocolate3) 1
    set CN(chocolate4) 1
    set CN(firebrick1) 1
    set CN(firebrick2) 1
    set CN(firebrick3) 1
    set CN(firebrick4) 1
    set CN(brown1) 1
    set CN(brown2) 1
    set CN(brown3) 1
    set CN(brown4) 1
    set CN(salmon1) 1
    set CN(salmon2) 1
    set CN(salmon3) 1
    set CN(salmon4) 1
    set CN(LightSalmon1) 1
    set CN(LightSalmon2) 1
    set CN(LightSalmon3) 1
    set CN(LightSalmon4) 1
    set CN(orange1) 1
    set CN(orange2) 1
    set CN(orange3) 1
    set CN(orange4) 1
    set CN(DarkOrange1) 1
    set CN(DarkOrange2) 1
    set CN(DarkOrange3) 1
    set CN(DarkOrange4) 1
    set CN(coral1) 1
    set CN(coral2) 1
    set CN(coral3) 1
    set CN(coral4) 1
    set CN(tomato1) 1
    set CN(tomato2) 1
    set CN(tomato3) 1
    set CN(tomato4) 1
    set CN(OrangeRed1) 1
    set CN(OrangeRed2) 1
    set CN(OrangeRed3) 1
    set CN(OrangeRed4) 1
    set CN(red1) 1
    set CN(red2) 1
    set CN(red3) 1
    set CN(red4) 1
    set CN(DeepPink1) 1
    set CN(DeepPink2) 1
    set CN(DeepPink3) 1
    set CN(DeepPink4) 1
    set CN(HotPink1) 1
    set CN(HotPink2) 1
    set CN(HotPink3) 1
    set CN(HotPink4) 1
    set CN(pink1) 1
    set CN(pink2) 1
    set CN(pink3) 1
    set CN(pink4) 1
    set CN(LightPink1) 1
    set CN(LightPink2) 1
    set CN(LightPink3) 1
    set CN(LightPink4) 1
    set CN(PaleVioletRed1) 1
    set CN(PaleVioletRed2) 1
    set CN(PaleVioletRed3) 1
    set CN(PaleVioletRed4) 1
    set CN(maroon1) 1
    set CN(maroon2) 1
    set CN(maroon3) 1
    set CN(maroon4) 1
    set CN(VioletRed1) 1
    set CN(VioletRed2) 1
    set CN(VioletRed3) 1
    set CN(VioletRed4) 1
    set CN(magenta1) 1
    set CN(magenta2) 1
    set CN(magenta3) 1
    set CN(magenta4) 1
    set CN(orchid1) 1
    set CN(orchid2) 1
    set CN(orchid3) 1
    set CN(orchid4) 1
    set CN(plum1) 1
    set CN(plum2) 1
    set CN(plum3) 1
    set CN(plum4) 1
    set CN(MediumOrchid1) 1
    set CN(MediumOrchid2) 1
    set CN(MediumOrchid3) 1
    set CN(MediumOrchid4) 1
    set CN(DarkOrchid1) 1
    set CN(DarkOrchid2) 1
    set CN(DarkOrchid3) 1
    set CN(DarkOrchid4) 1
    set CN(purple1) 1
    set CN(purple2) 1
    set CN(purple3) 1
    set CN(purple4) 1
    set CN(MediumPurple1) 1
    set CN(MediumPurple2) 1
    set CN(MediumPurple3) 1
    set CN(MediumPurple4) 1
    set CN(thistle1) 1
    set CN(thistle2) 1
    set CN(thistle3) 1
    set CN(thistle4) 1
    set CN(gray0) 1
    set CN(grey0) 1
    set CN(gray1) 1
    set CN(grey1) 1
    set CN(gray2) 1
    set CN(grey2) 1
    set CN(gray3) 1
    set CN(grey3) 1
    set CN(gray4) 1
    set CN(grey4) 1
    set CN(gray5) 1
    set CN(grey5) 1
    set CN(gray6) 1
    set CN(grey6) 1
    set CN(gray7) 1
    set CN(grey7) 1
    set CN(gray8) 1
    set CN(grey8) 1
    set CN(gray9) 1
    set CN(grey9) 1
    set CN(gray10) 1
    set CN(grey10) 1
    set CN(gray11) 1
    set CN(grey11) 1
    set CN(gray12) 1
    set CN(grey12) 1
    set CN(gray13) 1
    set CN(grey13) 1
    set CN(gray14) 1
    set CN(grey14) 1
    set CN(gray15) 1
    set CN(grey15) 1
    set CN(gray16) 1
    set CN(grey16) 1
    set CN(gray17) 1
    set CN(grey17) 1
    set CN(gray18) 1
    set CN(grey18) 1
    set CN(gray19) 1
    set CN(grey19) 1
    set CN(gray20) 1
    set CN(grey20) 1
    set CN(gray21) 1
    set CN(grey21) 1
    set CN(gray22) 1
    set CN(grey22) 1
    set CN(gray23) 1
    set CN(grey23) 1
    set CN(gray24) 1
    set CN(grey24) 1
    set CN(gray25) 1
    set CN(grey25) 1
    set CN(gray26) 1
    set CN(grey26) 1
    set CN(gray27) 1
    set CN(grey27) 1
    set CN(gray28) 1
    set CN(grey28) 1
    set CN(gray29) 1
    set CN(grey29) 1
    set CN(gray30) 1
    set CN(grey30) 1
    set CN(gray31) 1
    set CN(grey31) 1
    set CN(gray32) 1
    set CN(grey32) 1
    set CN(gray33) 1
    set CN(grey33) 1
    set CN(gray34) 1
    set CN(grey34) 1
    set CN(gray35) 1
    set CN(grey35) 1
    set CN(gray36) 1
    set CN(grey36) 1
    set CN(gray37) 1
    set CN(grey37) 1
    set CN(gray38) 1
    set CN(grey38) 1
    set CN(gray39) 1
    set CN(grey39) 1
    set CN(gray40) 1
    set CN(grey40) 1
    set CN(gray41) 1
    set CN(grey41) 1
    set CN(gray42) 1
    set CN(grey42) 1
    set CN(gray43) 1
    set CN(grey43) 1
    set CN(gray44) 1
    set CN(grey44) 1
    set CN(gray45) 1
    set CN(grey45) 1
    set CN(gray46) 1
    set CN(grey46) 1
    set CN(gray47) 1
    set CN(grey47) 1
    set CN(gray48) 1
    set CN(grey48) 1
    set CN(gray49) 1
    set CN(grey49) 1
    set CN(gray50) 1
    set CN(grey50) 1
    set CN(gray51) 1
    set CN(grey51) 1
    set CN(gray52) 1
    set CN(grey52) 1
    set CN(gray53) 1
    set CN(grey53) 1
    set CN(gray54) 1
    set CN(grey54) 1
    set CN(gray55) 1
    set CN(grey55) 1
    set CN(gray56) 1
    set CN(grey56) 1
    set CN(gray57) 1
    set CN(grey57) 1
    set CN(gray58) 1
    set CN(grey58) 1
    set CN(gray59) 1
    set CN(grey59) 1
    set CN(gray60) 1
    set CN(grey60) 1
    set CN(gray61) 1
    set CN(grey61) 1
    set CN(gray62) 1
    set CN(grey62) 1
    set CN(gray63) 1
    set CN(grey63) 1
    set CN(gray64) 1
    set CN(grey64) 1
    set CN(gray65) 1
    set CN(grey65) 1
    set CN(gray66) 1
    set CN(grey66) 1
    set CN(gray67) 1
    set CN(grey67) 1
    set CN(gray68) 1
    set CN(grey68) 1
    set CN(gray69) 1
    set CN(grey69) 1
    set CN(gray70) 1
    set CN(grey70) 1
    set CN(gray71) 1
    set CN(grey71) 1
    set CN(gray72) 1
    set CN(grey72) 1
    set CN(gray73) 1
    set CN(grey73) 1
    set CN(gray74) 1
    set CN(grey74) 1
    set CN(gray75) 1
    set CN(grey75) 1
    set CN(gray76) 1
    set CN(grey76) 1
    set CN(gray77) 1
    set CN(grey77) 1
    set CN(gray78) 1
    set CN(grey78) 1
    set CN(gray79) 1
    set CN(grey79) 1
    set CN(gray80) 1
    set CN(grey80) 1
    set CN(gray81) 1
    set CN(grey81) 1
    set CN(gray82) 1
    set CN(grey82) 1
    set CN(gray83) 1
    set CN(grey83) 1
    set CN(gray84) 1
    set CN(grey84) 1
    set CN(gray85) 1
    set CN(grey85) 1
    set CN(gray86) 1
    set CN(grey86) 1
    set CN(gray87) 1
    set CN(grey87) 1
    set CN(gray88) 1
    set CN(grey88) 1
    set CN(gray89) 1
    set CN(grey89) 1
    set CN(gray90) 1
    set CN(grey90) 1
    set CN(gray91) 1
    set CN(grey91) 1
    set CN(gray92) 1
    set CN(grey92) 1
    set CN(gray93) 1
    set CN(grey93) 1
    set CN(gray94) 1
    set CN(grey94) 1
    set CN(gray95) 1
    set CN(grey95) 1
    set CN(gray96) 1
    set CN(grey96) 1
    set CN(gray97) 1
    set CN(grey97) 1
    set CN(gray98) 1
    set CN(grey98) 1
    set CN(gray99) 1
    set CN(grey99) 1
    set CN(gray100) 1
    set CN(grey100) 1

    proc GetColorNames {} {
	variable CN
	return [lsort -dictionary [array names CN]]
    }

    proc IsColorNameQ {s} {
	variable CN
	if {[info exists CN($s)]} {
	    return 1;
	} else {
	    return 0;
	}
    }

    proc IsColorNumericQ {s} {
	return [regexp \
		    {^\#([[:xdigit:]]{6}|[[:xdigit:]]{3}|[[:xdigit:]]{9}|[[:xdigit:]]{12})$} $s]
    }
		
    proc IsColorSpecQ {s} {
	if {[IsColorNameQ $s]} {
	    return 1;
	} elseif {[IsColorNumericQ $s]} {
	    return 1;
	} else {
	    return 0;
	}
    }
}
#End of namespace validcolor

set OtherPopups(ColorNameList) "";
proc PopupColorNameList {} {
    if {[winfo exists $::OtherPopups(ColorNameList)]} {
	raise $::OtherPopups(ColorNameList);
	return ;
    }
    set po  [CreateTextDisplay [_ "Color Names"] 65 10];
    set ::OtherPopups(ColorNameList) $po;
    BindKeys $po;
    set n 0;
    foreach l [::validcolor::GetColorNames] {
	incr n;
	AppendToTextDisplay $po [format "\[%03d\] %s\n" $n $l];
    }
}

#Ths procedure takes as its sole argument the name
#of an existing procedure in the same interpreter
#and creates a new master level procedure that
#wraps the other procedure with a test for the
#correct argument count.

proc WrapMaster {pn} {
    regsub "^::fontsel::" $pn "" Stem
    set WrappedName Wrapped${Stem};
    set sp [format "proc $WrappedName \{args\} \{\n"];
    set ArgsNeeded [llength [info args $pn]];
    append sp [format "\tif \{\[llength \$args\] != %d\} \{\n" $ArgsNeeded]
    if {$ArgsNeeded == 1} {
	set emsg [format [_ "The command %s in the file %%s expects one argument"] \
	[SlaveName $WrappedName]]
	set cmd [format "\t\tputs \"$emsg\"\n" \$::InitFile]
	append sp $cmd
    } else {
	set emsg [format [_ "The command %s in the file %%s expects %d arguments\n"] \
	      [SlaveName $WrappedName] $ArgsNeeded]
	set cmd [format "\t\tputs \"$emsg\"\n" \$::InitFile]; 
	append sp $cmd;
    }
    append sp "\t\treturn;\n\t\}\n\t"
    append sp  $pn
    for {set i 0} {$i < $ArgsNeeded} {incr i} {
	append sp " \[lindex \$args $i\]"
    }
    append sp "\n\}"
    eval $sp;
    return $WrappedName;
}

proc ReadInitFile {name} {
    if { [catch {interp invoke init source $name} msg] } {
	puts [format [_  "Error on reading init file %s: %s"] $name $msg]
    } else {
	ShowMessage [format [_ "Executed init file %s"] $name]
    }
    interp delete init
}

proc SlavePuts {msg} {
    puts $msg;
}

proc SlaveMsgcat {} {
    package require msgcat
    ::msgcat::mcload [file join [file dirname [info script]] msgs];
}

#This is the list of the master interpreter commands
#other than those generated from data structures (currently
#color- and font-setting) that we wish to expose for use in
#the init file slave interpreter.
set MiscellaneousSlaveCommandList {
    ReadFeatureList
    SetAutoClearRegexpP
    SetBalloonHelpShowP
    SetDisplayConsonantChartColumnLabelsP
    SetDisplayConsonantChartRowLabelsP
    SetDisplayVowelChartColumnLabelsP
    SetDisplayVowelChartRowLabelsP
    SelectBrowser
    StoreCustomCharacterChartInPlace
    SetFocusFollowsMouseP
    SetHistoryCentralP
    SetHistoryIncludeProgramP
    SetOutputOnlyChangedLinesP
    AddUserPaletteEntry
    SelectProgramInitFile
    StoreCustomCharacterChartFileName
    SetStandardLayoutP
    SubstitutionModeInitFileP
    SetUseScrollbarsP
    SetAgrepCaseInsensitiveP
    SetAgrepBestResultsP
    SetAgrepErrorLimit
    SetAgrepDeletionCost
    SetAgrepInsertionCost
    SetAgrepSubstitutionCost
    SetCgrepCaseInsensitiveP
    SetCgrepComplementP
    SetCgrepTotalCost
    SetCgrepInsertionCost
    SetCgrepDeletionCost
    SetCgrepSubstitutionCost
    SetEgrepCaseInsensitiveP
    SetEgrepEmitMatchOnlyP
    SetEgrepComplementP
    SetEmacsFoldCaseMatchP 
    SetEmacsFoldCaseReplaceP 
    SetFgrepCaseInsensitiveP
    SetFgrepEmitMatchOnlyP
    SetFgrepComplementP
    SetGawkCaseInsensitiveP
    SetGawkIntervalExpressionsP
    SetGawkNotation
    SetGlarkCaseInsensitiveP
    SetGlarkEmitMatchOnlyP
    SetGlarkComplementP
    SetGlarkMatchEntireLineP
    SetGrepCaseInsensitiveP
    SetGrepEmitMatchOnlyP
    SetGrepComplementP
    SetGrepNotation
    SetJavaCanonEQP
    SetJavaCaseInsensitiveP
    SetJavaUnicodeCaseP
    SetJgrepCaseInsensitiveP
    SetNrgrepCaseInsensitiveP
    SetNrgrepComplementP
    SetNrgrepTotalCost
    SetNrgrepInsertionsP
    SetNrgrepDeletionsP
    SetNrgrepSubstitutionsP
    SetNrgrepTranspositionsP
    SetPerlUnicodeLocaleDependentP
    SetPythonRawStringP
    SetSedExtendedRegexpP
    SetTclCaseInsensitiveP
    SetTclExpandedP
    SetTrComplementP
    SetTrSqueezeP
    SetTrTruncateP
    SetShellItemLimit
}
#Puts SlavePuts

#This procedure creates the master procedures that will be exposed
#in the slave interpreter. It takes care of creating the base procedures
#where, as in the case of color and font setting, these are created
#programmatically, then wraps these as well as the manually
#written procedures that are to be exposed.
proc CreateInitProcs {} {
    set ::FontProcList "";
    fontsel::DefineFontSettingProcs
    DefineColorSettingProcs;
    #This is the complete list of commands that we want to expose 
    #in the slave init file interpreter. These are the raw, unwrapped, master
    #level commands.
    set ::MasterCommandsToBeExposedInInitList [concat \
	   [lsort $::ColorProcList] \
	   [lsort $::FontProcList]  \
	   [lsort $::MiscellaneousSlaveCommandList]];
    #Now we wrap them all so as to trap valence errors
    set ::WrappedMasterCommandList [list]
    foreach c $::MasterCommandsToBeExposedInInitList {
	lappend ::WrappedMasterCommandList [WrapMaster $c]
    }
}

#This procedure takes the list of wrapped master
#procedures and exposes them in a specified, already
#created, slave interpreter.
proc ExposeInitProcs {Interpreter} {
    foreach c $::WrappedMasterCommandList {
	set sl [SlaveName $c];
	$Interpreter alias $sl $c;
    }
}

set MasterToSlaveName(SetDisplayConsonantChartColumnLabelsP) ShowConsonantChartColumnLabelsP
set MasterToSlaveName(SetDisplayConsonantChartRowLabelsP) ShowConsonantChartRowLabelsP
set MasterToSlaveName(SetDisplayVowelChartColumnLabelsP) ShowVowelChartColumnLabelsP
set MasterToSlaveName(SetDisplayVowelChartRowLabelsP) ShowVowelChartRowLabelsP
set MasterToSlaveName(SelectProgramInitFile) Program;
set MasterToSlaveName(SelectBrowser) Browser;
set MasterToSlaveName(SlavePuts) Puts;
set MasterToSlaveName(StoreCustomCharacterChartInPlace) DefineCharacterChart 
set MasterToSlaveName(StoreCustomCharacterChartFileName) ReadCharacterChart 
set MasterToSlaveName(SubstitutionModeInitFileP) SubstitutionModeP

#Given the name of a wrapped command in the master interpreter,
#returns the name that the command is to have when
#exposed in the slave interpreter. In most cases the alias
#is computed from the master name, but in some cases
#the relationship is irregular. 
proc SlaveName {command} {
    regsub "^Wrapped" $command "" Unwrapped
    if {[info exists ::MasterToSlaveName($Unwrapped)]} {
	set EnglishSlaveName $::MasterToSlaveName($Unwrapped);
    } else {
	regsub "^Set" $Unwrapped "" EnglishSlaveName
    }
    return [_ $EnglishSlaveName]
}

proc InitFileSetup {} {
    interp create -safe -- init
    #We use slaveMsgcat rather than SlaveMsgcat so that the name does not
    #appear in the list that the user sees.
    init alias slaveMsgcat SlaveMsgcat
    init eval slaveMsgcat
    init alias mc _
    ExposeInitProcs init
    #This takes care of errors in the name of commands while still in the
    #slave interpreter, without aborting, and using the user-name in the error-message.
    init eval {
	proc unknown {args} {
	    set cmd [lindex $args 0]
	    Puts [format  [mc "Unknown command %s in script file %s."]  $cmd [info script]];
#	    Puts [format  [mc "Unknown command %1\$s in script file %2\$s."]  $cmd [info script]];
	    return ;
	}
    }
}

proc SlaveBoolean {s} {
    switch -regexp $s {
	1	{return 1}
	T.*	{return 1}
	t.*	{return 1}
	Y.*	{return 1}
	y.*	{return 1}
	ok	{return 1}
	on	{return 1}
	0 	{return 0}
	F.*	{return 0}
	f.*	{return 0}
	N.*	{return 0}
	n.*	{return 0}
	off	{return 0}
	default {
	    puts [format [_ "%s is not a Boolean argument."] $s]
	    return -1; 
	}
    }
}

#We can't just call SelectProgram from the init file
#because, for other reasons, we need to read the init
#file before enough of the infrastructure for SelectProgram
#is ready. We therefore just record the choice and execute
#SelectProgram later. 
proc SelectProgramInitFile {p} {
    set ::CommandLineProgram $p;
}

proc SubstitutionModeInitFileP {b} {
    set ::BeginInSubstitutionModeP [Boolean $b];
}


proc ReadFeatureList {args} {
    if {[llength $args]} {
	set fn [lindex $args 0]
    } else {
	set fn [tk_getOpenFile -title [_ "Read Feature List"]];
	if {[string equal $fn ""]} {
	    ShowMessage [_ "File selection cancelled."];
	    return ;
	}
    }
    if { [catch {open $fn "r"} fhd ] != 0} {
	ShowMessage [format [_ "Unable to open feature list %s."] [MinimizeFileName $fn]];
	return ;
    }
    set LineCnt 0
    while { [gets $fhd line] > 0} {
	if {$LineCnt == 0} {
	    set linep [split $line]
	    if {[llength $linep] != 2} {
		ShowMessage [_ "Header of file %s ill-formed."]
		close $fhd;
		return ;
	    }
	    set p [lindex $linep 0]
	    set l [lindex $linep 1]
	} else {
	    if {[scan $line "%s %s" Feature Value] != 2} {
		ShowMessage [format [_ "Ill-formed entry at line %d of file %s."] $LineCnt \
				 [MinimizeFileName $fn]]
		close $fhd;
		return
	    } else {
		set FTemp($Feature,$p,$l) $Value;
	    }
	}
	incr LineCnt;
    }
    close $fhd;
    if {$LineCnt < 1} {
	ShowMessage [_ "File %s is empty" [MinimizeFileName $fn]]
	return
    }
    foreach f [array names FTemp] {
	set ::Features($f) [Boolean $FTemp($f)]
    }
    SetCompoundFeatures;
    ShowMessage [format [_ "Read feature list for program %s in locale %s from %s."] $p $l \
		     [MinimizeFielName $fn]]
    if {[string equal $p $::program] && [string equal $l $::Locale]} {
	ConstructPalette;
    }
}

#New structure for UserPalette
#	UserPalette(Program,Name) -> [list Body Etext]

proc AddUserPaletteEntry {Which Name Body {EText ""}} {
    global UserPalette;
    incr UserPalette($Which,0);
    set UserPalette($Which,$Name) [list $Body [list $EText]];
}

proc PathToFileURL {p} {
    return [format "file://%s" $p];
}

#If the filename passed as argument is a pathname
#leading to a file in the current working directory,
#return just the basename+extension. Otherwise
#return the argument.
proc MinimizeFileName {s} {
    set cwd [pwd];
    set sdir [file dirname $s]
    if {[string equal $cwd $sdir]} {
	return [file tail $s]
    } else {
	return $s;
    }
}


#This is where the main action begins
#Entrypoint.


set HomeDir [GetHomeDir];
set ColorFullPath [file join $HomeDir $ColorFile];
set ScriptPath [info script];
if {$DebugP} {
    set ManualDirectory [file join [file dir $ScriptPath] Manual];
} else {
    set ManualDirectory [file join $NonBinPath Manual];
}
set ManualPath [file join $ManualDirectory Manual.html];
set ManualURL [PathToFileURL $ManualPath];

set Locale [::msgcat::mclocale];
LoadMessageCatalog;

#Open the journal file.
set JournalFullPath [file join $HomeDir $JournalFile];
if {[catch {open $JournalFullPath "a"} JournalHandle ] != 0} {
    puts [format [_ "Unable to open journal file %s."] $JournalFullPath];
    exit 2;
}
WriteJournal [format [_ "Session started: %s in directory %s"] [clock format [clock seconds]] [pwd]];

proc argshift {k} {
    set ::argv [lrange $::argv $k end];
}

set CommandLineUserClassFile "";
#Get command line arguments
while {[string match -* [lindex $argv 0]]} {
    switch -regexp -- [lindex $argv 0] {
	--?c.* {
	    set CommandLineUserClassFile [lindex $argv 1];
	    argshift 2;
	} 
	--?d.* {
	    set DebugP 1;
	    argshift 1;
	}
	--?F.* {
	    lappend FeatureFileList [lindex $argv 1]
	    argshift 2;
	} 
	--?f.* {
	    set PipeP 1;
	    argshift 1;
	}
	--?H.* {
	    set ReadHistoryFileP 0;
	    argshift 1;
	}
	--?h.* {
	    Usage;
	    exit 0;
	}
	--?i.* {
	    set ReadInitFileP 0;
	    argshift 1;
	}
	--?l.* {
	    set CommandLineLocale [lindex $argv 1];
	    argshift 2;
	    set nl [SetLocale $CommandLineLocale]
	    if {[string equal $nl ""] == 0} {
		set Locale $nl;
		LoadMessageCatalog;
	    }
	}
	--?n.* {
	    set FeatureTestP 0;
	    argshift 1;
	}
	--?p.* {
	    set CommandLineProgram [lindex $argv 1];
	    argshift 2;
	}
	--?s.* {
	    set BeginInSubstitutionModeP 1;
	    argshift 1
	}
	--?t.* {
	    set FeatureTestDebugP 1;
	    argshift 1
	}
	--?v.* {
	    puts "Redet $Version";
	    exit 0;
	}
	default {
	    puts [format [_ "Command line option %s not recognized."] [lindex $argv 0]];
	    Usage;
	    exit 0;
	}
    }
};					# End of while


foreach fn $FeatureFileList {
    ReadFeatureList $fn
}

puts "Redet $Version";
puts "Copyright (C) 2003-2006 William J. Poser.";
puts [_ "This program is free software; you can redistribute it
and/or modify it under the terms of the GNU General Public License
as published by the Free Software Foundation, either version 2
of the License, or (at your option) any later version."];

#If there is still a command line argument, it is a file to load as input data.
#We just record the name here as we don't want actually to read it until the windows
#are set up.
if { [llength $argv]} {
    set InitialTestInputDataFile [lindex $argv 0];
}
dmsg "About to create windows";
set PixelHeight 300;
wm geometry . =650x300+100+200
SetTitle $::Version [ProgramTimeDateStamp] $::Locale $::DoSubstitutionsP;
#wm title . [_ "Regular Expression Development and Execution Tool"];
set SideWidth [expr $MainWidth / 2];
wm withdraw [fontsel::CreateFontControlPanel]

CreateInitProcs;
if {$ReadInitFileP} {
    InitFileSetup;
    #Look first in current directory, then in home directory.
    if { [file exists $InitFile] } {
	ReadInitFile $InitFile;
    } else {
	set cwd [pwd];
	cd;
	if {[file exists $InitFile] } {
	    ReadInitFile $InitFile;
	}
	cd $cwd;
    }
}
fontsel::SetFontSelectionDefaults
fontsel::RecordDefaults;

option add *Menu.Background $ColorSpecs(Menu,Background) 100
option add *Menu.Foreground $ColorSpecs(Menu,Foreground) 100
option add *Menu*selectColor $ColorSpecs(Menu,Select) 100
option add *Menu.activeBackground $ColorSpecs(Menu,ActiveBackground) 100
option add *Menu.activeForeground  $ColorSpecs(Menu,ActiveForeground) 100

proc MacintoshNotes {} {
    global HelpPopups;
    if {[PopupDown Macintosh] ==1} {return}
    set po [CreateTextDisplay [_ "Notes for Macintosh Users"] 60 12]
    set HelpPopups(Macintosh) $po;
    AppendToTextDisplay $po [_ "This program works a bit differently on the Macintosh than on other platforms. One difference is in mouse usage. Several features of the program make use of right-clicks. Since the typical Macintosh uses a single-button mouse, if the program detects that it is running on a Macintosh, it interprets the combination Control-mouse click as equivalent to a right-click.\n\n"]
    AppendToTextDisplay $po [_ "The graphics/windowing system that Redet uses is Tk, for which two implementations are available under MacOSX. One implementation uses X11 as the underlying graphics and window system. This version of Tk is almost identical to the Unix version for which Redet was written. If you use this version of Tk, you should find that Redet looks and behaves just as described in the documentation, which is based in the first instance on the GNU/Linux version of Redet.\n\n"]
    AppendToTextDisplay $po [_ "The other implementation of Tk for MacOSX uses Aqua as the underlying graphics and window system. This version of Tk provides a more native Macintosh look and feel, at the expense of introducing differences between the look and behavior of programs under MacOSX and on other machines. In particular, the Macintosh user interface guidelines, which the Aqua implementation of Tk enforces, allow only menus, not commands, to be placed on the menu bar. As a result, if you are using Tk-Aqua, the File, Program, History, Tools, Configure and Help menus will appear on the Macintosh menu, while the Execute, Clear, and Palette buttons will appear in a row at the top of the Redet window.\n\n"]
    if {$::AquaP} {
	AppendToTextDisplay $po [_ "You are currently using the Aqua implementation of Tk. If you would prefer to have the standard interface for Redet, you will need to install the X11 implementation of Tk as well as X11 itself. As of the Tiger release of Mac OS X, X11 is provided on the distribution CD as an optional componenent."]
    } else {
	AppendToTextDisplay $po [_ "You are currently using the X11 implementation of Tk. This provides the standard interface to Redet. If you prefer a more native Macintosh look-and-feel you can switch to the Aqua implementation of Tk."]
    }
}

proc ProvideProgramInfo {} {
    global Version;
    global tcl_platform;
    set ProgramInfoPopup [CreateTextDisplay [_ "Programs"] 50 21];
    BindKeys $ProgramInfoPopup;
    AppendToTextDisplay $ProgramInfoPopup "Each program name is a link to information about the program\n\n\n";
    AppendLinkToTextDisplay $ProgramInfoPopup [_ "agrep (Wu-Manber)"] \
	{ShowWebPage ftp://ftp.cs.arizona.edu/agrep};
    AppendToTextDisplay $ProgramInfoPopup "\nWu-Manber agrep is a version of grep that provides for approximate matching, where matches deviating by no more than a specified amount from what the regular expression would otherwise have matched are accepted. The original version was developed by Sun Wu and Udi Manber at the University of Arizona around 1990. Several variants have arisen over the years and it has been ported to a wide range of platforms. TRE agrep provides some facilities that it does not, so if you are using Redet as a search tool TRE agrep is probably the better choice.";
    AppendToTextDisplay $ProgramInfoPopup "\n\n";
    AppendLinkToTextDisplay $ProgramInfoPopup [_ "agrep (TRE)"] \
	{ShowWebPage http://laurikari.net/tre};
    AppendToTextDisplay $ProgramInfoPopup "\nTRE agrep is the 'approximate grep' program provided with the TRE regular expression library. This library uses a new, fast regular expression matching algorithm and provides a particularly rich set of regular expression features while at the same time exhibiting better conformance to the POSIX standard than most other implementations. In addition to the standard regular expression constructs, it supports approximate matching. This means that you can associate costs with deviations from what the regular expression would otherwise have matched and request all matches that deviate by no more than a specified cost. Costs may be assigned separately to insertions, deletions, and substitutions on a group-specific basis. TRE agrep is therefore a good choice if you are using Redet as a search tool and the optimal choice if you need approximate matching.";
    AppendToTextDisplay $ProgramInfoPopup "\n\n";
    AppendLinkToTextDisplay $ProgramInfoPopup [_ "awk"] \
	{ShowWebPage http://cm.bell-labs.com/cm/cs/awkbook/};
    AppendToTextDisplay $ProgramInfoPopup "\nAwk is the classic Unix text processing language. An Awk program consists of a set of patterns with associated actions. Whenever the input matches a pattern, the corresponding action is executed. Awk automatically parses the input into records (by default lines, but changeable) and records into fields (by default, on whitespace, but changeable). Regular expressions are used both in patterns and, by means of calls to builtin functions, in actions.\n\nThere are a number of versions of Awk. The original version was developed at Bell Laboratories by Al Aho, Peter Weinberger, and Brian Kernighan. The link here is to this original version of Awk. Bell Labs later produced a revised version of Awk that is frequently called nawk. The link below is to a free, somewhat modernized version of nawk. What is probably the most widely used version today is gawk, the GNU project Awk implementation. Gawk is roughly comparable to the revised version of ATT Awk.Mawk is another free implementation roughly equivalent to ATT nawk. Note that other versions of Awk,such as Gawk and Nawk, are not infrequently named Awk rather than, or in addition to, Gawk or Nawk  .";
    AppendToTextDisplay $ProgramInfoPopup "\n\n";
    AppendLinkToTextDisplay $ProgramInfoPopup [_ "bash"] \
	{ShowWebPage http://www.gnu.org/software/bash/bash.html};
    AppendToTextDisplay $ProgramInfoPopup "\nBash (the 'born again shell')is one of the two most widely used Unix command interpreters. On many systems it is known as sh rather than, or in addition to, bash, because it is considered to supersede the original Bourne shell.";
    AppendToTextDisplay $ProgramInfoPopup "\n\n";
    AppendLinkToTextDisplay $ProgramInfoPopup [_ "cgrep"] \
	{ShowWebPage http://freshmeat.net/projects/cgrep};
    AppendToTextDisplay $ProgramInfoPopup "\nCgrep is an improved and extended version of the original Unix grep program developed by Bill Tannenbaum at Lucent Technologies. Its regular expression matching capabilities are a superset of those of the original egrep (not of GNU egrep), to which it adds approximate matching. It is also reported to be considerably faster. It has an extensive set of options controlling how much of the context surrounding the match to display and some capabilities for multi-line matching.";
    AppendToTextDisplay $ProgramInfoPopup "\n\n";
    AppendLinkToTextDisplay $ProgramInfoPopup [_ "ed"] \
	{ShowWebPage http://www.gnu.org/software/ed/ed.html};
    AppendToTextDisplay $ProgramInfoPopup "\nEd is the classic Unix line editor. Although few people use line editors interactively anymore, it remains in use via scripts. Vi and its derivative vim are screen-oriented descendants of ed.";
    AppendToTextDisplay $ProgramInfoPopup "\n\n";
    AppendLinkToTextDisplay $ProgramInfoPopup [_ "egrep"] \
	{ShowWebPage http://www.gnu.org/software/grep/};
    AppendToTextDisplay $ProgramInfoPopup "\nGrep is the classic Unix string search program. Egrep is a variant of grep that provided a richer regular expression notation usually known as 'extended regular expression' notation as opposed to 'basic regular expression' notation. On many systems egrep, grep, and fgrep are different names for the same program, which behaves differently depending on the name it is called by and/or the command-line options it is given.";
    AppendToTextDisplay $ProgramInfoPopup "\n\n";
    AppendLinkToTextDisplay $ProgramInfoPopup [_ "emacs"] \
	{ShowWebPage http://www.gnu.org/software/emacs/emacs.html};
    AppendToTextDisplay $ProgramInfoPopup "\nEmacs is an extremely powerful fully programmable and extensible text editor. It is really an interpreter for a dialect of LISP with a number of primitives useful for editing. Much of emacs' functionality is implemented indirectly by libraries of emacs lisp code. It is possible to run emacs non-interactively as a powerful text-processing engine.";
    AppendToTextDisplay $ProgramInfoPopup "\n\n";
    AppendLinkToTextDisplay $ProgramInfoPopup [_ "euphoria"] \
	{ShowWebPage http://www.rapideuphoria.com/};
    AppendToTextDisplay $ProgramInfoPopup "\nEuphoria is a language with a simple Pascal-like syntax used primarily on the Microsoft Windows platform though it is also available for GNU/Linux and FreeBSD. By some benchmarks it is the fastest of the interpreted languages. Euphoria provides a simple wildcard matching facility but not true regular expression matching."
    AppendToTextDisplay $ProgramInfoPopup "\n\n";
    AppendLinkToTextDisplay $ProgramInfoPopup [_ "fgrep"] \
	{ShowWebPage http://www.gnu.org/software/grep/};
    AppendToTextDisplay $ProgramInfoPopup "\nFgrep stands for 'fast grep'. It is a version of grep that is limited to searches for fixed strings. As such, it does not actually provide for regular expression matching at all. It is included here because fixed string searches are sometimes useful and because it is a member of the same family as grep and egrep, indeed often the same program.";
    AppendToTextDisplay $ProgramInfoPopup "\n\n";
    AppendLinkToTextDisplay $ProgramInfoPopup [_ "fish"] \
	{ShowWebPage http://roo.no-ip.org/fish/};
    AppendToTextDisplay $ProgramInfoPopup "\nFish, the 'friendly interactive shell', is a shell that is focused on interactive use, discoverability, and user friendliness. The design goal of fish is to give the user a rich set of powerful features in a way that is easy to discover, remember, and use. fish features a user-friendly and powerful tab-completion, including descriptions of every completion, tab-completion of strings with wildcards, and many completions for specific commands.\n";
    AppendToTextDisplay $ProgramInfoPopup "\n\n";
    AppendLinkToTextDisplay $ProgramInfoPopup [_ "frink"] \
	{ShowWebPage http://futureboy.homeip.net/frinkdocs};
    AppendToTextDisplay $ProgramInfoPopup "\nFrink is a language intended especially for numerical calculation. Its most unusual property is that all numerical values are associated with units, of which it has an extensive database. Frink therefore knows that the product of 2 furlongs and 3 feet is 367.9 square meters. It uses a modified version of the regular expression code from the Apache Java ORO project, which provides regular expression facilities compatible with those of Perl5.";
    AppendToTextDisplay $ProgramInfoPopup "\n\n";
    AppendLinkToTextDisplay $ProgramInfoPopup [_ "gawk"] \
	{ShowWebPage http://www.gnu.org/software/gawk/};
    AppendToTextDisplay $ProgramInfoPopup "\nGawk is the GNU project implementation of Awk. It is roughly equivalent to ATT nawk but has some extensions. Note that on many systems this is the only version of Awk installed and may be named Awk rather than, or in addition to, Gawk.";
    AppendToTextDisplay $ProgramInfoPopup "\n\n";
    AppendLinkToTextDisplay $ProgramInfoPopup [_ "glark"] \
	{ShowWebPage http://www.incava.org/projects/glark/};
    AppendToTextDisplay $ProgramInfoPopup "\nGlark is a text search program along the lines of grep implemented in Ruby. Additional features include Boolean combinations of patterns, highlighting of matches, and context around matches.";
    AppendToTextDisplay $ProgramInfoPopup "\n\n";
    AppendLinkToTextDisplay $ProgramInfoPopup [_ "grep"] \
	{ShowWebPage http://www.gnu.org/software/grep/};
    AppendToTextDisplay $ProgramInfoPopup "\nGrep is the classic Unix string search program. The original version provided 'basic regular expression' notation, while egrep provided the richer 'extended regular expression' notation and fgrep could search only for fixed strings. Typically, when called as grep with no special command-line options basic regular expression notation will be used. In many cases, the same program if called by another name or with other command-line options will behave like fgrep or egrep.";
    AppendToTextDisplay $ProgramInfoPopup "\n\n";
    AppendLinkToTextDisplay $ProgramInfoPopup [_ "guile"] \
	{ShowWebPage http://www.gnu.org/software/guile/};
    AppendToTextDisplay $ProgramInfoPopup "\nGuile is a dialect of Lisp developed by the GNU Project with the intention that it serve as the primary extension language for GNU software. It provides roughly the classic egrep regular expression facilities but uses notation that in some respects is unusual.";
    AppendToTextDisplay $ProgramInfoPopup "\n\n";
    AppendLinkToTextDisplay $ProgramInfoPopup [_ "icon"] \
	{ShowWebPage http://www.cs.arizona.edu/icon};
    AppendToTextDisplay $ProgramInfoPopup "\nIcon is the modern descendant of Snobol, the classic pattern matching language. Unlike Snobol, Icon has the usual Algol-type control structures. Syntactically, it feels much like C. However, Icon has a richer run-time system that supports such unusual constructs as goal-directed evaluation and generator functions. Icon has a regular expression matching toolkit of the standard type, but it is not used as much as in many other languages since Icon is designed for pattern matching and parsing by direct methods.";
    AppendToTextDisplay $ProgramInfoPopup "\n\n";
    AppendLinkToTextDisplay $ProgramInfoPopup [_ "java"] \
	{ShowWebPage http://java.sun.com};
    AppendToTextDisplay $ProgramInfoPopup "\nJava is a cross-platfoorm object-oriented language with automatic storage allocation and garbage collection otherwise similar in syntax and level to C. Java has an enormous collection of library functions, including one of the most sophisticated regular expression toolkits.";
    AppendToTextDisplay $ProgramInfoPopup "\n\n";
    AppendLinkToTextDisplay $ProgramInfoPopup [_ "javascript"] \
	{ShowWebPage http://www.njs-javascript.org};
    AppendToTextDisplay $ProgramInfoPopup "\nJavascript is the original webpage programning language introduced with the Netscape browser. It is used primarily on web pages.";
    AppendToTextDisplay $ProgramInfoPopup "\n\n";
    AppendLinkToTextDisplay $ProgramInfoPopup [_ "jgrep"] \
	{ShowWebPage http://ourworld.compuserve.com/homepages/John_Maddock/regexpp.htm};
    AppendToTextDisplay $ProgramInfoPopup "\nJgrep is a text search utility that accompanies the Regex++ regular expression library for C++ and C. This library provides full POSIX regular expression syntax plus some Perl extensions and handles Unicode.";
    AppendToTextDisplay $ProgramInfoPopup "\n\n";
    AppendLinkToTextDisplay $ProgramInfoPopup [_ "judoscript"] \
	{ShowWebPage http://www.judoscript.com/judo.html};
    AppendToTextDisplay $ProgramInfoPopup "\nJudoscript is a scripting language implemented in Java and intended to provide easier access to Java. It provides high-level facilities for a variety of functions such as HTTP and encryption while at the same time allowing Java code to be included.";
    AppendToTextDisplay $ProgramInfoPopup "\n\n";
    AppendLinkToTextDisplay $ProgramInfoPopup [_ "ksh"] \
	{ShowWebPage http://www.kornshell.com/};
    AppendToTextDisplay $ProgramInfoPopup "\nKsh is a shell in the Bourne shell lineage created by David Korn at AT&T. It exists in several versions, the 1988 AT&T version, the 1993 AT&T version, several derivatives of the AT&T version, and a public domain clone known as ";
    AppendLinkToTextDisplay $ProgramInfoPopup "pdksh" \
	{ShowWebPage http://www.cs.mun.ca/~michael/pdksh/}
    AppendToTextDisplay $ProgramInfoPopup [_ ". Note that both pdksh and the original AT&T versions are normally installed under the name ksh so it may not be obvious which version you have. As far as I can tell file globbing is the same in all versions except for the fact that pdksh does not support the POSIX named character classes ([[:digit:]] etc.)."];
    AppendToTextDisplay $ProgramInfoPopup "\n\n";
    AppendLinkToTextDisplay $ProgramInfoPopup [_ "lua"] \
	{ShowWebPage http://www.lua.org};
    AppendToTextDisplay $ProgramInfoPopup "\nLua is a scripting language aimed especially at games and other embedded applications. It is designed to be fast and to use a minimum of memory. Lua's pattern matching commands do not, strictly speaking, match regular expressions since the quantifiers apply either to the preceding symbol or the preceding builtin character class. It has capture groups but they do not serve as quantifier domains. In mathematical terms, Lua string matching lacks closure of subexpressions. If you need full regular expression matching Lua is not suitable.";
    AppendToTextDisplay $ProgramInfoPopup "\n\n";
    AppendLinkToTextDisplay $ProgramInfoPopup [_ "mawk"] \
	{ShowWebPage http://freshmeat.net/projects/mawk};
    AppendToTextDisplay $ProgramInfoPopup "\nMike's Awk is a version of Awk that conforms to the POSIX 1003.2 standard and adds a few extensions. It is roughly equivalent to ATT nawk. Mawk is smaller and faster than Gawk.";
    AppendToTextDisplay $ProgramInfoPopup "\n\n";
    AppendLinkToTextDisplay $ProgramInfoPopup [_ "nawk"] \
	{ShowWebPage http://heirloom.sourceforge.net};
    AppendToTextDisplay $ProgramInfoPopup "\nThe Nawk to which the link is provided is the version provided as part of the Heirloom Toolchest, which contains updated versions of original Unix software released as open source by Caledera and Sun. Among the ways in which it has been updated is that it can handle UTF-8 Unicode.";
    AppendToTextDisplay $ProgramInfoPopup "\n\n";
    AppendLinkToTextDisplay $ProgramInfoPopup [_ "nrgrep"] \
	{ShowWebPage http://www.dcc.uchile.cl/~gnavarro/software/};
    AppendToTextDisplay $ProgramInfoPopup "\nNrgrep is a text search utility that uses an algorithm developed by the author, Gonzalo Navarro. It supports approximate matching and has the unusual property of providing for transpositions. Costs may be set only globally, not for individual groups";
    AppendToTextDisplay $ProgramInfoPopup "\n\n";
    AppendLinkToTextDisplay $ProgramInfoPopup [_ "perl"] \
	{ShowWebPage http://www.perl.org/};
    AppendToTextDisplay $ProgramInfoPopup "\nPerl is a widely used scripting language considered by many to be the Swiss Army knife of programming. Version 5 of Perl introduced a number of extensions to standard regular expression notation, many of which have been adopted by other regular expression engines.";
    AppendToTextDisplay $ProgramInfoPopup "\n\n";
    AppendLinkToTextDisplay $ProgramInfoPopup [_ "php-mb"] \
	{ShowWebPage http://www.php.net};
    AppendToTextDisplay $ProgramInfoPopup "\nThis is the PHP scripting language using a regular expression library that supports multibyte characters.";
    AppendToTextDisplay $ProgramInfoPopup "\n\n";
    AppendLinkToTextDisplay $ProgramInfoPopup [_ "php-pcre"] \
	{ShowWebPage http://www.php.net};
    AppendToTextDisplay $ProgramInfoPopup "\nThis is the PHP scripting language using the PCRE regular expression library, wich provides regular expressions along the lines of those of Perl 5.";
    AppendToTextDisplay $ProgramInfoPopup "\n\n";
    AppendLinkToTextDisplay $ProgramInfoPopup [_ "php-posix"] \
	{ShowWebPage http://www.php.net};
    AppendToTextDisplay $ProgramInfoPopup "\nPHP is a scripting language used primarily for generating dynamic web pages. It has several regular expression toolkits. This one provides regular expressions conformant to the POSIX standard.";
    AppendToTextDisplay $ProgramInfoPopup "\n\n";
    AppendLinkToTextDisplay $ProgramInfoPopup [_ "pike"] \
	{ShowWebPage http://pike.ida.liu.se};
    AppendToTextDisplay $ProgramInfoPopup "\nPike is a scripting language roughly comparable to Python, Perl, Tcl and Ruby. It is object-oriented and has a C-like syntax. It has a somewhat lower-level orientation than comparable scripting languages. It has a fairly rich regular expression facility and is one of the faster languages of its type.";
    AppendToTextDisplay $ProgramInfoPopup "\n\n";
    AppendLinkToTextDisplay $ProgramInfoPopup [_ "python"] \
	{ShowWebPage http://www.python.org};
    AppendToTextDisplay $ProgramInfoPopup "\nPython is one of the popular new generation scripting languages. It is object-oriented, but not as as thoroughly as Ruby. It is possible for someone with little understanding of object-oriented programming to write in Python. Python has one of the richer regular expression toolkits.";
    AppendToTextDisplay $ProgramInfoPopup "\n\n";
    AppendLinkToTextDisplay $ProgramInfoPopup [_ "rc"] \
	{ShowWebPage http://www.star.le.ac.uk/~tjg/rc/};
    AppendToTextDisplay $ProgramInfoPopup "\nRc is the standard shell for Plan 9, the successor to Unix developed by Lucent.";
    AppendToTextDisplay $ProgramInfoPopup "\n\n";
    AppendLinkToTextDisplay $ProgramInfoPopup [_ "rebol"] \
	{ShowWebPage http://www.rebol.com};
    AppendToTextDisplay $ProgramInfoPopup "\nRebol is a cross-platform scripting language that is intended for use both as a programming language and as a data description language. Rebol's patternmatching facilities are an integral part of the language rather than a separate regular expression matching component, so Redet does not provide an optimal interface to them.";
    AppendToTextDisplay $ProgramInfoPopup "\n\n";
    AppendLinkToTextDisplay $ProgramInfoPopup [_ "ruby"] \
	{ShowWebPage http://ruby-lang.org};
    AppendToTextDisplay $ProgramInfoPopup "\nRuby is a relatively new addition to the group of scripting languages that includes Perl, Python, and Tcl. It is more thoroughly object-oriented than Python and uses a syntax reminiscent in some ways of that of Perl. Perl fans in search of a cleaner, strongly object-oriented language tend to like Ruby. Ruby has a fairly rich regular expression facility and executes quickly, so it is a reasonable choice if you are using Redet as a search tool as well as if you are developing regular expressions for Ruby.";
    AppendToTextDisplay $ProgramInfoPopup "\n\n";
    AppendLinkToTextDisplay $ProgramInfoPopup [_ "sed"] \
	{ShowWebPage http://www.gnu.org/software/sed};
    AppendToTextDisplay $ProgramInfoPopup "\nSed is the classic Unix stream editor. It is much like the line editor ed but is oriented toward use as a filter.";
    AppendToTextDisplay $ProgramInfoPopup "\n\n";
    AppendLinkToTextDisplay $ProgramInfoPopup [_ "sleep"] \
	{ShowWebPage http://sleep.hick.org};
    AppendToTextDisplay $ProgramInfoPopup "\nSleep is an embeddable scripting language implemented in Java. It is inspired by Perl with influence from Objective C. Sleep has both a full regular expression capability and a more limited wildcard matching facility.";
    AppendToTextDisplay $ProgramInfoPopup "\n\n";
    AppendLinkToTextDisplay $ProgramInfoPopup [_ "sleepwc"] \
	{ShowWebPage http://sleep.hick.org};
    AppendToTextDisplay $ProgramInfoPopup "\nThis is the wildcard matching facility of the Sleep scriting language, which also has a full regular expression engine.";
    AppendToTextDisplay $ProgramInfoPopup "\n\n";
    AppendLinkToTextDisplay $ProgramInfoPopup [_ "tcl"] \
	{ShowWebPage http://www.tcl.tk};
    AppendToTextDisplay $ProgramInfoPopup "\nTcl is the language in which this program is written, so it is always available and is very fast since there is no overhead executing other programs as child processes. It has one of the richest regular expression facilities and so is a good choice if you are using Redet as a search tool.";
    AppendToTextDisplay $ProgramInfoPopup "\n\n";
    AppendLinkToTextDisplay $ProgramInfoPopup [_ "tclglob"] \
	{ShowWebPage http://www.tcl.tk};
    AppendToTextDisplay $ProgramInfoPopup "\nTcl has a filename matching feature in addition to its richer regular expression facilities. If you are using Redet as a search tool, you had might as well use the full regular expression facilities. If you are constructing expressions for use with Tcl's file globbing commands you should select this program.";
    AppendToTextDisplay $ProgramInfoPopup "\n\n";
    AppendLinkToTextDisplay $ProgramInfoPopup [_ "tcsh"] \
	{ShowWebPage http://www.tcsh.org};
    AppendToTextDisplay $ProgramInfoPopup "\nThis is one of the command line interpreters widely used on Unix systems. Tcsh is an extended version of csh, the shell developed at Berkeley. On many systems it is named csh instead of, or in addition to, tcsh. You should choose this program if you are developing regular expressions for use with tcsh. Otherwise you would be better advised to use a program with richer and faster regular expression facilities.";
    AppendToTextDisplay $ProgramInfoPopup "\n\n";
    AppendLinkToTextDisplay $ProgramInfoPopup [_ "tr"] \
	{ShowWebPage http://www.gnu.org/software/coreutils/manual/html_chapter/coreutils_9.html\#SEC44};
    AppendToTextDisplay $ProgramInfoPopup "\nTr is one of the standard Unix utilities. It is used to map one set of characters to another. It can also delete selected characters or reduce sequences of adjacent identical characters to a single token. It is not really a regular expression matcher but is supported because users have asked for it and because it uses character classes similar to the named character classes used in POSIX regular expressions.";
    AppendToTextDisplay $ProgramInfoPopup "\n\n";
}

rename unknown StandardUnknown
proc unknown {args} {
    if {[string match Explain* [lindex $args 0]]} {
	ShowMessage [_ "No information is available on this topic. See Help:Bug Reports."]
    } else {
	set cm [concat StandardUnknown $args]
	uplevel 1 [eval $cm]
    }
}

# This procedure relabels the top level menu buttons and destroys and reconstructs
# the submenus. The latter is necessary because Tk does not allow the relabelling
# of submenus.
proc LabelMenus {} {
    global m;
    global program;
    global Locale;
    global BalloonHelpP;
    global LeftImplicitStar;
    global RightImplicitStar;
    global ButtonName;
    global FeatureTestDebugP;
    global FocusFollowsMouseP;
    global SortUnicodeRangesByCodepointP;
    global MenuIndex;
    global UserClassPaletteIsDisplayedP;
    global CreateFontControlPanelIndex;
    global SelectLocaleIndex;
    global SortUnicodeRangesIndex;
    global FocusFollowsMouseIndex;
    global PerlUnicodeLocaleDependentIndex;
    global BalloonHelpIndex;
    global ToggleActualRegexpIndex;
    global ShowActualRegexpP;
    global DisplayActualRegexpIndex;
    global DescribeDisplayActualRegexpIndex;
    global ToggleUserClassPaletteIndex;
    global DescribeToggleUserClassPaletteIndex;
    global ToggleUserClassesEnabledIndex;
    global DescribeToggleUserClassesEnabledIndex;
    global UserClassesEnabledP;
    global SubstitutionModeIndex;
    global DoSubstitutionsP;
    global OutputOnlyChangedLinesP;
    global ComparisonWindowDisplayedP;
    global SideBySideLayoutP;
    global RegSubSideBySideP;
    global UseScrollbarsP;

    balloonhelp_control 0;
    $m entryconfigure $MenuIndex(FileMenu) -label  [_ "File"];
    $m.file delete [mdo 1] [mdo 5]
    set ind 0;
    destroy $m.file.regexp
    $m.file add cascade -label  [_ "Regular Expression"] -menu [menu $m.file.regexp]
#    bind $m.file <<MenuSelect>> {puts "File menu selected."}
#    bind $m.file.regexp <<MenuSelect>> {puts "Regexp submenu selected."}
    $m.file.regexp add command -label  [_ "Load Regular Expression From Clipboard"]  -command LoadRegularExpressionFromClipboard;
    $m.file.regexp add command -label  [_ "Load Regular Expression From File"] -command LoadRegularExpressionFromFile;
    $m.file.regexp add command -label  [_ "Save Expressions In History Format"] -command SaveRegexpAsHistory;
    $m.file.regexp add command -label  [_ "Save Regexp As Plain Text"] -command SaveRegexpPlain;
    $m.file.regexp add command -label  [_ "Save Subexp As Plain Text"] -command SaveSubexpPlain;

    destroy $m.file.tdata
    $m.file add cascade -label  [_ "Test Data"] -menu [menu $m.file.tdata] 
    $m.file.tdata add command -label  [_ "Clear Test Data"] -command ClearInput;
    $m.file.tdata add command -label  [_ "Edit Test Data"] -command EditTestInputData;
    $m.file.tdata add command -label  [_ "Load Test Data From Clipboard"] -command LoadTestDataFromClipboard;
    $m.file.tdata add command -label  [_ "Load Test Data From File"] -command LoadTestInputData;
    $m.file.tdata add command -label  [_ "Save Test Data To File"] -command SaveTestInputData
    destroy $m.file.results;
    $m.file add cascade -label  [_ "Results"] -menu [menu $m.file.results] 
    $m.file.results add command -label  [_ "Edit Results"] -command EditOutput
    $m.file.results add command -label  [_ "Lock Results"] -command LockOutput;
    $m.file.results add command -label  [_ "Save Results"] -command SaveOutput;
    destroy $m.file.comp
    $m.file add cascade -label  [_ "Comparison Data"] -menu [menu $m.file.comp] 
    $m.file.comp add command -label  [_ "Display Comparison Window"] -command ToggleComparisonWindow
    set MenuIndex(ToggleComparisonWindow) 1
    $m.file.comp add command -label  [_ "Clear Comparison Data"] -command ClearOutputComparisonData;
    $m.file.comp add command -label  [_ "Edit Comparison Data"] -command EditOutputComparisonData;
    $m.file.comp add command -label  [_ "Load Comparison Data From Clipboard"] -command LoadOutputComparisonDataFromClipboard;
    $m.file.comp add command -label  [_ "Load Comparison Data From File"] -command LoadOutputComparisonData;
    $m.file.comp add command -label  [_ "Save Comparison Data To File"] -command SaveOutputComparisonData;
    $m.file.comp add command -label  [_ "Compare Output and Comparison Data"] -command ShowDiffResult;
    $m.file add command -label  [_ "Quit"] -command ShutDown;
    incr ind;
    $m entryconfigure $MenuIndex(ProgramMenu) -label  [_ "Program"];
    $m.program delete [mdo 1] [mdo 37]
    $m.program add command -label "agrep" -command {SelectProgram agrep};
    $m.program add command -label "awk"  -command {SelectProgram awk};
    $m.program add command -label "bash"  -command {SelectProgram bash};
    $m.program add command -label "cgrep" -command {SelectProgram cgrep}
    $m.program add command -label "ed"   -command {SelectProgram ed}
    $m.program add command -label "egrep" -command {SelectProgram egrep}
    $m.program add command -label "emacs" -command {SelectProgram emacs}
    $m.program add command -label "euphoria" -command {SelectProgram euphoria}
    $m.program add command -label "fgrep" -command {SelectProgram fgrep}
    $m.program add command -label "fish" -command {SelectProgram fish}
    $m.program add command -label "frink" -command {SelectProgram frink} -columnbreak 1
    $m.program add command -label "gawk"  -command {SelectProgram gawk}
    $m.program add command -label "glark"  -command {SelectProgram glark}
    $m.program add command -label "grep"  -command {SelectProgram grep}
    $m.program add command -label "guile"  -command {SelectProgram guile}
    $m.program add command -label "icon"  -command {SelectProgram icon}
    $m.program add command -label "java"  -command {SelectProgram java}
    $m.program add command -label "javascript"  -command {SelectProgram javascript}
    $m.program add command -label "jgrep"  -command {SelectProgram jgrep}
    $m.program add command -label "judoscript"  -command {SelectProgram judoscript}
    $m.program add command -label "ksh"  -command {SelectProgram ksh}  -columnbreak 1
    $m.program add command -label "lua"  -command {SelectProgram lua} 
    $m.program add command -label "mawk"  -command {SelectProgram mawk}
    $m.program add command -label "nawk"  -command {SelectProgram nawk}
    $m.program add command -label "nrgrep"  -command {SelectProgram nrgrep}
    $m.program add command -label "perl"  -command {SelectProgram perl}
    $m.program add command -label "php-mb"  -command {SelectProgram php-mb}
    $m.program add command -label "php-pcre"  -command {SelectProgram php-pcre}
    $m.program add command -label "php-posix"  -command {SelectProgram php-posix}
    $m.program add command -label "pike"  -command {SelectProgram pike}
    $m.program add command -label "python" -command {SelectProgram python} -columnbreak 1
    $m.program add command -label "rc"  -command {SelectProgram rc}
    $m.program add command -label "rebol"  -command {SelectProgram rebol} 
    $m.program add command -label "ruby"  -command {SelectProgram ruby}
    $m.program add command -label "sed"   -command  {SelectProgram sed}
    $m.program add command -label "sleep"   -command  {SelectProgram sleep}
    $m.program add command -label "sleepwc"   -command  {SelectProgram sleepwc}
    $m.program add command -label "tcl"   -command  {SelectProgram tcl}
    $m.program add command -label "tclglob"  -command  {SelectProgram tclglob}
    $m.program add command -label "tcsh"  -command {SelectProgram tcsh}
    $m.program add command -label "tr"  -command {SelectProgram tr}
    if {!$::AquaP} {
	$m entryconfigure $MenuIndex(ExecuteMenu) -label  [format [_ "Execute-%s%s%s"] $LeftImplicitStar $ButtonName $RightImplicitStar];
    }
    $m.history delete [mdo 1] [mdo 5];
    $m entryconfigure $MenuIndex(HistoryMenu) -label  [_ "History"];
    set ind 1;
    set hist::ToggleHistoryIndex $ind;
    if {$hist::HistoryIsDisplayedP} {
	set blabel [_ "Hide History"];
    } else {
	set blabel [_ "Popup History"];
    }
    $m.history add command -label $blabel -command {hist::ToggleHistory};
    incr ind;
    if {$hist::HistoryShowProgP} {
	set blabel [_ "Do Not Show Program"];
    } else {
	set blabel [_ "Show Program"];
    }
    set hist::HistoryShowProgIndex $ind;
    $m.history add command -label $blabel -command {hist::ToggleHistoryProgramDisplay};
    incr ind;
    $m.history add command -label [_ "Save History"] -command {hist::SaveHistoryList};
    incr ind;
    $m.history add command -label [_ "Prune History"] -command {hist::PruneHistoryList};
    incr ind;
    $m.history add command -label [_ "Clear History"] -command {hist::ClearHistoryList};
    incr ind;
    if {!$::AquaP} {
	$m entryconfigure $MenuIndex(ClearMenu) -label  [_ "Clear"];
	$m entryconfigure $MenuIndex(PaletteMenu) -label  [_ "Palette"];
    } else {
	.cmnds.clear configure -text [_ "Clear"];
	.cmnds.palette configure -text [_ "Palette"];
    }
    $m entryconfigure $MenuIndex(ToolsMenu) -label  [_ "Tools"];
    $m.tools delete [mdo 1] [mdo 7];

    destroy $m.tools.charentry;
    $m.tools add cascade -label [_ "Character Entry"] -menu [menu $m.tools.charentry];
    $m.tools.charentry delete [mdo 1] [mdo $::CharentryMenuItems];
    set ::CharacterEntryMenuItems 0; 

    incr ::CharacterEntryMenuItems;
    set ::CustomCharacterChartIndex $::CharacterEntryMenuItems;
    $m.tools.charentry add command -label [_ "Load Custom Character Chart Definition"] \
	-command ReadCustomCharacterChartPopup;

    incr ::CharacterEntryMenuItems;
    set ::ToggleIPAAIndex $::CharacterEntryMenuItems;
    $m.tools.charentry add command -label [_ "Display Accented Letter Chart"] -command ToggleIPAA;

    incr ::CharacterEntryMenuItems;
    set ::ToggleIPACIndex $::CharacterEntryMenuItems;
    $m.tools.charentry add command -label [_ "Display IPA Consonants"] -command ToggleIPAC;

    incr ::CharacterEntryMenuItems;
    set ::ToggleIPAVIndex $::CharacterEntryMenuItems;
    $m.tools.charentry add command -label [_ "Display IPA Vowel Chart"] -command ToggleIPAV;

    incr ::CharacterEntryMenuItems;
    set ::ToggleIPADIndex $::CharacterEntryMenuItems;
    $m.tools.charentry add command -label [_ "Display IPA Diacritics"] -command ToggleIPAD;

    incr ::CharacterEntryMenuItems;
    set ::ToggleCharEntryByCodeIndex $::CharacterEntryMenuItems;
    $m.tools.charentry add command -label \
	[_ "Display Widget for Entering Characters by Unicode Code"] \
	-command ToggleCharEntryByCode;

    foreach Title [lsort [array names ::SpecialCharacterPalette]] {
	if {[string match *WidgetName $Title]} {continue}
	$::CEM add command -label $Title -command "PopupSpecialPalette $Title";
	incr ::CharacterEntryMenuItems;
    }

    destroy $m.tools.classes
    $m.tools add cascade -label [_ "Classes"] -menu [menu $m.tools.classes];
    $m.tools.classes delete [mdo 1] [mdo 6];
    set ind 1;
    if {$ShowActualRegexpP} {
	set blabel [_ "Do Not Display Regular Expression Actually Executed"];
    } else {
	set blabel [_ "Display Regular Expression Actually Executed"];
    }
    set DisplayActualRegexpIndex $ind;
    $m.tools.classes add command -label  $blabel -command ToggleActualRegexp;
    incr ind;
    if {$UserClassPaletteIsDisplayedP} {
	set blabel [_ "Do Not Display User-Defined Class Palette"];
    } else {
	set blabel [_ "Display User-Defined Class Palette"];
    }
    $m.tools.classes add command -label $blabel -command ToggleUserClassPalette;
    set ToggleUserClassPaletteIndex $ind;

    incr ind;
    if {$UserClassesEnabledP} {
	set blabel [_ "Disable User Classes"];
    } else {
	set blabel [_ "Enable User Classes"];
    }
    $m.tools.classes add command -label $blabel -command ToggleUserClassesEnabled;
    set ToggleUserClassesEnabledIndex $ind;

    incr ind;
    $m.tools.classes add command -label  [_ "Enter Character Class Definition"] -command PopupUserClassEntry;
    set EnterCharacterClassDefinitionIndex $ind;

    incr ind;
    $m.tools.classes add command -label  [_ "Load Character Class Definitions"] -command ReadUserClassesInteractively;
    set LoadCharacterClassDefinitionIndex $ind;

    incr ind;
    $m.tools.classes add command -label  [_ "Save Character Class Definitions to File"] -command SaveUserClassDefinitions;
    set SaveCharacterClassDefinitionIndex $ind;
    destroy $m.tools.search
    $m.tools add cascade -label [_ "Search"] -menu [menu $m.tools.search];
    $m.tools.search delete [mdo 1] [mdo 4]
    $m.tools.search add command -label  [_ "Search Test Data"] -command search::SearchTestData
    $m.tools.search add command -label  [_ "Search Results"] -command search::SearchResults;
    $m.tools.search add command -label  [_ "Go to Character in Test Data"] -command search::GotoCharTestData
    $m.tools.search add command -label  [_ "Go to Character in Results"] -command search::GotoCharResults;
    $m.tools add command -label [_ "Result Cache"] -command {resc::PopupCachedEntries}
    $m.tools add command -label [_ "Save Command Information"] -command {SaveCommandInfo}
    $m.tools add command -label [_ "Show Command Line"] -command {ShowCommandLine}
    $m.tools add command -label [_ "Abort"] -command {AbortSearch}
    $m entryconfigure $MenuIndex(ConfigureMenu) -label  [_ "Configure"];
    $m.configure delete [mdo 1] [mdo 12];
    set ind 1;
    destroy $m.configure.charentry
    $m.configure add cascade -label [_ "Character Entry"] -menu [menu $m.configure.charentry]
    incr ind;
    $m.configure.charentry delete [mdo 1]  [mdo 4];
    $m.configure.charentry add checkbutton -label [_ "Display Consonant Chart Column Labels"] \
	-variable DisplayConsonantChartColumnLabelsP -onvalue 1 -offvalue 0 \
	-command ControlDisplayConsonantChartColumnLabels
    $m.configure.charentry add checkbutton -label [_ "Display Consonant Chart Row Labels"] \
	-variable DisplayConsonantChartRowLabelsP -onvalue 1 -offvalue 0 \
	-command ControlDisplayConsonantChartRowLabels
    $m.configure.charentry add checkbutton -label [_ "Display Vowel Chart Column Labels"] \
	-variable DisplayVowelChartColumnLabelsP -onvalue 1 -offvalue 0 \
	-command ControlDisplayVowelChartColumnLabels
    $m.configure.charentry add checkbutton -label [_ "Display Vowel Chart Row Labels"] \
	-variable DisplayVowelChartRowLabelsP -onvalue 1 -offvalue 0 \
	-command ControlDisplayVowelChartRowLabels

    destroy $m.configure.ft
    $m.configure add cascade -label [_ "Feature Testing"] -menu [menu $m.configure.ft];
    incr ind;
    $m.configure.ft delete [mdo 1]  [mdo 3];
    set ftind 1;

    $m.configure.ft add command -label  [_ "Test Features"] -command TestFeatures;
    incr ftind;
    $m.configure.ft add command -label  [_ "Read Feature List"] -command ReadFeatureList;
    incr ftind;
    $m.configure.ft add command -label  [_ "Write Feature List to File"] -command {DumpFeatures $program $Locale};
    incr ftind;

    $m.configure.ft add checkbutton -label [_ "Feature Testing Enabled"] \
	-variable FeatureTestP -onvalue 1 -offvalue 0

    $m.configure.ft add checkbutton -label [_ "Feature Test Debugging Enabled"] \
	-variable FeatureTestDebugP -onvalue 1 -offvalue 0

    destroy $m.configure.layout
    $m.configure add cascade  -label [_ "Layout"] -menu [menu $m.configure.layout]
    incr ind;

    $m.configure.layout add checkbutton -label [_ "Link Mode and Layout"] \
	-variable StandardConfigurationP -onvalue 1 -offvalue 0 \
	-command {if {$::StandardConfigurationP} { GotoStandardLayout}}

    $m.configure.layout add checkbutton -label [_ "Text Windows Side-By-Side"] \
	-variable SideBySideLayoutP -onvalue 1 -offvalue 0 \
	-command LayoutWindows

    $m.configure.layout add checkbutton -label [_ "Regexp and Subexp Side-By-Side"]\
	-variable RegSubSideBySideP -onvalue 1 -offvalue 0 \
	-command LayoutWindows;

    $m.configure.layout add checkbutton -label [_ "Use Scrollbars"] \
	-variable UseScrollbarsP -onvalue 1 -offvalue 0 \
	-command UpdateScrollbars;

    destroy $m.configure.misc
    $m.configure add cascade -label [_ "Miscellaneous"] -menu [menu $m.configure.misc]
    incr ind;

    $m.configure.misc add checkbutton -label [_ "Autoclear Regular Expression"] \
	-variable AutoClearRegexpP -onvalue 1 -offvalue 0

    $m.configure.misc add checkbutton -label [_ "Focus Follows Mouse"] \
	-variable FocusFollowsMouseP -onvalue 1 -offvalue 0 \
	-command {if {$::FocusFollowsMouseP} {tk_focusFollowsMouse}}

    $m.configure.misc add checkbutton -label [_ "On Substitution Output Only Changed Lines"] \
	-variable OutputOnlyChangedLinesP -onvalue 1 -offvalue 0 \
	-command InOutScrollLinkage

    $m.configure.misc add checkbutton -label [_ "Order Unicode Ranges by Codepoint"] \
	-variable SortUnicodeRangesByCodepointP  -onvalue 1 -offvalue 0 \
	-command UpdateUnicodeRangeSort;

    $m.configure.misc add checkbutton -label [_ "Set Debug Flag"] \
	-variable DebugP -onvalue 1 -offvalue 0;
   
    $m.configure.misc add checkbutton -label [_ "Show Balloon Help"] \
	-variable BalloonHelpP -onvalue 1 -offvalue 0 \
	-command {balloonhelp_control $::BalloonHelpP}

    destroy $m.configure.progspec
    $m.configure add cascade -label [_ "Program Specific Features"] -menu [menu $m.configure.progspec];
    incr ind;

    set col NavajoWhite
    set abc salmon
    $m.configure.progspec add command -label  [_ "Program Settings"] -command {} \
	-background $col -activebackground $col -font PopupTitleFont

    $m.configure.progspec add command -label  [_ "Agrep"] -command PopupAgrepControls \
	-activebackground $abc

    $m.configure.progspec add command -label  [_ "Cgrep"] -command PopupCgrepControls \
	-activebackground $abc

    $m.configure.progspec add command -label  [_ "Egrep"] -command PopupEgrepControls \
	-activebackground $abc

    $m.configure.progspec add command -label  [_ "Emacs"] -command PopupEmacsControls \
	-activebackground $abc

    $m.configure.progspec add command -label  [_ "Fgrep"] -command PopupFgrepControls \
	-activebackground $abc

    $m.configure.progspec add command -label  [_ "Gawk"] -command PopupGawkControls \
	-activebackground $abc

    $m.configure.progspec add command -label  [_ "Glark"] -command PopupGlarkControls \
	-activebackground $abc

    $m.configure.progspec add command -label  [_ "Grep"] -command PopupGrepControls \
	-activebackground $abc

    $m.configure.progspec add command -label  [_ "Java"] -command PopupJavaControls \
	-activebackground $abc

    $m.configure.progspec add command -label  [_ "Jgrep"] -command PopupJgrepControls \
	-activebackground $abc
    $m.configure.progspec add command -label  [_ "Nrgrep"] -command PopupNrgrepControls \
	-activebackground $abc
    $m.configure.progspec add command -label  [_ "Perl"] -command PopupPerlControls \
	-activebackground $abc

    $m.configure.progspec add command -label  [_ "Python"] -command PopupPythonControls \
	-activebackground $abc

    $m.configure.progspec add command -label  [_ "Sed"] -command PopupSedControls \
	-activebackground $abc

    $m.configure.progspec add command -label  [_ "Tcl"] -command PopupTclControls \
	-activebackground $abc

    $m.configure.progspec add command -label  [_ "Tr"] -command PopupTrControls \
	-activebackground $abc
 
    $m.configure add separator
    incr ind;

    set SubstitutionModeIndex $ind;
    if {$DoSubstitutionsP == 0} {
	set blabel [_ "Change to Substitution Mode"];
    } else {
	set blabel [_ "Change to Match Mode"];
    }
    $m.configure add command -label $blabel  -command ToggleSubstitutionMode;
    incr ind;

    $m.configure add command -label [_ "Save Configuration"] -command {SaveState};
    incr ind;

    $m.configure add separator
    incr ind;

    set CreateFontControlPanelIndex $ind;
    $m.configure add command -label [_ "Select Font"] -command fontsel::CreateFontControlPanel;
    incr ind;

    set SelectLocaleIndex $ind;
    $m.configure add command -label  [_ "Select Locale"] -command ChangeLocale;

    $m entryconfigure 9 -label  [_ "Help"];
#Help Menu
    if {[string equal $::System MacOSX]} {
	$m.help delete [mdo 1] [mdo 17];
    } else {
	$m.help delete [mdo 1] [mdo 16];
    }
    set ind 1;
    $m.help add command -label [_ "About"] -command About;
    $m.help add command -label [_ "Bug Reports"] -command BugReports;
    $m.help add command -label [_ "Color Names"] -command PopupColorNameList;
    $m.help add command -label [_ "Command Descriptions"] -command \
	{ShowWebPage [file join ${::ManualDirectory} comdesc.html]}
    $m.help add command -label [_ "Command Line Options"] -command CommandLineOptions;
    $m.help add command -label [_ "Description"] -command Description;
    $m.help add command -label [_ "Illustrated Web Manual"] -command WebManual;
    destroy $m.help.ifc
    $m.help add cascade -label [_ "Initialization File Commands"] -menu [menu $m.help.ifc];
    $m.help.ifc add command -label [_ "Popup List"] -command PopupInitCommandList;
    $m.help.ifc add command -label [_ "Save to File"] -command SaveInitCommands;
    destroy $m.help.iftc
    $m.help add cascade -label [_ "Initialization File Tcl Commands"]  -menu [menu $m.help.iftc];
    $m.help.iftc add command -label [_ "Popup List"] -command PopupInitTclCommandList;
    $m.help.iftc add command -label [_ "Save to File"] -command SaveInitTclCommands;
    $m.help add command -label [_ "Key Bindings"] -command DescribeKeyBindings;
    $m.help add command -label [_ "License"] -command ShowGPL;
    if {[string equal $::System MacOSX]} {
	$m.help add command -label [_ "Macintosh Notes"] -command MacintoshNotes;
    }
    $m.help add command -label [_ "Programs"] -command ProvideProgramInfo;
    $m.help add command -label [_ "This Program"] -command PopupProgramInfo;
    $m.help add command -label [_ "Unicode General Character Properties"] -command ShowUnicodeGCP;
    $m.help add command -label [_ "Unicode Ranges"] -command ShowUnicodeRanges;
    $m.help add command -label [_ "Write Palette to File"] -command WritePaletteToFile

    if {[winfo exists .hl]} {
	if {[winfo exists .hl.hlist]} {
	    if {[winfo exists .hl.histtitle]} {
		.hl.histtitle configure -text [_ "History List"];
	    }
	}
    }
    if {$BalloonHelpP} {balloonhelp_control 1}
}

#Create GUI

#Real frames
#Top one, for regular expression and substitution expression windows.  
frame .rsf  -width $MainWidth  -height 3 -borderwidth 0 -relief sunken;
#Lower one, for data windows, that is, test data, result, and comparison data.
frame .dwf  -width $MainWidth  -height 0 -borderwidth 0 -relief sunken;
#These are used in vertical mode for pairs of windows and scrollbars
frame .dwf.vwi  -width $MainWidth  -height 0 -borderwidth 0
frame .dwf.vwo  -width $MainWidth  -height 0 -borderwidth 0
frame .dwf.vwc  -width $MainWidth  -height 0 -borderwidth 0
#Separators
frame .sep1 -width $MainWidth -height 2 -borderwidth 1 -relief sunken
frame .sep2 -width $MainWidth -height 2 -borderwidth 1 -relief sunken
frame .sep3 -width $MainWidth -height 2 -borderwidth 1 -relief sunken
#The quasi-menu
if {$AquaP} {
    frame .cmnds
    button .cmnds.execute -text [format [_ "Execute-%s"] $Program] -command ExecuteRegexp \
	-bg $::ColorSpecs(Menubar,Background) -fg $::ColorSpecs(Menubar,Foreground)
    button .cmnds.clear -text [format [_ "Clear"] $Program] -command ClearRegexp \
	-bg $::ColorSpecs(Menubar,Background) -fg $::ColorSpecs(Menubar,Foreground)
    button .cmnds.palette -text [format [_ "Palette"] $Program] -command TogglePalette \
	-bg $::ColorSpecs(Menubar,Background) -fg $::ColorSpecs(Menubar,Foreground)
    pack .cmnds.execute -side left -expand 1 -fill both
    pack .cmnds.clear -side left -expand 1 -fill both
    pack .cmnds.palette -side left -expand 1 -fill both
    BindKeys .cmnds
    frame .sepcmnds -width $MainWidth -height 2 -borderwidth 1 -relief sunken
}
#The message window.
text .msg -width $MainWidth -bg $ColorSpecs(Messages,Background) -fg $ColorSpecs(Messages,Foreground) -height 1\
    -relief raised -font MainFont -exportselection 1
#The regular expression and substitution expression windows.
entry .rsf.re -width $MainWidth -bg $ColorSpecs(Regexp,Background) -fg $ColorSpecs(Regexp,Foreground)\
    -font RegexpFont -exportselection 1;
entry .rsf.sub -width $MainWidth -bg $ColorSpecs(Subexp,Background) -fg $ColorSpecs(Subexp,Foreground)\
    -font RegexpFont -exportselection 1;
#The three data windows.
text $::IND  -width $SideWidth -bg $ColorSpecs(TestData,Background) -fg $ColorSpecs(TestData,Foreground)\
    -height $MainHeight -font TextFont -exportselection 1  -yscrollcommand {$::INDSB set}
text $::OUT -width $SideWidth  -bg $ColorSpecs(Results,Background) -fg $ColorSpecs(Results,Foreground)\
    -height $MainHeight -font TextFont -exportselection 1 -yscrollcommand {$::OUTSB set}
text $::COM -width $MainWidth -bg $ColorSpecs(ComparisonData,Background) -fg $ColorSpecs(ComparisonData,Foreground)\
    -height $MainHeight -font TextFont -exportselection 1 -yscrollcommand {$::COMSB set};
#The scrollbars for the data windows.
scrollbar $::INDSB -bg $ColorSpecs(TestData,Background) -troughcolor $ColorSpecs(TestData,Background) -command {$::IND yview}
scrollbar $::OUTSB -bg $ColorSpecs(Results,Background) -troughcolor $ColorSpecs(Results,Background) -command {$::OUT yview}
scrollbar $::COMSB -bg $ColorSpecs(ComparisonData,Background) -troughcolor $ColorSpecs(ComparisonData,Background) -command {$::COMo yview}

LayoutWindows;
set InsertionTarget $::REG;
bind $::REG <FocusIn> "SetInsertionTargets $::REG"
bind $::SUB <FocusIn> "SetInsertionTargets $::SUB"
bind $::IND <FocusIn> "SetInsertionTargets $::IND"
bind $::OUT <FocusIn> "SetInsertionTargets $::OUT";
bind $::COM <FocusIn> "SetInsertionTargets $::COM"

bind $::INDSB <<B3>> {ScrollbarMoveBigIncrement $::INDSB 0.10 %x %y};
bind $::OUTSB <<B3>> {ScrollbarMoveBigIncrement $::OUTSB 0.10 %x %y};
bind $::COMSB <<B3>> {ScrollbarMoveBigIncrement $::COMSB 0.10 %x %y};

BindKeys .msg;
BindKeys $::REG;
BindKeys $::SUB;
BindKeys $::IND;
BindKeys $::OUT;
BindKeys $::COM;
bind $::SUB <Return> {ExecuteRegexp};
bind $::REG <Tab> {$::REG  insert insert "\t";break;}; #Allow entry of literal tab.
bind $::SUB <Tab> {$::SUB insert insert "\t";break;}; #Allow entry of literal tab.

.msg  configure -state disabled
$::COM configure -state disabled
$::OUT  configure -state disabled
$::IND   configure -state disabled

balloonhelp_for .msg  [_ "Messages from program appear here."]
balloonhelp_for $::REG  [_ "Assemble regular expression here."]
balloonhelp_for $::SUB  [_ "Assemble substitution expression here."]
balloonhelp_for $::IND  [_ "Data on which to run regexp"]
balloonhelp_for $::OUT  [_ "Result of execution of regexp"]
balloonhelp_for $::COM [_ "Data to be compared to result of execution of regexp"]

#Setup menubar

set m [menu .menubar -tearoff 0 -font MenuFont \
       -bg $ColorSpecs(Menubar,Background) \
       -fg $ColorSpecs(Menubar,Foreground) \
       -activebackground $ColorSpecs(Menubar,ActiveBackground)\
       -activeforeground $ColorSpecs(Menubar,ActiveForeground)]
BindKeys .menubar;
set MenuBarItemCnt -1;
$m add cascade -label [_ "File"]   -menu [menu $m.file]
incr MenuBarItemCnt;
set MenuIndex(FileMenu) $MenuBarItemCnt;
$m add cascade -label [_ "Program"] -menu [menu $m.program];
incr MenuBarItemCnt;
set MenuIndex(ProgramMenu) $MenuBarItemCnt;
if {!$AquaP} {
    $m add command -label [format [_ "Execute-%s"] $Program]  -command ExecuteRegexp;
    incr MenuBarItemCnt;
    set MenuIndex(ExecuteMenu) $MenuBarItemCnt;
}
$m add cascade -label [_ "History"] -menu [menu $m.history];
incr MenuBarItemCnt;
set MenuIndex(HistoryMenu) $MenuBarItemCnt;
if {!$AquaP} {
    $m add command -label [_ "Clear"] -command ClearRegexp;
    incr MenuBarItemCnt;
    set MenuIndex(ClearMenu) $MenuBarItemCnt;
    $m add command -label [_ "Palette"] -command TogglePalette;
    incr MenuBarItemCnt;
    set MenuIndex(PaletteMenu) $MenuBarItemCnt;
}
$m add cascade -label [_ "Tools"] -menu [menu $m.tools]
incr MenuBarItemCnt;
set MenuIndex(ToolsMenu) $MenuBarItemCnt;
$m add cascade -label [_ "Configure"] -menu [menu $m.configure]
incr MenuBarItemCnt;
set MenuIndex(ConfigureMenu) $MenuBarItemCnt;
$m add cascade -label [_ "Help"] -menu [menu $m.help]
incr MenuBarItemCnt;
set MenuIndex(HelpMenu) $MenuBarItemCnt;
LabelMenus;
. configure -menu .menubar

#Its okay to use the toggle since we can be sure that we are
#starting out in match mode.
if {$BeginInSubstitutionModeP} {
    ToggleSubstitutionMode;
}

#Its easiest if we create the emacs command shell whether or not we're going to use emacs.
CreateEmacsWrapper;

dmsg "About to read history file";

#Read history file.
if {$ReadHistoryFileP} {
    if { [file exists $HistoryFile] } {
	hist::ReadHistoryFile $HistoryFile;
    } else {
	set HistoryFullPath [file join $HomeDir $HistoryFile];
	if { [file exists $HistoryFullPath] } {hist::ReadHistoryFile $HistoryFullPath}
    }
}

#If a file named "Regexp" exists, read its contents into the history list.
if { [file exists "Regexp"] } {
    hist::ReadHistoryFile Regexp;
}

#We want the default browser to be set before this code is executed.
#If the default browser is on the list, remove it.
set di [lsearch -exact $BrowserList $DefaultBrowser]
if {$di >= 0} {
    set BrowserList [lreplace $BrowserList $di $di]
}
#Add the default browser to the beginning of the list.
set BrowserList [linsert $BrowserList 0 $DefaultBrowser];

foreach fn $CustomCharacterChartFileNameList {
    wm withdraw [ReadCustomCharacterChartPopup $fn]
}
foreach dl $CustomCharacterChartDataList {
    wm withdraw [DefineCustomCharacterChartPopup $dl]
}

set InitialProgram $program;
hist::OpenHistoryFile; #For writing now;
SetCommandGlosses;
SetRegReturnBinding;
search::SearchInitialize $::IND;
search::SearchInitialize $::OUT;

trace add variable ProgramInfo(perl,UnicodeLocaleDependentP) write PerlUnicodeDepUpdate;

if {$CommandLineProgram != ""} {set program $CommandLineProgram}
if {[SelectProgram $program] != 1} {
    update;
    after 5000; #Give the user a chance to see the message
    SelectProgram tcl
}

if {[string equal $CommandLineUserClassFile ""] == 0} {
    dmsg "About to read user class file.";
    ReadUserClasses $CommandLineUserClassFile;
}
if {$InitialTestInputDataFile != ""} {
    LoadTestInputData $InitialTestInputDataFile;
    if {$PipeP} {ShowMessage [_ "You can't read test data from a pipe and from a file."]}
}
if {$PipeP} {LoadTestInputData}
focus -force $::REG;
dmsg "Initialization complete: starting event loop.";
FlushJournal;
