Tk Library Source Code

3.1.3 - Thu Jan 22 14:51:08 GMT 2004

	I changed the bindtags so that binding to
	the parent frame will cause the child $win.t
	to invoke those bindings.  This means that
	you can create menus that popup on 
	ButtonPress-3 without having to use bind.tree
	or a similar mechanism.  Thank Jeff Hobbs
	for pointing this out.
	
	I fixed the destroy event handling, so that
	it will now not cleanup the widget when a 
	temporary child of the widget is destroyed.

3.1.2 - Fri May 23 17:33:17 GMT 2003

	I fixed ctext::deleteHighlighClass so
	that it will now delete regexp classes.
	I had to modify ctext::getHighlightClasses
	and ctext::addHighlightClassForRegexp to
	fix it.  I've decided to keep the package
	provide at 3.1.

3.1.1 - Fri May 23 00:53:39 GMT 2003

	I made some minor changes to configure
	instance handling, so that .t config
	will return the proper values.  Alas I
	decided to add a TODO, because the values
	aren't quite like standard Tk; with the
	resource classes and all.

3.1 - Thu May 22 01:30:41 GMT 2003

	I fixed some bugs on the configure instance
	handling.  I added ctext::buildArgParseTable,
	which improves performance, because now the
	table is only generated once per widget.
	
	I improved cget to accept glob expressions,
	which also fixed a bug with strings like:
	cget -yscroll which didn't match an array
	element, but do match when passed to the
	real text widget.
	
	You can now pass strings like:
	.t config -flag
	
	and the value for -flag will be returned
	even if the flag is special to ctext.
	This took some engineering to get right.

	I fixed a bug in the test files that occured
	due to some fixes.  Basically I'm using list
	now to construct the tagInfo for each highlight
	class.  This caused problems, because I was
	previously using strings.  The test files were
	using escapes to work around the quoting 
	problem.  They have been changed and now
	everything should work properly.  You will
	need to lookout for this problem if you 
	upgrade.

	I updated REGRESSION.

	The end result is a good release based on
	my testing.  

3.1-alpha-5 - Thu May 15 00:39:10 GMT 2003

	I fixed a minor bug in argument handling
	in the configure instance handler.

3.1-alpha-4 - Wed May 14 17:09:32 GMT 2003

	I improved install.tcl by adding more
	information about auto_path.

	I fixed a bug with listbox selection in
	install.tcl (curselection wasn't used).

	I renamed ctext::getClasses to 
	ctext::getHighlightClasses.

	I made some uplevel calls list based, so
	that if $win has a space in its path ctext
	will work correctly.

	I made the class creation procs all use
	list for storing items in the arrays.

	I modified ctext::getHighlightClasses to
	return a list in the format of: 
	class [list items ...]

	I fixed a bug with 
	ctext::addHighlightClassForRegexp.  It 
	wasn't storing the $re in the class array.
	This was new to the 3.x series.

3.1-alpha-2-3 - Tue May 13 19:30:51 GMT 2003

	I have redone the configure instance 
	handling.  I added -linemap_select_fg
	and -linemap_select_bg.  I have updated
	the README to reflect the new commands
	and options introduced in the 3.x series.
	I have removed the TODO file, because all
	tasks within it have been completed.

	I added an install.tcl script.  It's
	very easy to use and passes all of my 
	tests.  

	I need to test with Malephiso,
	because there may be minor issues I
	haven't noticed.  

3.1-alpha-1 - Mon May 12 23:12:18 GMT 2003

	I've made many changes that have cleaned
	up the code.  I have added -linemap_markable.
	I changed ctext::getAr to accept a suffix.
	I'm now using global variables with a 
	__ctext prefix, because it is easier than
	using namespace variables.  

	The _blink tag was renamed to __ctext_blink.

	I added ctext::deleteHighlightClass, which
	works with any of the 4 class creators.  It
	needs more testing, but so far it passes
	all of my tests.

	I want to wait about a week or so and go
	over each line of code slowly.  I've tried
	to engineer this well, but typos happen, so...	

	I need to merge more of Andreas Sievers'
	changes and features.

[At this point Andreas Sievers working on ASED
submitted his 3.0 to me and I decided to create
3.1 which merges 2.7-alpha with his work.]

2.7-alpha - Fri May  2 13:08:48 GMT 2003

	I have added -linemap_mark_command with
	an example in ctext_test_interactive.tcl

	I addec ctext::getAr which I'm using to
	store more state information about the
	widget for cget and configure.  I modified
	cget and configure to use it, and they
	are now more useful.
	
	This is an alpha release because I haven't
	tested it much.  I still need to spend
	some time and review the diffs.  I'll 
	probably get to that next week, and I'll
	test it with Malephiso (my editor).  I
	should also update the README with
	information about -linemap_mark_command.

2.6.10 - Tue Apr 29 20:47:29 GMT 2003

	I fixed a bug with -font handling in the
	instance command.  
	You can now do:
	.t config -font
	and it will change the linemap font as
	well as the main text widget.
	
	I cleaned up argument handling in the
	constructor and instance commands.  They
	now use concat and are simpler.
	
	I added ctext::event:Destroy which now
	takes care of removing an interp alias
	which was missing in previous releases.
	
	interp alias is now used rather than
	eval with a dummy proc for creating an
	instance command.
	
	$win now has a <FocusIn> binding that
	should fix a problem some of you may
	experience.  
	You can now do:
	focus $win 
	and it will act like:
	focus $win.t
	
	I removed uplevel n eval calls, which
	were pointless.  I didn't realize 
	when I wrote them that uplevel acts like
	eval.
			
2.6.9 - Mon Apr 28 16:17:13 GMT 2003

	I fixed a minor focus issue by adding
	-takefocus 0 to the linemap creator.

	I also removed an uplevel #0 for interp
	alias, which wasn't needed.

	I removed the government clause in the 
	LICENSE.

	I'm pondering a rewrite of Ctext (yet again)
	which will use SDynObject, and provide more
	features, but the thought "Why fix it if it
	isn't broken?" comes to mind.

2.6.8 - Mon Dec  2 18:24:49 GMT 2002

	I fixed two bugs pointed out by Neil Madden.
	
	The initial creation of the widget failed
	when -linemap 0 was used.
	
	The virtual event <<Modified>> was not occuring.
	----
	I cleaned up several rough areas in the code.
	
	I cleaned up the code in the creation of the
	widget for -yscrollcommand and the linemap.
	
	I cleaned up the code in the configure instance
	command handler.
	
	----
	This release passes all of my tests with 
	Tcl/Tk 8.3 and 8.4.  To make debugging easier
	I have added ctext_test_interactive.tcl

2.6.7 - Fri Nov 22 16:39:41 GMT 2002

	I fixed a bug with C comment highlighting.  It
	wasn't updating the highlighting when the
	insertion was just one character.  The problem
	was that the RE didn't match, because the 
	previous char and next char were not used to
	decipher the match.  
	
	This release was tested with Tcl/Tk 8.4
			
2.6.6 - Thu Aug 22 23:46:14 GMT 2002

	I fixed a serious bug with ctext::matchPair
	and ctext::matchQuote.  The problem was that
	in some cases the pattern )|}|] was causing
	an infinite loop when no other patterns matched.
	It was finding the same character over and over
	again.  This is fixed now.   I'm sorry to anyone
	that was bothered by this.  I found it today with
	Malephiso while editing a test file.  It basically
	locked up my editor.  The long scripts and C code
	I've been editing in the past haven't had this
	problem, due to multiple characters matching.

	Please report BUGS.  I need your help.

2.6.5 - Tue Aug 20 23:27:23 GMT 2002

	I fixed a minor issue with <Destroy> handling.
	A catch was needed to prevent an error
	message, due to several <Destroy> events
	occuring in some cases.


2.6.4 - Tue Jul 23 19:29:49 MDT 2002

	I fixed a minor bug with the linemap updating.
	I didn't notice that with a small number of
	lines it wasn't displaying the line numbers 
	properly.

	I fixed a major flaw with 8.4 handling.  The
	8.4 text widget has some new features, and 
	the edit instance command wasn't dealing with
	the requests properly.  Now it should, but
	I haven't tested it a lot. 


2.6.3 - Fri Jul  5 11:32:42 MDT 2002

	I made improvements to ctext::matchPair that
	should improve the speed.  I also fixed a
	bug that occured with the pattern { \}.
	
	I added an edit modified instance command.
	I'm not sure if it works like the Tk 8.4 
	version, but it should work well enough.
	
	I added edit modified tests to ctext_test.tcl
	
	I added -class Ctext to the parent frame.
	Those of you using .Xdefaults may want this.

	I updated the README for edit modified.
	
	It's about time for another study session of
	the code to fix any bugs or potential bugs.

2.6.2 - Mon Jul  1 09:31:39 MDT 2002

	I fixed a bug with <Destroy> handling.  

	I removed all calls to variable, and now use
	the fully qualified namespace name for variables.
	This makes the code more concise and cleaner.  
	
	I improved the speed of 
	ctext::addHighlightClassForSpecialChars by
	using foreach with [split $str ""].

	I added a Destroy button to ctext_test.tcl.

	I removed the -font flags in the test files, 
	so it will use what's in the X resources, or
	the default for Tk.

	I improved ctext::matchQuote:blink by doing
	if {$count & 1} rather than if {[expr {$count & 1}]}
	I need to remember that if is like expr.

	I fixed a Doh! in ctext::matchQuote.  I was 
	not thinking that the end pos is already known 
	due to the switch in the instanceCmd.	

	ctext::matchPair now works.  Try typing a pattern
	of ( ) or [ ] or { } or ( ( ) ) and so on.  It's really
	cool.  Big thanks to Mac Cody for inspiring this.  I
	didn't use any of his code for MatchPair but I looked
	at it to get a general idea.

2.6.1 - Thu Jun 27 10:55:54 MDT 2002

	I added ctext::disableComments and
	ctext::enableComments.  C comment highlighting
	is disabled by default now.  I started merging
	the changes by Mac Cody into this release.  I
	used some of his code for making quotes blink.
	I rewrote some of it to fit more with my ideals.
	I'll be merging more of his great ideas into 
	Ctext in the future.

	I fixed a bug with the C comment highlighting.
	I found that \\ was causing problems, so the
	\\\\ RE addition and \\\\ check solves that.

	I replaced func_finder.tcl with a newer file that
	should work better.  What I should probably do is
	write a minimal C parser for dealing with finding
	functions, or do another trick with the C 
	preprocessor.

	I updated the README and ctext_test_c.tcl

2.6 - Mon Jun 24 09:39:24 MDT 2002

	I radically modified ctext::comments to fix bugs
	with comments in quotes being highlighted and
	to improve speed.  It is now much faster and 
	simpler.  I added -linemapfg and -linemapbg options.
	

2.5.2 - Sun May 19 09:36:16 MDT 2002
	
	I made major changes to how the C commenting works.
	I made a serious mistake with the way that C
	comments were highlighted.  I was invoking 
	ctext::comments and there could be several
	after idle timers going that call it that were
	relying on a global array.  Basically my 
	state variables were getting clobbered.  It
	took me a while to figure this out.  Now I
	pass a [clock clicks] argument for each call
	and it creates the array if necessary and
	passes the clock clicks value in subsequent
	calls.  The end result is that now several
	ctext::comments loops can be running at 
	once and they don't clobber each other.

2.5.1 - Fri Mar 15 17:15:30 MST 2002

	I have added ctext::update which allows you
	to update a cursor or progress dialog while
	Ctext highlights text.  It works quite nicely
	in Malephiso.  I updated the README to 
	show the new change, and how to use it.  I
	also fixed a minor error in the README.

2.5 - Sat Mar  2 23:59:07 MST 2002

	I've fixed several critical bugs with deletion
	of text.  I've improved the clarity of the
	code by adding ctext::instanceCmd.  This also
	makes it so that theoretically you could
	overload ctext.  The performance of deletion
	and insertion may be better due to my use of
	a timer for highlighting.

2.4.1 - Sat Feb 23 23:12:49 MST 2002

	I fixed a bug with tag removal that occured
	when text was appended to an existing tag. 
	The fix was to use the insert position minus
	one char in the call to ctext::findPreviousSpace.
	

2.4 - Tue Feb  5 16:27:46 MST 2002

	The linemap will now update even if scrolling
	hasn't occured.  I tried to get this working 
	in previous releases, but had problems with
	display updates.  Now I use "after 1" with it,
	so it works without blocking the GUI.

	The widget should now completely clean up after
	itself I hope.  I made changes to the <Destroy>
	callback.  Please let me know if it doesn't 
	cleanup for you.


2.3.5 - Wed Jan 23 23:55:51 MST 2002

	I fixed a minor bug that caused some text tags
	to be removed when they shouldn't be when deleting
	the first character of a line.
	
	if {[$self._t compare $start < $lineStart]} {
		set start $lineStart                                    
	}	 

2.3.4 - Mon Jan 21 22:05:23 MST 2002

	I added | and , to the not chars.  This helps with C
	syntax highlighting.

2.3.3 - Mon Jan 14 23:06:39 MST 2002

	I fixed a bug with C comment highlighting that occured when
	the state of the comment handler was not reset when it reached
	the end of the text widget.  I also fixed a minor bug with
	tag removal in the delete handler.

2.3.2 - Thu Jan 10 19:48:20 MST 2002

	I added " and ' to the not chars in the main highlighting
	engine.  This makes it so that char start strings like
	$blah end at a " or '.  So, for example with $blah" every
	thing would be highlighted like the variable.  Now, it only
	highlights the $blah.

2.3.1 - Fri Jan  4 22:35:19 MST 2002
	
	I fixed a minor bug with the C comment handling.  I now
	have it working very fast for a while, and then it stops
	until being restarted when / or * is found/entered in the
	insert or delete widget instance commands.  There is one
	bug I'm trying to track down where the highlighting stops
	for apparently no reason.  It's probably good enough to 
	use for production use in Malephiso, but as usual no warranty
	to you folks.  

2.3 - Mon Dec 31 15:18:05 MST 2001

	I have added C comment highlighting.  It works properly
	but it flashes; which can be annoying.  I'm going to work
	on this more later on.

2.2.8 - Mon Dec 31 04:18:57 MST 2001

	I fixed some bugs with the delete instance command. 


2.2.7 - Sun Dec 30 18:15:10 MST 2001

	I made changes to ctext::highlight that have improved
	the speed.  They should help a lot with very large files.

2.2.6 - Sun Dec 30 16:28:26 MST 2001

	I improved the search expressions by adding -- to 
	deal with - in any of the search strings.  Using 
	ctext in Malephiso has caused me to find so many bugs
	that I had no idea about over the past week or so. 

2.2.5 - Sun Dec 30 11:10:38 MST 2001

	I fixed a bug with findPreviousSpace and findNextSpace
	which should improve the speed of tag removal, because
	it will no longer remove char tags that it doesn't 
	have to.

2.2.4 - Sun Dec 30 10:57:57 MST 2001

	I fixed a bug with the highlighting that occured when
	the whitespace is entered between a highlighted word.

	I also fixed a bug with the linemap that occured when
	an empty line was pressed.

2.2.3 - Mon Dec 24 12:53:49 MST 2001
	
	I added ; to the RE for not chars in the ctext::highlight 
	proc.

2.2.2 - Sun Dec 23 14:37:26 MST 2001

	I made a minor change to the highlighting RE, so that
	it handles things like [.widget cget -flag]  Before this
	the -flag part wouldn't have been highlighted.

	I added ctext::clearHighlightClasses which takes only
	one argument; $win.

2.2.1 - Wed Dec 19 10:18:42 MST 2001
	
	I fixed a bug that occured with some text widget commands,
	for example searching with -count.  I had to use uplevel
	in the call to the master text widget.
	 

2.2 - Wed Dec 19 06:18:08 MST 2001

	I've fixed some bugs that occured if C functions were being
	highlighted.  I changed addHighlightClassForSpecialChars
	so that it accepts a string of characters to match.  
	All addHighlightClass commands now must have a window argument.
	The window argument makes it so that you can now have multiple
	languages highlighted in separate windows.  I added 
	ctext::addHighlightClassForRegexp (see the test files for
	examples).  
	
	I'm going to write a script for finding all Tcl and Tk
 	flags via an automated search through the man pages.  This
	should hopefully help others with their custom editors
	that use ctext.
  
2.1.4
	I fixed a few bugs.  Widget destruction should now work 
	properly.

2.1.3:
Well, the diff between 2.1.2 and 2.1.3 is huge.  To summarize I've
replaced the list that stored selected linemap lines with an array,
which has improved the performance.  I've added error checking and
done a bunch of cleanup.  I've changed the indentation style.  

2.1.2:
LICENSE file added and licensing changed to BSD style.

2.1.1:
replaced addHighlightClass array setting with a list (quoting hell fix)

2.1:
added \r to the tests for the Mac
added \r to the default regexp end of line for the Mac
removed global and replaced with upvar #0 
added ctext to the prefix of ToggledList
new ctext_test2.tcl with two ctext widgets
fixed the dos2unix script, so that {lf lf} -translation is used

2.0.2:
fixed a bug with insert calling highlight improperly when pasting/inserting multiple lines
wrote dos2unix to convert from NT's \r\n to \n so that Unix people aren't annoyed.
update idletasks added to delete and insert instance commands

2.0.1:
ctext_test.tcl removed extra ctext test window

2.0-a6:
instance cget -linemap works
added more documentation to Readme.txt

2.0-a5:
removed hardcoded comment highlighting
removed debug output and console show

2.0-a4:
> 50% speedup during ctext::highlight due to a simpler regexp 
that uses not ([^ chars]+) instead.

2.0-a3:
fixed bug with cut instance command
added fastdelete and fastinsert instance commands
instance config -linemap and -yscrollcommand work
added highlight instance command
added copy, cut, paste, and append selection instance commands

2.0-a2:
proc ctext::addHighlightClassForSpecialChars
proc ctext::addHighlightClassWithOnlyCharStart
highlight function works
merged delete from 1.1.1 and fixed a bug
insert bug fix

This software is copyrighted by George Peter Staplin.  The following 
terms apply to all files associated with the software unless explicitly
disclaimed in individual files.

The authors hereby grant permission to use, copy, modify, distribute,
and license this software and its documentation for any purpose, provided
that existing copyright notices are retained in all copies and that this
notice is included verbatim in any distributions. No written agreement,
license, or royalty fee is required for any of the authorized uses.
Modifications to this software may be copyrighted by their authors
and need not follow the licensing terms described here, provided that
the new terms are clearly indicated on the first page of each file where
they apply.

IN NO EVENT SHALL THE AUTHORS OR DISTRIBUTORS BE LIABLE TO ANY PARTY
FOR DIRECT, INDIRECT, SPECIAL, INCIDENTAL, OR CONSEQUENTIAL DAMAGES
ARISING OUT OF THE USE OF THIS SOFTWARE, ITS DOCUMENTATION, OR ANY
DERIVATIVES THEREOF, EVEN IF THE AUTHORS HAVE BEEN ADVISED OF THE
POSSIBILITY OF SUCH DAMAGE.

THE AUTHORS AND DISTRIBUTORS SPECIFICALLY DISCLAIM ANY WARRANTIES,
INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY,
FITNESS FOR A PARTICULAR PURPOSE, AND NON-INFRINGEMENT.  THIS SOFTWARE
IS PROVIDED ON AN "AS IS" BASIS, AND THE AUTHORS AND DISTRIBUTORS HAVE
NO OBLIGATION TO PROVIDE MAINTENANCE, SUPPORT, UPDATES, ENHANCEMENTS, OR
MODIFICATIONS.

	o Author

	George Peter Staplin

	See also: Thanks (below)


	o Licensing

	BSD style see the LICENSE file


	o Installation

	Ctext requires only one file named ctext.tcl.  You
	can source this file or if you prefer to use
	"package require ctext" you can use the install.tcl
	script.  The install script can be run like so:
	wish8.4 install.tcl

	If you are a developer I highly recommend that you 
	study the Usage section below.  If you need an 
	example then see the test files (especialy 
	ctext_test_interactive.tcl).


	o How it Works

	Ctext overloads the text widget and provides
	new commands, named highlight, copy, paste, cut,
	append, and edit.  It also provides several
	commands that allow you to define classes.
	Each class corresponds to a tag in the widget.
 

	o Usage
	
	Ctext can be used like so:
	pack [ctext .t]
	.t fastinsert end $data
	.t highlight 1.0 end  
	
	The copy, paste, and cut widget commands are frontends
	for tk_text*, but they don't require giving an argument 
	for the text widget window.  I have also addded an 
	append command, which appends the current selection
	to the existing clipboard text.

	An edit modified command is available that keeps
	track of whether or not data in the widget has been
	modified.  .t edit modified would return 0 if the
	data hasn't been modified.  To set the value after
	inserting text you can use .t edit modified 0.  It
	will automatically be set to 1 during
	insertion/deletion cut/paste etc.
	
	During insertion and deletion of text in the widget
	the tags and highlighting will be automatically
	updated, unless you specify -highlight 0 during
	creation or instance configuration of the widget.

	All of the flags that the text widget supports work.  
	It also supports new flags.  These new flags are:

	-linemap creates a line number list on the left of 
	the widget.

	-linemapfg changes the foreground of the linemap.
	The default is the same color as the main text 
	widget.

	-linemapbg changes the background of the linemap.
	The default is the same color as the main text 
	widget.

	-linemap_select_fg changes the selected 
	line foreground.  The default is black.
	
	-linemap_select_bg changes the selected line 
	background.  The default is yellow.

	-linemap_mark_command calls a procedure or command 
	with the path of the ctext window, the type which is 
	either marked or unmarked, and finally the line 
	number selected.  The proc prototype is: 
	proc linemark_cmd {win type line}.  See also 
	ctext_test_interactive.tcl

	-highlight takes a boolean value which defines
	whether or not to highlight text which is inserted 
	or deleted.  The default is 1.

	-linemap_markable takes a boolean value which
	specifies whether or not lines in the linemap
	are markable with the mouse.  The default is 1.
	
	Four highlighting procedures are available for adding 
	keywords.  Each proc takes a class, color, keyword, 
	and window argument.  The highlight widget command will 
	automatically use each class that you add with any of 
	the three functions.  If you want to change the font 
	of a class or another attribute you can run a 
	command like this:
	.t tag configure $className -font {Helvetica 16}
	
	Note that the tag is created when you add a class.

	Normal keywords:
	ctext::addHighlightClass .t class color [list string1 string2 ...]

	Strings that start with chars like $, for $var:
	ctext::addHighlightClassWithOnlyCharStart .t class color "\$"

	A series of characters in a string
	ctext:addHighlightClassForSpecialChars .t class color {[]{}}

	Comments, and other things that need regexp:
	ctext::addHighlightClassForRegexp .t class color {#\[^\n\]*}

	ctext::clearHighlightClasses clears all of the 
	highlight classes from the widget specified.  
	Example: ctext::clearHighlightClasses .t

	To get a list of classes defined for a widget do 
	something like: ctext::getHighlightClasses .t

	To delete a highlight class do something like:
	ctext::deleteHighlightClass .t classNameToDelete

	You can update a cursor while ctext highlights a large file
	by overriding ctext::update.  Simply source ctext.tcl then
	create your ctext::update proc, and it will be called by
	ctext.  This allows you to have a progress dialog, or animated
	cursor.

	If you are using C and want C comments highlighted you can
	use ctext::enableComments.  You can modify the colors of 
	C comments by configuring the tag _cComment after enabling with
	the afformentioned command.  The C comment highlighting is
	disabled by default.


	I have personally tested it with Tcl/Tk 8.4.4 in NetBSD.
	It should work with all Tcl platforms.

	Please send comments and bugs to [email protected]

	o Thanks

	Kevin Kenny, Neil Madden, Jeffrey Hobbs, Richard Suchenwirth, 
	Johan Bengtsson, Mac Cody, G�nther, and Andreas Sievers.

Due to changes between the 2.7 and 3.1 release you may need to remove escapes in your class patterns.  This is due to my former inproper use of quotes, which I have now replaced with lists.  The escaping is no longer necessary.

Some fonts don't display a bitmap properly.  The size of the bitmap seems to be the issue.   This seems to be a bug with the text widget.

Make the flags that ctext adds have Class and resource names.  Also make .t config return those resource/class names.  I suspect that I could do this by making each value for a flag a list, but this needs proper planning before I go coding in the unknown.

# By George Peter Staplin
# See also the README for a list of contributors
# RCS: @(#) $Id: ctext.tcl,v 1.1.1.1 2004/01/23 00:32:16 georgeps Exp $

package require Tk
package provide ctext 3.1

namespace eval ctext {}

#win is used as a unique token to create arrays for each ctext instance
proc ctext::getAr {win suffix name} {
	set arName __ctext[set win][set suffix]
	uplevel [list upvar #0 $arName $name]
	return $arName
}

proc ctext {win args} { 
	if {[llength $args] & 1} {
		return -code error "invalid number of arguments given to ctext (uneven number after window) : $args"
	}
	
	frame $win -class Ctext

	set tmp [text .__ctextTemp]
	
	ctext::getAr $win config ar

	set ar(-fg) [$tmp cget -foreground]
	set ar(-bg) [$tmp cget -background]
	set ar(-font) [$tmp cget -font]
	set ar(-relief) [$tmp cget -relief]
	destroy $tmp
	set ar(-yscrollcommand) ""
	set ar(-linemap) 1
	set ar(-linemapfg) $ar(-fg)
	set ar(-linemapbg) $ar(-bg)
	set ar(-linemap_mark_command) {}
	set ar(-linemap_markable) 1
	set ar(-linemap_select_fg) black
	set ar(-linemap_select_bg) yellow
	set ar(-highlight) 1
	set ar(win) $win
	set ar(modified) 0
	
	set ar(ctextFlags) [list -yscrollcommand -linemap -linemapfg -linemapbg \
-font -linemap_mark_command -highlight -linemap_markable -linemap_select_fg \
-linemap_select_bg]
	
	array set ar $args
	
	foreach flag {foreground background} short {fg bg} {
		if {[info exists ar(-$flag)] == 1} {
			set ar(-$short) $ar(-$flag)
			unset ar(-$flag)
		}
	}
	
	#Now remove flags that will confuse text and those that need modification:
	foreach arg $ar(ctextFlags) {
		set loc [lsearch $args $arg]
		if {$loc >= 0} {
			set args [lreplace $args $loc [expr {$loc + 1}]]
		}
	}
	
	text $win.l -font $ar(-font) -width 1 -height 1 \
		-relief $ar(-relief) -fg $ar(-linemapfg) -bg $ar(-linemapbg) -takefocus 0

	set topWin [winfo toplevel $win]
	bindtags $win.l [list $win.l $topWin all]

	if {$ar(-linemap) == 1} {
		pack $win.l -side left -fill y
	}
	
	set args [concat $args [list -yscrollcommand [list ctext::event:yscroll $win $ar(-yscrollcommand)]]]

	#escape $win, because it could have a space
	pack [eval text \$win.t $args -font \$ar(-font)] -side right -fill both -expand 1

	bind $win.t <Configure> [list ctext::linemapUpdate $win]
	bind $win.l <ButtonPress-1> [list ctext::linemapToggleMark $win %y]
	bind $win.t <KeyRelease-Return> [list ctext::linemapUpdate $win]
	rename $win __ctextJunk$win
	rename $win.t $win._t

	bind $win <Destroy> [list ctext::event:Destroy $win %W]
	bindtags $win.t [linsert [bindtags $win.t] 0 $win]

	interp alias {} $win {} ctext::instanceCmd $win
	interp alias {} $win.t {} $win
	
	#If the user wants C comments they should call ctext::enableComments
	ctext::disableComments $win
	ctext::modified $win 0
	ctext::buildArgParseTable $win

	return $win
}

proc ctext::event:yscroll {win clientData args} {
	ctext::linemapUpdate $win

	if {$clientData == ""} {
		return
	}
	uplevel #0 $clientData $args
}

proc ctext::event:Destroy {win dWin} {
	if {![string equal $win $dWin]} {
		return
	}
	catch {rename $win {}}
	interp alias {} $win.t {}
	ctext::clearHighlightClasses $win
	array unset [ctext::getAr $win config ar]
}

#This stores the arg table within the config array for each instance.
#It's used by the configure instance command.
proc ctext::buildArgParseTable win {
	set argTable [list]

	lappend argTable any -linemap_mark_command {
		set configAr(-linemap_mark_command) $value
		break
	}

	lappend argTable {1 true yes} -linemap {
		pack $self.l -side left -fill y
		set configAr(-linemap) 1
		break
	}

	lappend argTable {0 false no} -linemap {
		pack forget $self.l
		set configAr(-linemap) 0
		break
	}

	lappend argTable any -yscrollcommand {
		set cmd [list $self._t config -yscrollcommand [list ctext::event:yscroll $self $value]]

		if {[catch $cmd res]} {
			return $res
		}
		set configAr(-yscrollcommand) $value
		break
	}

	lappend argTable any -linemapfg {
		if {[catch {winfo rgb $self $value} res]} {
			return -code error $res
		}
		$self.l config -fg $value
		set configAr(-linemapfg) $value
		break
	}

	lappend argTable any -linemapbg {
		if {[catch {winfo rgb $self $value} res]} {
			return -code error $res
		}
		$self.l config -bg $value
		set configAr(-linemapbg) $value
		break
	}

	lappend argTable any -font {
		if {[catch {$self.l config -font $value} res]} {
			return -code error $res
		}
		$self._t config -font $value
		set configAr(-font) $value
		break
	}

	lappend argTable {0 false no} -highlight {
		set configAr(-highlight) 0
		break
	}

	lappend argTable {1 true yes} -highlight {
		set configAr(-highlight) 1
		break
	}

	lappend argTable {0 false no} -linemap_markable {
		set configAr(-linemap_markable) 0
		break
	}

	lappend argTable {1 true yes} -linemap_markable {
		set configAr(-linemap_markable) 1
		break
	}

	lappend argTable any -linemap_select_fg {
		if {[catch {winfo rgb $self $value} res]} {
			return -code error $res
		}
		set configAr(-linemap_select_fg) $value
		$self.l tag configure lmark -foreground $value
		break
	}

	lappend argTable any -linemap_select_bg {
		if {[catch {winfo rgb $self $value} res]} {
			return -code error $res
		}
		set configAr(-linemap_select_bg) $value
		$self.l tag configure lmark -background $value
		break
	}

	ctext::getAr $win config ar
	set ar(argTable) $argTable
}

proc ctext::instanceCmd {self cmd args} {
	#slightly different than the RE used in ctext::comments
	set commentRE {\"|\\|'|/|\*}

	switch -glob -- $cmd {
		append {
			if {[catch {$self._t get sel.first sel.last} data] == 0} {
				clipboard append -displayof $self $data
			}
		}

		cget {
			set arg [lindex $args 0]
			ctext::getAr $self config configAr

			foreach flag $configAr(ctextFlags) {
				if {[string match ${arg}* $flag]} {
					return [set configAr($flag)]
				}
			}
			return [$self._t cget $arg]
		}

		conf* {
			ctext::getAr $self config configAr

			if {0 == [llength $args]} {
				set res [$self._t configure]
				set del [lsearch -glob $res -yscrollcommand*]		
				set res [lreplace $res $del $del]
			
				foreach flag $configAr(ctextFlags) {
					lappend res [list $flag [set configAr($flag)]]
				}				
				return $res
			}
			
			array set flags {}
			foreach flag $configAr(ctextFlags) {
				set loc [lsearch $args $flag]
				if {$loc < 0} {
					continue
				}
				
				if {[llength $args] <= ($loc + 1)} {
					#.t config -flag
					return [set configAr($flag)]
				}

				set flagArg [lindex $args [expr {$loc + 1}]]
				set args [lreplace $args $loc [expr {$loc + 1}]]
				set flags($flag) $flagArg
			}

			foreach {valueList flag cmd} $configAr(argTable) {
				if {[info exists flags($flag)]} {
					foreach valueToCheckFor $valueList {
						set value [set flags($flag)]
						if {[string equal "any" $valueToCheckFor]} $cmd \
						elseif {[string equal $valueToCheckFor [set flags($flag)]]} $cmd 
					}
				}
			}
			
			if {[llength $args]} {
				#we take care of configure without args at the top of this branch
				uplevel 1 [linsert $args 0 $self._t configure]
			}
		}

		copy {
			tk_textCopy $self
		} 

		cut {
			if {[catch {$self.t get sel.first sel.last} data] == 0} {
				clipboard clear -displayof $self.t
				clipboard append -displayof $self.t $data
				$self delete [$self.t index sel.first] [$self.t index sel.last]
				ctext::modified $self 1
			}
		}

		delete {
			#delete n.n ?n.n
			
			#first deal with delete n.n
			set argsLength [llength $args]
			
			if {$argsLength == 1} {
				set deletePos [lindex $args 0]
				set prevChar [$self._t get $deletePos]
				
				$self._t delete $deletePos
				set char [$self._t get $deletePos]
				
				set prevSpace [ctext::findPreviousSpace $self._t $deletePos]
				set nextSpace [ctext::findNextSpace $self._t $deletePos]
				
				set lineStart [$self._t index "$deletePos linestart"]
				set lineEnd [$self._t index "$deletePos + 1 chars lineend"]
				
				if {[string equal $prevChar "#"] || [string equal $char "#"]} {
					set removeStart $lineStart
					set removeEnd $lineEnd
				} else {
					set removeStart $prevSpace
					set removeEnd $nextSpace
				}
				
				foreach tag [$self._t tag names] {
					if {[string equal $tag "_cComment"] != 1} {
						$self._t tag remove $tag $removeStart $removeEnd
					}
				}
				
				set checkStr "$prevChar[set char]"
				
				if {[regexp $commentRE $checkStr]} {
					after idle [list ctext::comments $self]
				}
				ctext::highlight $self $lineStart $lineEnd
				ctext::linemapUpdate $self
			} elseif {$argsLength == 2} {
				#now deal with delete n.n ?n.n?
				set deleteStartPos [lindex $args 0]
				set deleteEndPos [lindex $args 1]
				
				set data [$self._t get $deleteStartPos $deleteEndPos]
				
				set lineStart [$self._t index "$deleteStartPos linestart"]
				set lineEnd [$self._t index "$deleteEndPos + 1 chars lineend"]
				eval \$self._t delete $args
				
				foreach tag [$self._t tag names] {
					if {[string equal $tag "_cComment"] != 1} {
						$self._t tag remove $tag $lineStart $lineEnd
					}
				}
				
				if {[regexp $commentRE $data]} {
					after idle [list ctext::comments $self]
				}
				
				ctext::highlight $self $lineStart $lineEnd
				if {[string first "\n" $data] >= 0} {
					ctext::linemapUpdate $self
				}
			} else {
				return -code error "invalid argument(s) sent to $self delete: $args"
			}
			ctext::modified $self 1
		}

		fastdelete {
			eval \$self._t delete $args
			ctext::modified $self 1
			ctext::linemapUpdate $self
		}
		
		fastinsert {
			eval \$self._t insert $args
			ctext::modified $self 1
			ctext::linemapUpdate $self
		}
		
		highlight {
			ctext::highlight $self [lindex $args 0] [lindex $args 1]
			ctext::comments $self
		}

		insert {
			if {[llength $args] < 2} {
				return -code error "please use at least 2 arguments to $self insert"
			}
			set insertPos [lindex $args 0]  
			set prevChar [$self._t get "$insertPos - 1 chars"]
			set nextChar [$self._t get $insertPos]
			set lineStart [$self._t index "$insertPos linestart"]
			set prevSpace [ctext::findPreviousSpace $self._t ${insertPos}-1c]
			set data [lindex $args 1]   
			eval \$self._t insert $args 

			set nextSpace [ctext::findNextSpace $self._t insert]
			set lineEnd [$self._t index "insert lineend"] 
			 
			if {[$self._t compare $prevSpace < $lineStart]} {
				set prevSpace $lineStart
			}

			if {[$self._t compare $nextSpace > $lineEnd]} {
				set nextSpace $lineEnd
			}
			
			foreach tag [$self._t tag names] { 
				if {[string equal $tag "_cComment"] != 1} {
					$self._t tag remove $tag $prevSpace $nextSpace 
				}
			} 

			set REData $prevChar
			append REData $data
			append REData $nextChar
			if {[regexp $commentRE $REData]} {
				after idle [list ctext::comments $self]
			}
			
			after idle [list ctext::highlight $self $lineStart $lineEnd]
			switch -- $data {
				"\}" {
					ctext::matchPair $self "\\\{" "\\\}" "\\"
				}
				"\]" {
					ctext::matchPair $self "\\\[" "\\\]" "\\"
				}
				"\)" {
					ctext::matchPair $self "\\(" "\\)" ""
				}
				"\"" {
					ctext::matchQuote $self
				}
			}
			ctext::modified $self 1
			ctext::linemapUpdate $self
		}

		paste {
			tk_textPaste $self 
			ctext::modified $self 1
		}

		edit {
			set subCmd [lindex $args 0]
			set argsLength [llength $args]
			
			ctext::getAr $self config ar

			if {"modified" == $subCmd} {
				if {$argsLength == 1} {
					return $ar(modified)
				} elseif {$argsLength == 2} {
					set value [lindex $args 1]
					set ar(modified) $value
				} else {
					return -code error "invalid arg(s) to $self edit modified: $args"
				}
			} else {
				#Tk 8.4 has other edit subcommands that I don't want to emulate.
				return [uplevel 1 [linsert $args 0 $self._t $cmd]]
			}
		}
		
		default { 
			return [uplevel 1 [linsert $args 0 $self._t $cmd]]
		}
	}
}

proc ctext::tag:blink {win count} {
	if {$count & 1} {
		$win tag configure __ctext_blink -foreground [$win cget -bg] -background [$win cget -fg]
	} else {
		$win tag configure __ctext_blink -foreground [$win cget -fg] -background [$win cget -bg]
	}

	if {$count == 4} {
		$win tag delete __ctext_blink 1.0 end
		return
	}
	incr count
	after 50 [list ctext::tag:blink $win $count]
}

proc ctext::matchPair {win str1 str2 escape} {
	set prevChar [$win get "insert - 2 chars"]
	
	if {[string equal $prevChar $escape]} {
		#The char that we thought might be the end is actually escaped.
		return
	}

	set searchRE "[set str1]|[set str2]"
	set count 1
	
	set pos [$win index "insert - 1 chars"]
	set endPair $pos
	set lastFound ""
	while 1 {
		set found [$win search -backwards -regexp $searchRE $pos]
		
		if {$found == "" || [$win compare $found > $pos]} {
			return
		}

		if {$lastFound != "" && [$win compare $found == $lastFound]} {
			#The search wrapped and found the previous search
			return
		}
		
		set lastFound $found
		set char [$win get $found]
		set prevChar [$win get "$found - 1 chars"]
		set pos $found

		if {[string equal $prevChar $escape]} {
			continue
		} elseif {[string equal $char [subst $str2]]} {
			incr count
		} elseif {[string equal $char [subst $str1]]} {
			incr count -1
			if {$count == 0} {
				set startPair $found
				break
			} 
		} else {
			#This shouldn't happen.  I may in the future make it return -code error
			puts stderr "ctext seems to have encountered a bug in ctext::matchPair"
			return
		}
	}
	
	$win tag add __ctext_blink $startPair
	$win tag add __ctext_blink $endPair
	ctext::tag:blink $win 0
}

proc ctext::matchQuote {win} {
	set endQuote [$win index insert]
	set start [$win index "insert - 1 chars"]
	
	if {[$win get "$start - 1 chars"] == "\\"} {
		#the quote really isn't the end
		return
	}
	set lastFound ""
	while 1 {
		set startQuote [$win search -backwards \" $start]
		if {$startQuote == "" || [$win compare $startQuote > $start]} {
			#The search found nothing or it wrapped.
			return
		}

		if {$lastFound != "" && [$win compare $lastFound == $startQuote]} {
			#We found the character we found before, so it wrapped.
			return
		}
		set lastFound $startQuote
		set start [$win index "$startQuote - 1 chars"]
		set prevChar [$win get $start]

		if {$prevChar == "\\"} {
			continue
		}
		break
	}
	
	if {[$win compare $endQuote == $startQuote]} {
		#probably just \"
		return
	}
	
	$win tag add __ctext_blink $startQuote $endQuote
	ctext::tag:blink $win 0
}

proc ctext::enableComments {win} {
	$win tag configure _cComment -foreground khaki
}
proc ctext::disableComments {win} {
	catch {$win tag delete _cComment}
}

proc ctext::comments {win} {
	if {[catch {$win tag cget _cComment -foreground}]} {
		#C comments are disabled
		return
	}

	set startIndex 1.0
	set commentRE {\\\\|\"|\\\"|\\'|'|/\*|\*/}
	set commentStart 0
	set isQuote 0
	set isSingleQuote 0
	set isComment 0
	$win tag remove _cComment 1.0 end
	while 1 {
		set index [$win search -count length -regexp $commentRE $startIndex end]
		
		if {$index == ""} {
			break
		}
		
		set endIndex [$win index "$index + $length chars"]
		set str [$win get $index $endIndex]
		set startIndex $endIndex

		if {$str == "\\\\"} {
			continue
		} elseif {$str == "\\\""} {
			continue
		} elseif {$str == "\\'"} {
			continue
		} elseif {$str == "\"" && $isComment == 0 && $isSingleQuote == 0} {
			if {$isQuote} {
				set isQuote 0
			} else {
				set isQuote 1
			}
		} elseif {$str == "'" && $isComment == 0 && $isQuote == 0} {
			if {$isSingleQuote} {
				set isSingleQuote 0
			} else {
				set isSingleQuote 1
			}
		} elseif {$str == "/*" && $isQuote == 0 && $isSingleQuote == 0} {
			if {$isComment} {
				#comment in comment
				break
			} else {
				set isComment 1
				set commentStart $index
			}
		} elseif {$str == "*/" && $isQuote == 0 && $isSingleQuote == 0} {
			if {$isComment} {
				set isComment 0
				$win tag add _cComment $commentStart $endIndex
				$win tag raise _cComment
			} else {
				#comment end without beginning
				break
			}
		}
	}
}

proc ctext::addHighlightClass {win class color keywords} { 
	set ref [ctext::getAr $win highlight ar]
	foreach word $keywords {
		set ar($word) [list $class $color]
	}
	$win tag configure $class 

	ctext::getAr $win classes classesAr
	set classesAr($class) [list $ref $keywords]
}

#For [ ] { } # etc.
proc ctext::addHighlightClassForSpecialChars {win class color chars} {  
	set charList [split $chars ""]

	set ref [ctext::getAr $win highlightSpecialChars ar]
	foreach char $charList {
		set ar($char) [list $class $color]
	}
	$win tag configure $class 

	ctext::getAr $win classes classesAr
	set classesAr($class) [list $ref $charList]
}

proc ctext::addHighlightClassForRegexp {win class color re} {  
	set ref [ctext::getAr $win highlightRegexp ar]

	set ar($class) [list $re $color]
	$win tag configure $class 

	ctext::getAr $win classes classesAr
	set classesAr($class) [list $ref $class]
}

#For things like $blah 
proc ctext::addHighlightClassWithOnlyCharStart {win class color char} { 
	set ref [ctext::getAr $win highlightCharStart ar]

	set ar($char) [list $class $color]
	$win tag configure $class 

	ctext::getAr $win classes classesAr
	set classesAr($class) [list $ref $char]
}

proc ctext::deleteHighlightClass {win classToDelete} {
	ctext::getAr $win classes classesAr

	if {![info exists classesAr($classToDelete)]} {
		return -code error "$classToDelete doesn't exist"
	}
	
	foreach {ref keyList} [set classesAr($classToDelete)] {
		upvar #0 $ref refAr
		foreach key $keyList {
			if {![info exists refAr($key)]} {
				continue
			}
			unset refAr($key)
		}
	}
	unset classesAr($classToDelete)
}

proc ctext::getHighlightClasses win {
	ctext::getAr $win classes classesAr

	set res [list]

	foreach {class info} [array get classesAr] {
		lappend res $class
	}
	return $res
}

proc ctext::findNextChar {win index char} {
	set i [$win index "$index + 1 chars"]
	set lineend [$win index "$i lineend"]
	while 1 {
		set ch [$win get $i]
		if {[$win compare $i >= $lineend]} {
			return ""
		}
		if {$ch == $char} {
			return $i
		}
		set i [$win index "$i + 1 chars"]
	}
}

proc ctext::findNextSpace {win index} {
	set i [$win index $index]
	set lineStart [$win index "$i linestart"]
	set lineEnd [$win index "$i lineend"]
	#Sometimes the lineend fails (I don't know why), so add 1 and try again.
	if {[$win compare $lineEnd == $lineStart]} {
		set lineEnd [$win index "$i + 1 chars lineend"]
	}

	while {1} {
		set ch [$win get $i]

		if {[$win compare $i >= $lineEnd]} {
			set i $lineEnd
			break
		}

		if {[string is space $ch]} { 
			break
		}
		set i [$win index "$i + 1 chars"]
	}
	return $i
}

proc ctext::findPreviousSpace {win index} {
	set i [$win index $index]
	set lineStart [$win index "$i linestart"]
	while {1} {
		set ch [$win get $i]

		if {[$win compare $i <= $lineStart]} {
			set i $lineStart
			break
		}

		if {[string is space $ch]} {
			break
		}
		
		set i [$win index "$i - 1 chars"]
	}
	return $i
}

proc ctext::clearHighlightClasses {win} {
	#no need to catch, because array unset doesn't complain
	#puts [array exists ::ctext::highlight$win]

	ctext::getAr $win highlight ar
	array unset ar
	
	ctext::getAr $win highlightSpecialChars ar
	array unset ar
	
	ctext::getAr $win highlightRegexp ar
	array unset ar
	
	ctext::getAr $win highlightCharStart ar
	array unset ar
	
	ctext::getAr $win classes ar
	array unset ar
}

#This is a proc designed to be overwritten by the user.
#It can be used to update a cursor or animation while
#the text is being highlighted.
proc ctext::update {} {

}

proc ctext::highlight {win start end} {
	ctext::getAr $win config configAr

	if {!$configAr(-highlight)} {
		return
	}

	set si $start
	set twin "$win._t"
	
	#The number of times the loop has run.
	set numTimesLooped 0
	set numUntilUpdate 600

	ctext::getAr $win highlight highlightAr
	ctext::getAr $win highlightSpecialChars highlightSpecialCharsAr
	ctext::getAr $win highlightRegexp highlightRegexpAr
	ctext::getAr $win highlightCharStart highlightCharStartAr

	while 1 {
		set res [$twin search -count length -regexp -- {([^\s\(\{\[\}\]\)\.\t\n\r;\"'\|,]+)} $si $end]
		if {$res == ""} { 
			break 
		} 
		
		set wordEnd [$twin index "$res + $length chars"]
		set word [$twin get $res $wordEnd] 
		set firstOfWord [string index $word 0]

		if {[info exists highlightAr($word)] == 1} {
			set wordAttributes [set highlightAr($word)]
			foreach {tagClass color} $wordAttributes break
			
			$twin tag add $tagClass $res $wordEnd
			$twin tag configure $tagClass -foreground $color

		} elseif {[info exists highlightCharStartAr($firstOfWord)] == 1} {
			set wordAttributes [set highlightCharStartAr($firstOfWord)]
			foreach {tagClass color} $wordAttributes break
			
			$twin tag add $tagClass $res $wordEnd 
			$twin tag configure $tagClass -foreground $color
		}
		set si $wordEnd

		incr numTimesLooped
		if {$numTimesLooped >= $numUntilUpdate} {
			ctext::update
			set numTimesLooped 0
		}
	}
	
	foreach {ichar tagInfo} [array get highlightSpecialCharsAr] {
		set si $start
		foreach {tagClass color} $tagInfo break

		while 1 {
			set res [$twin search -- $ichar $si $end] 
			if {"" == $res} { 
				break 
			} 
			set wordEnd [$twin index "$res + 1 chars"]
	
			$twin tag add $tagClass $res $wordEnd
			$twin tag configure $tagClass -foreground $color
			set si $wordEnd

			incr numTimesLooped
			if {$numTimesLooped >= $numUntilUpdate} {
				ctext::update
				set numTimesLooped 0
			}
		}
	}
	
	foreach {tagClass tagInfo} [array get highlightRegexpAr] {
		set si $start
		foreach {re color} $tagInfo break
		while 1 {
			set res [$twin search -count length -regexp -- $re $si $end] 
			if {"" == $res} { 
				break 
			} 
		
			set wordEnd [$twin index "$res + $length chars"]
			$twin tag add $tagClass $res $wordEnd
			$twin tag configure $tagClass -foreground $color
			set si $wordEnd
			
			incr numTimesLooped
			if {$numTimesLooped >= $numUntilUpdate} {
				ctext::update
				set numTimesLooped 0
			}
		}
	}
}

proc ctext::linemapToggleMark {win y} {
	ctext::getAr $win config configAr
	
	if {!$configAr(-linemap_markable)} {
		return
	}
	
	set markChar [$win.l index @0,$y] 
	set lineSelected [lindex [split $markChar .] 0]
	set line [$win.l get $lineSelected.0 $lineSelected.end]

	if {$line == ""} {
		return
	}

	ctext::getAr $win linemap linemapAr
	
	if {[info exists linemapAr($line)] == 1} { 
		#It's already marked, so unmark it.
		array unset linemapAr $line
		ctext::linemapUpdate $win
		set type unmarked
	} else {
		#This means that the line isn't toggled, so toggle it.
		array set linemapAr [list $line {}]
		$win.l tag add lmark $markChar [$win.l index "$markChar lineend"] 
		$win.l tag configure lmark -foreground $configAr(-linemap_select_fg) \
-background $configAr(-linemap_select_bg)
		set type marked
	}

	if {[string length $configAr(-linemap_mark_command)]} {
		uplevel #0 [linsert $configAr(-linemap_mark_command) end $win $type $line]
	}
}

#args is here because -yscrollcommand may call it
proc ctext::linemapUpdate {win args} {
	if {[winfo exists $win.l] != 1} { 
		return
	}

	set pixel 0
	set lastLine {}
	set lineList [list]
	set fontMetrics [font metrics [$win._t cget -font]]
	set incrBy [expr {1 + ([lindex $fontMetrics 5] / 2)}]

	while {$pixel < [winfo height $win.l]} {
		set idx [$win._t index @0,$pixel]

		if {$idx != $lastLine} {
			set line [lindex [split $idx .] 0]
			set lastLine $idx
			$win.l config -width [string length $line]
			lappend lineList $line
		}
		incr pixel $incrBy 
	} 

	ctext::getAr $win linemap linemapAr
	
	$win.l delete 1.0 end
	set lastLine {}
	foreach line $lineList {
		if {$line == $lastLine} {
			$win.l insert end "\n" 
		} else {
			if {[info exists linemapAr($line)]} { 
				$win.l insert end "$line\n" lmark
			} else {
				$win.l insert end "$line\n"
			}
		}
		set lastLine $line
	}
}

proc ctext::modified {win value} {
	ctext::getAr $win config ar
	set ar(modified) $value
	event generate $win <<Modified>>
	return $value
}

source ./ctext.tcl

scrollbar .y -orient vertical -command {.t yview}
ctext .t -xscrollcommand {.x set} -yscrollcommand {.y set} -wrap none
scrollbar .x -orient horizontal -command {.t xview}


grid .y -sticky ns
grid .t -row 0 -column 1
grid .x -column 1 -sticky we

#!/bin/sh 
# the next line restarts using wish \
exec wish "$0" ${1+"$@"} 

#set tcl_traceExec 1

proc main {} {
	source ./ctext.tcl

	pack [frame .f] -fill both -expand 1
	#Of course this could be cscrollbar instead, but it's not as common.
	pack [scrollbar .f.s -command {.f.t yview}] -side right -fill y

	#Dark colors
	pack [ctext .f.t -linemap 1 -bg black -fg white -insertbackground yellow \
		-yscrollcommand {.f.s set}] -fill both -expand 1

	ctext::addHighlightClass .f.t widgets purple [list obutton button label text frame toplevel \
		cscrollbar scrollbar checkbutton canvas listbox menu menubar menubutton \
		radiobutton scale entry message tk_chooseDir tk_getSaveFile \
		tk_getOpenFile tk_chooseColor tk_optionMenu]

	ctext::addHighlightClass .f.t flags orange [list -text -command -yscrollcommand \
		-xscrollcommand -background -foreground -fg -bg \
		-highlightbackground -y -x -highlightcolor -relief -width \
		-height -wrap -font -fill -side -outline -style -insertwidth \
		-textvariable -activebackground -activeforeground -insertbackground \
		-anchor -orient -troughcolor -nonewline -expand -type -message \
		-title -offset -in -after -yscroll -xscroll -forward -regexp -count \
		-exact -padx -ipadx -filetypes -all -from -to -label -value -variable \
		-regexp -backwards -forwards -bd -pady -ipady -state -row -column \
		-cursor -highlightcolors -linemap -menu -tearoff -displayof -cursor \
		-underline -tags -tag]

	ctext::addHighlightClass .f.t stackControl red {proc uplevel namespace while for foreach if else}
	ctext::addHighlightClassWithOnlyCharStart .f.t vars mediumspringgreen "\$"
	ctext::addHighlightClass .f.t htmlText yellow "<b> </b> <i> </i>"
	ctext::addHighlightClass .f.t variable_funcs gold {set global variable unset}
	ctext::addHighlightClassForSpecialChars .f.t brackets green {[]{}}
	ctext::addHighlightClassForRegexp .f.t paths lightblue {\.[a-zA-Z0-9\_\-]+}
	ctext::addHighlightClassForRegexp .f.t comments khaki {#[^\n\r]*}
	#After overloading, insertion is a little slower with the 
	#regular insert, so use fastinsert.
	#set fi [open Ctext_Bug_Crasher.tcl r]
	set fi [open long_test_script r]
	.f.t fastinsert end [read $fi]
	close $fi
	
	pack [frame .f1] -fill x

	pack [button .f1.append -text Append -command {.f.t append}] -side left
	pack [button .f1.cut -text Cut -command {.f.t cut}] -side left
	pack [button .f1.copy -text Copy -command {.f.t copy}] -side left
	pack [button .f1.paste -text Paste -command {.f.t paste}] -side left
	.f.t highlight 1.0 end
	pack [button .f1.test -text {Remove all Tags and Highlight} \
		-command {puts [time {
			foreach tag [.f.t tag names] {
				.f.t tag remove $tag 1.0 end
			}
			update idletasks
			.f.t highlight 1.0 end
			}]
		}
	] -side left
	pack [button .f1.fastdel -text {Fast Delete} -command {.f.t fastdelete 1.0 end}] -side left

	pack [frame .f2] -fill x
	pack [button .f2.test2 -text {Scrollbar Command {}} -command {.f.t config -yscrollcommand {}}] -side left
	pack [button .f2.cl -text {Clear Classes} -command {ctext::clearHighlightClasses .f.t}] -side left
	pack [button .f2.des -text Destroy -command {destroy .f.t}] -side left
	pack [button .f2.editModSet0 -text "Set Modified 0" -command {puts [.f.t edit modified 0]}] -side left
	pack [button .f2.editModGet -text "Print Modified" -command {puts [.f.t edit modified]}] -side left
	
	pack [button .f2.exit -text Exit -command exit] -side left
	
	puts [.f.t cget -linemap]
	puts [.f.t cget -linemapfg]
	puts [.f.t cget -linemapbg]
	puts [.f.t cget -bg]
}
main

#!/bin/sh 
# the next line restarts using wish \
exec wish "$0" ${1+"$@"} 

#use :: so I don't forget it's global
#set ::tcl_traceExec 1

proc highlight:addClasses {win} {
	ctext::addHighlightClassForSpecialChars $win brackets green {[]}
	ctext::addHighlightClassForSpecialChars $win braces lawngreen {{}}
	ctext::addHighlightClassForSpecialChars $win parentheses palegreen {()}
	ctext::addHighlightClassForSpecialChars $win quotes "#c65e3c" {"'}

	ctext::addHighlightClass $win control red [list namespace while for if else do switch case]
		
	ctext::addHighlightClass $win types purple [list \
	int char u_char u_int long double float typedef unsigned signed]
	
	ctext::addHighlightClass $win macros mediumslateblue [list \
	#define #undef #if #ifdef #ifndef #endif #elseif #include #import #exclude]
	
	ctext::addHighlightClassForSpecialChars $win math cyan {+=*-/&^%!|<>}
}

proc main {} {
	source ./ctext.tcl

	pack [frame .f] -fill both -expand 1
	#Of course this could be cscrollbar instead, but it's not as common.
	pack [scrollbar .f.s -command ".f.t yview"] -side right -fill y

	#Dark colors			
	pack [ctext .f.t -linemap 1 \
		-bg black -fg white -insertbackground yellow \
		-yscrollcommand ".f.s set"] -fill both -expand 1

	highlight:addClasses .f.t
	ctext::enableComments .f.t

	set fi [open test.c r]
	.f.t fastinsert end [read $fi]
	close $fi
	
	pack [button .append -text Append -command {.f.t append}] -side left
	pack [button .cut -text Cut -command {.f.t cut}] -side left
	pack [button .copy -text Copy -command {.f.t copy}] -side left
	pack [button .paste -text Paste -command {.f.t paste}] -side left
	.f.t highlight 1.0 end
	pack [button .test -text {Remove all Tags and Highlight} \
		-command {puts [time {
			foreach tag [.f.t tag names] {
				.f.t tag remove $tag 1.0 end
			}
			update idletasks
			.f.t highlight 1.0 end
			}]
		}
	] -side left
	pack [button .test2 -text {Scrollbar Command {}} -command {.f.t config -yscrollcommand {}}] -side left
	pack [button .cl -text {Clear Classes} \
		-command {ctext::clearHighlightClasses .f.t}] -side left
	pack [button .exit -text Exit -command exit] -side left
	#pack [ctext .ct2 -linemap 1] -side bottom	

	#update
	#console show
	#puts [.f.t cget -linemap]
	#puts [.f.t cget -bg]
}
main

#!/bin/sh 
# the next line restarts using wish \
exec wish "$0" ${1+"$@"} 

#set tcl_traceExec 1
proc linemap_mark_cmd {win type line} {
	puts "line $line was $type in $win"
}

proc main {} {
	source ./ctext.tcl

	pack [frame .f] -fill both -expand 1
	#Of course this could be cscrollbar instead, but it's not as common.
	pack [scrollbar .f.s -command {.f.t yview}] -side right -fill y

	#Dark colors
	pack [ctext .f.t -bg black -fg white -insertbackground yellow \
		-yscrollcommand {.f.s set} -linemap_mark_command linemap_mark_cmd] -fill both -expand 1

	ctext::addHighlightClass .f.t widgets purple [list obutton button label text frame toplevel \
		cscrollbar scrollbar checkbutton canvas listbox menu menubar menubutton \
		radiobutton scale entry message tk_chooseDir tk_getSaveFile \
		tk_getOpenFile tk_chooseColor tk_optionMenu]

	ctext::addHighlightClass .f.t flags orange [list -text -command -yscrollcommand \
		-xscrollcommand -background -foreground -fg -bg \
		-highlightbackground -y -x -highlightcolor -relief -width \
		-height -wrap -font -fill -side -outline -style -insertwidth \
		-textvariable -activebackground -activeforeground -insertbackground \
		-anchor -orient -troughcolor -nonewline -expand -type -message \
		-title -offset -in -after -yscroll -xscroll -forward -regexp -count \
		-exact -padx -ipadx -filetypes -all -from -to -label -value -variable \
		-regexp -backwards -forwards -bd -pady -ipady -state -row -column \
		-cursor -highlightcolors -linemap -menu -tearoff -displayof -cursor \
		-underline -tags -tag]

	ctext::addHighlightClass .f.t stackControl red {proc uplevel namespace while for foreach if else}
	ctext::addHighlightClassWithOnlyCharStart .f.t vars mediumspringgreen "\$"
	ctext::addHighlightClass .f.t htmlText yellow "<b> </b> <i> </i>"
	ctext::addHighlightClass .f.t variable_funcs gold {set global variable unset}
	ctext::addHighlightClassForSpecialChars .f.t brackets green {[]{}}
	ctext::addHighlightClassForRegexp .f.t paths lightblue {\.[a-zA-Z0-9\_\-]+}
	ctext::addHighlightClassForRegexp .f.t comments khaki {#[^\n\r]*}
	#After overloading, insertion is a little slower with the 
	#regular insert, so use fastinsert.
	#set fi [open Ctext_Bug_Crasher.tcl r]
	set fi [open long_test_script r]
	.f.t fastinsert end [read $fi]
	close $fi
	
	pack [frame .f1] -fill x

	pack [button .f1.append -text Append -command {.f.t append}] -side left
	pack [button .f1.cut -text Cut -command {.f.t cut}] -side left
	pack [button .f1.copy -text Copy -command {.f.t copy}] -side left
	pack [button .f1.paste -text Paste -command {.f.t paste}] -side left
	.f.t highlight 1.0 end
	pack [button .f1.test -text {Remove all Tags and Highlight} \
		-command {puts [time {
			foreach tag [.f.t tag names] {
				.f.t tag remove $tag 1.0 end
			}
			update idletasks
			.f.t highlight 1.0 end
			}]
		}
	] -side left
	pack [button .f1.fastdel -text {Fast Delete} -command {.f.t fastdelete 1.0 end}] -side left

	pack [frame .f2] -fill x
	pack [button .f2.test2 -text {Scrollbar Command {}} -command {.f.t config -yscrollcommand {}}] -side left
	pack [button .f2.cl -text {Clear Classes} -command {ctext::clearHighlightClasses .f.t}] -side left
	pack [button .f2.des -text Destroy -command {destroy .f.t}] -side left
	pack [button .f2.editModSet0 -text "Set Modified 0" -command {puts [.f.t edit modified 0]}] -side left
	pack [button .f2.editModGet -text "Print Modified" -command {puts [.f.t edit modified]}] -side left
	
	pack [button .f2.exit -text Exit -command exit] -side left

	pack [entry .e] -side bottom -fill x
	.e insert end "ctext::deleteHighlightClass .f.t "
	bind .e <Return> {puts [eval [.e get]]}
	
	puts [.f.t cget -linemap]
	puts [.f.t cget -linemapfg]
	puts [.f.t cget -linemapbg]
	puts [.f.t cget -bg]
}
main

source ./ctext.tcl
pack [ctext {.t blah}]

ctext::addHighlightClass {.t blah} c blue [list bat ball boot cat hat]
ctext::addHighlightClass {.t blah} c2 red [list bozo bull bongo]
{.t blah} highlight 1.0 end

#!/bin/tclsh8.3

proc main {argc argv} {

	array set functions ""

	foreach f $argv {
		puts stderr "PROCESSING FILE $f"

		catch {exec cc -DNeedFunctionPrototypes -E $f} data
		#set functionList [regexp -all -inline {[a-zA-Z0-9_-]+[ \t\n\r]+([a-zA-Z0-9_-]+)[ \t\n\r]+\([ \t\n\r]*([^\)]+)[ \t\n\r]*\)[ \t\n\r]*;} $data]
		set functionList [regexp -all -inline {[a-zA-Z0-9_\-\*]+[ \t\n\r\*]+([a-zA-Z0-9_\-\*]+)[ \t\n\r]*\(([^\)]*)\)[ \t\n\r]*;} $data]
		set functionList [concat $functionList \
			[regexp -all -inline {[a-zA-Z0-9_\-\*]+[ \t\n\r\*]+([a-zA-Z0-9_\-\*]+)[ \t\n\r]*_ANSI_ARGS_\(\(([^\)]*)\)\)[ \t\n\r]*;} $data]]
		#puts "FL $functionList"
		foreach {junk function args} $functionList {
			#puts "FUNC $function ARGS $args"
			set args [string map {"\n" "" "\r" "" "\t" " " "," ", "} $args]
			regsub -all {\s{2,}} $args " " args
			set functions($function) $args
		}
	}

	puts "array set ::functions \{"
	foreach function [lsort -dictionary [array names functions]] {
		if {"_" == [string index $function 0] || "_" == [string index $function end]} {
			continue
		}
		puts "\t$function [list [set functions($function)]]"
	}
	puts "\}"
}

proc sglob {pattern} {
	return [glob -nocomplain $pattern]
}

#main $argc /usr/local/include/tclDecls.h
#return
        
main $argc [concat [sglob /usr/include/*.h] [sglob /usr/include/*/*.h] \
[sglob /usr/local/include/*.h] [sglob /usr/local/include/*/*.h] \
[sglob /usr/X11R6/include/*.h] [sglob /usr/X11R6/include/*/*.h] \
[sglob /usr/X11R6/include/*/*/*.h] [sglob /usr/local/include/X11/*.h] \
[sglob /usr/local/include/X11/*/*.h]]

#Run this with the wish (Tk shell) that you want to install for.
#For example: $ wish8.4 install.tcl
	
proc event.select.install.path win {
	set i [$win curselection]
	set ::installPath [$win get $i]
}

proc install {} {
	set idir [file join $::installPath ctext]
	file mkdir $idir
	file copy -force pkgIndex.tcl $idir
	file copy -force ctext.tcl $idir
	tk_messageBox -icon info -message "Successfully installed into $idir" \
-title {Install Successful} -type ok

	exit
}

proc main {} {
	option add *foreground black
	option add *background gray65
	. config -bg gray65
	
	wm title . {Ctext Installer}
	label .title -text {Welcome to the Ctext installer} -font {Helvetica 14}
	
	message .msgauto -aspect 300 -text {The auto_path directories are automatically searched by Tcl/Tk for packages.  You may select a directory to install Ctext into, or type in a new directory.  Your auto_path directories are:}
	
	set autoLen [llength $::auto_path]
	listbox .listauto -height $autoLen
	
	for {set i 0} {$i < $autoLen} {incr i} {
		.listauto insert end [lindex $::auto_path $i]
	}
	
	bind .listauto <<ListboxSelect>> [list event.select.install.path %W]
	
	label .lipath -text {Install Path:}
	set ::installPath [lindex $::auto_path end]
	entry .installPath -textvariable ::installPath
	
	frame .fcontrol
	frame .fcontrol.finst -relief sunken -bd 1
	pack [button .fcontrol.finst.install -text Install -command install] -padx 4 -pady 4
	button .fcontrol.cancel -text Cancel -command exit
	pack .fcontrol.finst -side left -padx 5
	pack .fcontrol.cancel -side right -padx 5
	
	pack .title -fill x
	pack .msgauto -anchor w
	pack .listauto -fill both -expand 1
	pack .lipath -anchor w
	pack .installPath -fill x
	pack .fcontrol -pady 10
}
main

#By George Peter Staplin

namespace eval cscrollbar {
	variable buttonPressed 0
	variable lastX 0
	variable lastY 0
		
variable up_xbm {
#define up_width 18
#define up_height 12
static unsigned char up_bits[] = {
   0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x03, 0x00, 0x80, 0x07, 0x00,
   0xc0, 0x0f, 0x00, 0xe0, 0x1f, 0x00, 0xf0, 0x3f, 0x00, 0xf8, 0x7f, 0x00,
   0xfc, 0xff, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00};
}

variable down_xbm {
#define down_width 18
#define down_height 12
static char down_bits[] = {
   0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xfc, 0xff, 0x00,
   0xf8, 0x7f, 0x00, 0xf0, 0x3f, 0x00, 0xe0, 0x1f, 0x00, 0xc0, 0x0f, 0x00,
   0x80, 0x07, 0x00, 0x00, 0x03, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00 };
}

variable left_xbm {
#define left_width 12
#define left_height 18
static char left_bits[] = {
   0x00, 0x00, 0x00, 0x00, 0x00, 0x01, 0x80, 0x01, 0xc0, 0x01, 0xe0, 0x01,
   0xf0, 0x01, 0xf8, 0x01, 0xfc, 0x01, 0xfc, 0x01, 0xf8, 0x01, 0xf0, 0x01,
   0xe0, 0x01, 0xc0, 0x01, 0x80, 0x01, 0x00, 0x01, 0x00, 0x00, 0x00, 0x00 };
}

variable right_xbm {
#define right_width 12
#define right_height 18
static char right_bits[] = {
   0x00, 0x00, 0x00, 0x00, 0x08, 0x00, 0x18, 0x00, 0x38, 0x00, 0x78, 0x00,
   0xf8, 0x00, 0xf8, 0x01, 0xf8, 0x03, 0xf8, 0x03, 0xf8, 0x01, 0xf8, 0x00,
   0x78, 0x00, 0x38, 0x00, 0x18, 0x00, 0x08, 0x00, 0x00, 0x00, 0x00, 0x00 };
}
}

#This creates the scrollbar and an instance command for it.
#cmdArgs represents the initial arguments.  cmdArgs becomes smaller
#gradually as options/flags are processed, and if it contains
#anything else afterward an error is reported.

proc cscrollbar {win args} {
	
	if {[expr {[llength $args] & 1}] != 0} {
		return -code error "Invalid number of arguments given to cscrollbar\
(uneven number):	$args"				
	}
	
	frame $win -class Cscrollbar
	upvar #0 _cscrollbar$win ar 
	button .__temp
	set cmdArgs(-orient) vertical

	set cmdArgs(-bg) [option get $win background Color1]
	if {$cmdArgs(-bg) == ""} {
		set cmdArgs(-bg) [.__temp cget -bg]
	}

	set cmdArgs(-fg) [option get $win foreground Color1]
	if {$cmdArgs(-fg) == ""} {
		set cmdArgs(-fg) [.__temp cget -fg]
	}

	set cmdArgs(-slidercolor) [option get $win sliderColor Color1]
	if {$cmdArgs(-slidercolor) == ""} { 
		set cmdArgs(-slidercolor) blue
	}

	set cmdArgs(-gradient1) [option get $win gradient1 Color1]
	if {$cmdArgs(-gradient1) == ""} {
		set cmdArgs(-gradient1) royalblue3
	}

	set cmdArgs(-gradient2) [option get $win gradient2 Color1]
	if {$cmdArgs(-gradient2) == ""} {
		set cmdArgs(-gradient2) gray90
	}


	set ar(sliderPressed) 0
	destroy .__temp
	
	array set cmdArgs $args
	array set ar [array get cmdArgs]
	
	unset cmdArgs(-slidercolor)
	unset cmdArgs(-gradient1)
	unset cmdArgs(-gradient2)
					
	#synonym flags
	foreach long {background foreground} short {bg fg} {
		if {[info exists cmdArgs(-$long)] == 1} {
			set cmdArgs(-$short) $cmdArgs(-$long)	
			unset cmdArgs(-long)
		}
	}

	if {$cmdArgs(-orient) == "vertical"} {
		cscrollbar::createVertical $win $cmdArgs(-bg) $cmdArgs(-fg)
	} elseif {$cmdArgs(-orient) == "horizontal"} {
		cscrollbar::createHorizontal $win $cmdArgs(-bg) $cmdArgs(-fg) 
	} else {
		return -code error {Invalid -orient option -- use vertical or horizontal}
	}
	
	unset cmdArgs(-orient)
	unset cmdArgs(-fg)
	unset cmdArgs(-bg)

	if {[info exists cmdArgs(-command)] == 1} {
		bind $win.1 <ButtonPress-1> "set cscrollbar::buttonPressed 1; cscrollbar::moveUnit {$cmdArgs(-command)} -1 %W"
		bind $win.1 <ButtonRelease-1> "set cscrollbar::buttonPressed 0; cscrollbar::moveUnit {$cmdArgs(-command)} -1 %W"
		bind $win.c <ButtonRelease-1> "cscrollbar::sliderNotPressed $win" 
		bind $win.2 <ButtonPress-1> "set cscrollbar::buttonPressed 1; cscrollbar::moveUnit {$cmdArgs(-command)} 1 %W"
		bind $win.2 <ButtonRelease-1> "set cscrollbar::buttonPressed 0; cscrollbar::moveUnit {$cmdArgs(-command)} 1 %W"

		bind $win.3 <ButtonPress-1> "set cscrollbar::buttonPressed 1; cscrollbar::moveUnit {$cmdArgs(-command)} -1 %W"
		bind $win.3 <ButtonRelease-1> "set cscrollbar::buttonPressed 0; cscrollbar::moveUnit {$cmdArgs(-command)} -1 %W"
		bind $win.4 <ButtonPress-1> "set cscrollbar::buttonPressed 1; cscrollbar::moveUnit {$cmdArgs(-command)} 1 %W"
		bind $win.4 <ButtonRelease-1> "set cscrollbar::buttonPressed 0; cscrollbar::moveUnit {$cmdArgs(-command)} 1 %W"


		bind $win <Configure> "after idle [list cscrollbar::updateView $win]"
		unset cmdArgs(-command)
	}
	
	
	if {[llength [array names cmdArgs]] != 0} {
		return -code error "Invalid argument sent to cscrollbar: [array get cmdArgs]"
	}
	
	rename $win _cscrollbarJunk$win

	bind $win <Destroy> "rename $win {};"
	
	proc $win {cmd args} "eval cscrollbar::instanceCmd $win \$cmd \$args"
	return $win
}

proc cscrollbar::updateView {win} {
	upvar #0 _cscrollbar$win ar
	if {[catch $ar(-command) res] && $res != ""} {
		$win set 0 1
	}
}

proc cscrollbar::instanceCmd {self cmd args} {
	upvar #0 _cscrollbar$self ar

	switch -glob -- $cmd {
		cget {
			if {[info exists ar($args)] == 1} {
				return $ar($args)
			} else {
				return -code error "unknown argument(s) to cget: $args"
			}
		}
	
		conf* {
			if {[llength $args] == 0} {
				foreach name [array names ar -*] {
					append res "{$name $ar($name)} "		
				}
				
				return $res					
			}

			array set cmdArgs $args
			
			foreach long {background foreground} short {bg fg} {
				if {[info exists cmdArgs(-$long)] == 1} {
					set cmdArgs(-$short) $cmdArgs(-$long)
					unset cmdArgs(-$long)
				}
			}

			if {[info exists cmdArgs(-gradient1)] == 1} {
				set ar(-gradient1) $cmdArgs(-gradient1)
				event generate $self <Configure>
			}
			
			if {[info exists cmdArgs(-gradient2)] == 2} {
				set ar(-gradient2) $cmdArgs(-gradient2)
				event generate $self <Configure>
			}

			if {[info exists cmdArgs(-bg)] == 1} {
				set ar(-bg) $cmdArgs(-bg)
				$self.1 config -bg $ar(-bg)
				$self.c config -bg $ar(-bg)
				$self.2 config -bg $ar(-bg)
				
				if {$ar(-orient) == "vertical"} {
					$ar(upImage) config -background $ar(-bg)
					$ar(upDisabledImage) config -background $ar(-bg)
					$ar(downImage) config -background $ar(-bg)
					$ar(downDisabledImage) config -background $ar(-bg)
				}
			
				if {$ar(-orient) == "horizontal"} {
					$ar(leftImage) config -background $ar(-bg)
					$ar(leftDisabledImage) config -background $ar(-bg)
					$ar(rightImage) config -background $ar(-bg)
					$ar(rightDisabledImage) config -background $ar(-bg)
				}
				unset cmdArgs(-bg)
			}

			if {[info exists cmdArgs(-fg)] == 1} {
				set ar(-fg) $cmdArgs(-fg)
				$self.1 config -fg $ar(-fg)
				$self.2 config -fg $ar(-fg)
				$self.3 config -fg $ar(-fg)
				$self.4 config -fg $ar(-fg)

				if {$ar(-orient) == "vertical"} {
					$ar(upImage) config -foreground $ar(-fg)
					$ar(downImage) config -foreground $ar(-fg)
				}
			
				if {$ar(-orient) == "horizontal"} {
					$ar(leftImage) config -foreground $ar(-fg)
					$ar(rightImage) config -foreground $ar(-fg)
				}
				unset cmdArgs(-fg)
			}

			if {[info exists cmdArgs(-slidercolor)] == 1} {
				set ar(-slidercolor) $cmdArgs(-slidercolor)
				$self.c itemconfigure slider -fill $ar(-slidercolor)
				unset cmdArgs(-slidercolor)
			}

			if {[info exists cmdArgs(-command)] == 1} {
				set ar(-command) $cmdArgs(-command)
				bind $self.1 <ButtonPress-1> "set cscrollbar::buttonPressed 1; cscrollbar::moveUnit {$ar(-command)} -1 %W"
				bind $self.1 <ButtonRelease-1> "set cscrollbar::buttonPressed 0; cscrollbar::moveUnit {$ar(-command)} -1 %W"
				bind $self.c <ButtonRelease-1> "cscrollbar::sliderNotPressed $self"
				bind $self.2 <ButtonPress-1> "set cscrollbar::buttonPressed 1; cscrollbar::moveUnit {$ar(-command)} 1 %W"
				bind $self.2 <ButtonRelease-1> "set cscrollbar::buttonPressed 0; cscrollbar::moveUnit {$ar(-command)} 1 %W"
				
				bind $self.3 <ButtonPress-1> "set cscrollbar::buttonPressed 1; cscrollbar::moveUnit {$ar(-command)} -1 %W"
				bind $self.3 <ButtonRelease-1> "set cscrollbar::buttonPressed 0; cscrollbar::moveUnit {$ar(-command)} -1 %W"
				bind $self.4 <ButtonPress-1> "set cscrollbar::buttonPressed 1; cscrollbar::moveUnit {$ar(-command)} 1 %W"
				bind $self.4 <ButtonRelease-1> "set cscrollbar::buttonPressed 0; cscrollbar::moveUnit {$ar(-command)} 1 %W"
				
				bind $self <Configure> "
					if {\[catch {$ar(-command)} res\] == 0 && \$res != \"\"} {
						$self set \$res
					}
				"
				unset cmdArgs(-command)
			}
			
			set res [llength [array names cmdArgs]]
			if {$res != 0} {
				return -code error "The following options were not recognized\
by cscrollbar: [array get cmdArgs]"
			}
		}

		set {
			set start [lindex $args 0]
			set end [lindex $args 1]
		
			#somehow this becomes a list when I don't want it to be.
			if {$end == ""} {
				set end [lindex $start 1]
				set start [lindex $start 0]
			}
			
			if {$end <= 0} {
				set end 1
			}

			update idletasks
			
			if {$ar(-orient) == "vertical"} {		
				if {$start == 0} {
					$self.1 config -image $ar(upDisabledImage)
					$self.3 config -image $ar(upDisabledImage)
				} else {
					$self.1 config -image $ar(upImage)
					$self.3 config -image $ar(upImage)
				}

				if {$end == 1} {
					$self.2 config -image $ar(downDisabledImage)
					$self.4 config -image $ar(downDisabledImage)
				} else {
					$self.2 config -image $ar(downImage)
					$self.4 config -image $ar(downImage)
				}

				if {$ar(sliderPressed) == 1} {
					return
				}

				#-2 is done for the border
				set areaHeight [expr {([winfo height $self.c] - 2)}]
				set startPos [expr {$start * $areaHeight}]
				set endPos [expr {$end * $areaHeight}]

				if {$endPos <= 0} {
					set endPos $areaHeight
				}

				$self.c coords slider 0 $startPos [winfo width $self.c] $endPos 
			}
			if {$ar(-orient) == "horizontal"} {
				if {$start == 0} {
					$self.1 config -image $ar(leftDisabledImage)
					$self.3 config -image $ar(leftDisabledImage)
				} else {
					$self.1 config -image $ar(leftImage)
					$self.3 config -image $ar(leftImage)
				}
				if {$end == 1} {
					$self.2 config -image $ar(rightDisabledImage)
					$self.4 config -image $ar(rightDisabledImage)
				} else {
					$self.2 config -image $ar(rightImage)
					$self.4 config -image $ar(rightImage)
				}

				if {$ar(sliderPressed) == 1} {
					return
				}
				set areaWidth [expr {([winfo width $self.c] - 2)}]
				set startPos [expr {$start * $areaWidth}]
				set endPos [expr {$end * $areaWidth}]
				
				if {$endPos <= 0} {
					set endPos $areaWidth
				}

				$self.c coords slider $startPos 0 $endPos [winfo height $self.c] 
			}
		} 
		
		default { 
			#puts "$cmd $args" 
		}
	}
}

proc cscrollbar::createHorizontal {win bg fg} {
	upvar #0 _cscrollbar$win ar 
	
	set bd 1
	
	set ar(leftImage) [image create bitmap -data $cscrollbar::left_xbm \
		-foreground $fg -background $bg]
	set ar(leftDisabledImage) [image create bitmap -data $cscrollbar::left_xbm \
		-foreground gray50 -background $bg]
	set ar(rightImage) [image create bitmap -data $cscrollbar::right_xbm \
		-foreground $fg -background $bg]
	set ar(rightDisabledImage) [image create bitmap -data $cscrollbar::right_xbm \
		-foreground gray50 -background $bg]

	grid [label $win.1 -image $ar(leftDisabledImage) -relief raised -bg $bg -fg $fg -bd $bd] \
		-row 0 -column 0 -sticky w

	grid [label $win.2 -image $ar(rightDisabledImage) -relief raised -bg $bg -fg $fg -bd $bd] \
		-row 0 -column 1 -sticky w

	grid [canvas $win.c -relief flat -highlightthickness 0 \
		-height [winfo reqheight $win.1] -width 10 -bg $bg] \
		-row 0 -column 2 -sticky ew
	
	grid columnconfigure $win 2 -weight 1

	grid [label $win.3 -image $ar(leftDisabledImage) -relief raised -bg $bg -fg $fg -bd $bd] \
		-row 0 -column 3 -sticky e

	grid [label $win.4 -image $ar(rightDisabledImage) -relief raised -bg $bg -fg $fg -bd $bd] \
		-row 0 -column 4 -sticky e
	
	cscrollbar::drawSlider $win 0 0 1 1 horizontal

	$win.c bind slider <B1-Motion> "cscrollbar::moveSlider $win horizontal %x"
	$win.c bind slider <ButtonPress-1> "
		set cscrollbar::lastX \[$win.c canvasx %x\] 
		set cscrollbar::lastY \[$win.c canvasy %y\] 
	"
	bind $win.c <Configure> "cscrollbar::drawBackground $win horizontal"
}


proc cscrollbar::createVertical {win bg fg} {
	upvar #0 _cscrollbar$win ar 
	
	set bd 1
	
	set ar(upImage) [image create bitmap -data $cscrollbar::up_xbm \
		-foreground $fg -background $bg]
	set ar(upDisabledImage) [image create bitmap -data $cscrollbar::up_xbm \
		-foreground gray50 -background $bg]
	set ar(downImage) [image create bitmap -data $cscrollbar::down_xbm \
		-foreground $fg -background $bg]
	set ar(downDisabledImage) [image create bitmap -data $cscrollbar::down_xbm \
		-foreground gray50 -background $bg]

	grid [label $win.1 -image $ar(upDisabledImage) -relief raised -bg $bg -fg $fg -bd $bd] \
		-row 0 -column 0 -sticky n

	grid [label $win.2 -image $ar(downDisabledImage) -relief raised -bg $bg -fg $fg -bd $bd] \
		-row 1 -column 0 -sticky n

	grid [canvas $win.c -relief flat -highlightthickness 0 \
		-width [winfo reqwidth $win.1] -height 10 -bg $bg] \
		-row 2 -column 0 -sticky ns
	
	grid rowconfigure $win 2 -weight 1
	grid [label $win.3 -image $ar(upDisabledImage) -relief raised -bg $bg -fg $fg -bd $bd] \
		-row 3 -column 0 -sticky s
	grid [label $win.4 -image $ar(downDisabledImage) -relief raised -bg $bg -fg $fg -bd $bd] \
		-row 4 -column 0 -sticky s

	
	cscrollbar::drawSlider $win 0 0 1 1 vertical

	$win.c bind slider <B1-Motion> "cscrollbar::moveSlider $win vertical %y"
	$win.c bind slider <ButtonPress-1> "
		set cscrollbar::lastX \[$win.c canvasx %x\]   
		set cscrollbar::lastY \[$win.c canvasy %y\]
	"
	bind $win.c <Configure> "cscrollbar::drawBackground $win vertical"
}

	
#Based on Richard Suchenwirth's gradient code from one of his train
#projects. 	
proc cscrollbar::drawBackground {win type} {
	upvar #0 _cscrollbar$win ar 
	set canv $win.c
	set x1 0 
	set y1 0
	set x2 [expr {[winfo width $canv] + 8}]
	set y2 [expr {[winfo height $canv] + 8}]
	set c1 $ar(-gradient1)
	set c2 $ar(-gradient2)

	$canv delete background
								 
	foreach {r1 g1 b1} [winfo rgb $canv $c1] break
	foreach {r2 g2 b2} [winfo rgb $canv $c2] break
	set redDiff [expr {$r2 - $r1}]
	set greenDiff [expr {$g2 - $g1}]
	set blueDiff [expr {$b2 - $b1}]
	switch $type {
		horizontal {
			set yDiff [expr {$y2 - $y1}]
			set steps [expr {int(abs($yDiff))}]
			if {$steps > 255} {
				set steps 255
			}
			for {set i 2} {$i < $steps} {incr i} {
				set p [expr {double($i) / $steps}]
				set y [expr {$y1 + $yDiff * $p}]
				set r [expr {int($r1 + $redDiff * $p)}]
				set g [expr {int($g1 + $greenDiff * $p)}]
				set b [expr {int($b1 + $blueDiff * $p)}]
	
				set fillColor "#"
				foreach color {r g b} {
					set preColor [format "%2.2x" [set $color]]
					set color [format "%2.2s" $preColor]
					append fillColor $color
				}
				
				$canv create rectangle $x1 $y $x2 $y2 -outline {} -tag background \
					-fill $fillColor
			}
		}
				
		vertical {
			set xDiff [expr {$x2 - $x1}]
			set steps [expr {int(abs($xDiff))}]
	
			if {$steps > 255} {
				set steps 255
			}
			for {set i 2} {$i < $steps} {incr i} {
				set p [expr {double($i) / $steps}]
				set x [expr {$x1 + $xDiff * $p}]
				set r [expr {int($r1 + $redDiff * $p)}]
				set g [expr {int($g1 + $greenDiff * $p)}]
				set b [expr {int($b1 + $blueDiff * $p)}]
				
				set fillColor "#"
				foreach color {r g b} {
					set preColor [format "%2.2x" [set $color]]
					set color [format "%2.2s" $preColor]
					append fillColor $color
				}
				
				$canv create rectangle $x $y1 $x2 $y2 -outline {} -tag background \
					-fill $fillColor
			} 
		}
				
		default {
			return -code error "unknown direction \"$type\": must be one of horizontal or vertical"
		}
	}
	
	$win.c bind background <ButtonPress-1> "cscrollbar::scrollPages $win $type %x %y"
	$win.c lower background
}


proc cscrollbar::drawSlider {win x1 y1 x2 y2 type} {
	upvar #0 _cscrollbar$win ar 

	#update idletasks
	$win.c delete slider

	if {$type == "vertical"} {
		set canvasWidth [winfo width $win.c]
		$win.c create rectangle 0 $y1 $canvasWidth $y2 \
			-fill $ar(-slidercolor) -outline "" -tag slider -stipple gray50 
		return
	}

	if {$type == "horizontal"} {
		set canvasHeight [winfo height $win.c]
		$win.c create rectangle $x1 0 $x2 $canvasHeight \
			-fill $ar(-slidercolor) -outline "" -tag slider -stipple gray50
		return
	}
}

	
proc cscrollbar::moveSlider {win type position} {
	variable lastX
	variable lastY
	upvar #0 _cscrollbar$win ar 

	if {$type == "vertical"} {
		#move the slider y values which are 1 and 3 in the coords list
		set sliderStartY [lindex [$win.c coords slider] 1]
		set sliderEndY [lindex [$win.c coords slider] 3]
		set sliderHeight [expr {$sliderEndY - $sliderStartY}]
		set areaHeight [expr {[winfo height $win.c] - 1}]
	
			
		set newY [expr {$position - $lastY}]
		set upBoundResult [expr {($sliderStartY + $newY) < 0}] 
		set downBoundResult [expr {($sliderEndY + $newY) > $areaHeight}]
	
		if {$upBoundResult != 1 && $downBoundResult != 1} {
			$win.c move slider 0 $newY
			set lastY $position
		} elseif {$upBoundResult == 1} {
			set lastY [expr {$lastY - $sliderStartY}]
			$win.c move slider 0 [expr {-$sliderStartY}]
		} elseif {$downBoundResult == 1} {
			set amountToMove [expr {-$sliderStartY + ($areaHeight - $sliderHeight)}]
			set lastY [expr {$lastY + $amountToMove}]
			$win.c move slider 0 $amountToMove
		}
		
		if {[info exists ar(-command)] == 1} {
			set ar(sliderPressed) 1
			eval $ar(-command) moveto [expr {$sliderStartY / $areaHeight}]
		}
		return
	}

	if {$type == "horizontal"} {
		#move the slider x values which are 0 and 2 in the coords list
		set sliderStartX [lindex [$win.c coords slider] 0] 
		set sliderEndX [lindex [$win.c coords slider] 2] 
		set sliderWidth [expr {$sliderEndX - $sliderStartX}] 
		set areaWidth [expr {[winfo width $win.c] - 1}]
				
		set newX [expr {$position - $lastX}]
		set leftBoundResult [expr {($sliderStartX + $newX) < 0}] 
		set rightBoundResult [expr {($sliderEndX + $newX) > $areaWidth}]
	
		if {$leftBoundResult != 1 && $rightBoundResult != 1} {
			$win.c move slider $newX 0
			set lastX $position
		} elseif {$leftBoundResult == 1} {
			set lastX [expr {$lastX - $sliderStartX}]
			$win.c move slider [expr {-$sliderStartX}] 0
		} elseif {$rightBoundResult == 1} {
			set amountToMove [expr {-$sliderStartX + ($areaWidth - $sliderWidth)}] 
			set lastX [expr {$lastX + $amountToMove}]
			$win.c move slider $amountToMove 0
		}
		
		if {[info exists ar(-command)] == 1} {
			set ar(sliderPressed) 1
			eval $ar(-command) moveto [expr {$sliderStartX / $areaWidth}]
		}
		return
	}
}

#This moves the widget being scrolled a unit at a time.
#It is invoked by the arrow buttons.  The arrow buttons
#are actually labels with bitmaps that have the -relief 
#change.

proc cscrollbar::moveUnit {cmd unit self} {
	variable buttonPressed
	
	eval $cmd scroll $unit units

	$self config -relief sunken								
	if {$buttonPressed == 1} {
		after 40 "cscrollbar::moveUnit {$cmd} $unit $self"
	} else {
		$self config -relief raised
	}
}

#This means that someone has pressed the trough/background
#of the scrollbar, so we should scroll a page at a time.
#Unlike Tk's scrollbar I don't continue scrolling while
#the mouse is held down.  Instead I chose to scroll once.
#If the user wants it to continue they can press the mouse
#again.
proc cscrollbar::scrollPages {win type x y} {
	upvar #0 _cscrollbar$win ar 

	if {$type == "horizontal"} {
		set sliderStartX [lindex [$win.c coords slider] 0] 
		set sliderEndX [lindex [$win.c coords slider] 2]	

		if {$x < $sliderStartX} { 
			eval [concat $ar(-command) scroll -1 pages]
		}
		
		if {$x > $sliderEndX} {
			eval [concat $ar(-command) scroll 1 pages]
		}
	}

	if {$type == "vertical"} {
		set sliderStartY [lindex [$win.c coords slider] 1] 
		set sliderEndY [lindex [$win.c coords slider] 3]	
		
		if {$y < $sliderStartY} {
			eval [concat $ar(-command) scroll -1 pages]
		}
		
		if {$y > $sliderEndY} {
			eval [concat $ar(-command) scroll 1 pages]
		}
	}
}


proc cscrollbar::sliderNotPressed {win} {
	upvar #0 _cscrollbar$win ar 
	set ar(sliderPressed) 0

	if {[catch {$ar(-command)} res] == 0 && $res != ""} {
		$win set $res
	}
}

package ifneeded ctext 3.1 [list source [file join $dir ctext.tcl]]

/*The Panache Window Manager*/
/*By George Peter Staplin*/
/*Please read the LICENSE file included with the Panache distribution 
 *for usage restrictions.
 */

#include <stdio.h>
#include <stdlib.h>
#include <signal.h>
#ifndef __STDC__
	#include <malloc.h>
#endif
#include <X11/Xlib.h>
#include <X11/Xutil.h>
#include <X11/Xos.h>
#include <X11/Xatom.h>
#include <X11/keysym.h>
#include <X11/cursorfont.h>
#include <tcl.h>  
#include "PanacheWindowList.h"

/*Style 
I use if (returnFromFunc == 1) instead of if (returnFromFunc)
I use if (returnFromFunc == 0) instead of if (!returnFromFunc) 
*/  

/*Automatic focus of new windows yes/no.*/
/*Automatic focus of transient windows yes/no.*/

#define PANACHE_DIRECTORY "Panache"
#define CMD_ARGS (ClientData clientData, Tcl_Interp *interp, \
int objc, Tcl_Obj *CONST objv[])
		
Display *dis;
XEvent report;
Window root;
Tcl_Interp *interp;
int distance_from_edge = 0; 
Window mapped_window = None;
int screen;
Atom _XA_WM_STATE;  
Atom _XA_WM_PROTOCOLS;
Atom _XA_WM_DELETE_WINDOW; 
Window workspace_manager;
struct CList *keepAboveWindowList;
unsigned long eventMask = (ResizeRedirectMask | PropertyChangeMask | \
	EnterWindowMask | LeaveWindowMask | FocusChangeMask | KeyPressMask);
				
#define winIdLength 14
/*#define FORK_ON_START*/

int PanacheGetWMState (Window win);
void PanacheSelectInputForRootParented (Window win);
void PanacheConfigureNormalWindow (Window win, unsigned long value_mask);

char Panache_Init_script[] = {
	"if {[file exists $prefix/$panacheDirectory/Panache.tcl] != 1} {\n" 
	"	puts stderr  {unable to open Panache.tcl  Did you run make install?}\n" 
	"	puts stderr \"I looked in $prefix/$panacheDirectory\"\n"
	"	exit -1\n" 
	"}\n"
	"proc sendToPipe str {\n"
	"	set str [string map {\"\n\" \"\" \"\r\" \"\"} $str]\n"
	"	puts $::pipe $str\n"
	"	flush $::pipe\n"
	"}\n"
	"proc getFromPipe {} {\n"
	"	gets $::pipe line\n" 
	"	if {$line != \"\"} {\n"
	"		set cmd [lindex $line 0]\n"
	"		if {[llength $line] == 2} {\n" 
	"			$cmd [lindex $line 1]\n"
	"		} else {\n"
	"			eval $line\n" 
	"		}\n"
	"	}\n"
	"}\n"
	"set ::pipe [open \"|$wishInterpreter $prefix/$panacheDirectory/Panache.tcl\" w+]\n"
	"fconfigure $::pipe -blocking 0\n"
	"\n"};

		
char *charMalloc (int size) {
	char *mem = NULL;
	
	mem = (char *)	malloc ((sizeof (char)) * size); 
	
	if (mem == NULL) {
		fprintf (stderr, "malloc failed to allocate memory  This means that Panache \
and other applications could have problems if they continue running.\n\n  \
exiting Panache now!");
		exit (-1);
	}
	
	return mem;
}


void sendConfigureNotify (Window win, unsigned long value_mask, XWindowChanges *winChanges) {
	XEvent xe;
	XWindowAttributes wattr;

	if (XGetWindowAttributes (dis, win, &wattr) == 0) {
		return;
	}

	xe.type = ConfigureNotify;	
	xe.xconfigure.type = ConfigureNotify;
	xe.xconfigure.event = win;
	xe.xconfigure.window = win;
	
	
	xe.xconfigure.x = (value_mask & CWX) ? winChanges->x : wattr.x;
	xe.xconfigure.y = (value_mask & CWY) ? winChanges->y : wattr.y;	
	xe.xconfigure.width = (value_mask & CWWidth) ? winChanges->width : wattr.width;
	xe.xconfigure.height = (value_mask & CWHeight) ? winChanges->height : wattr.height;
			
	xe.xconfigure.border_width = 0;
	xe.xconfigure.above = None;
	xe.xconfigure.override_redirect = 0;
	
	XSendEvent (dis, win, 0, StructureNotifyMask, &xe);
	
	XFlush (dis);	
}


void sendMapNotify (Window win) {
	XEvent mapNotify;

	mapNotify.type = MapNotify;
	mapNotify.xmap.type = MapNotify;
	mapNotify.xmap.window = win;
	mapNotify.xmap.display = dis;
	mapNotify.xmap.event = win;
	XSendEvent (dis, win, 0, StructureNotifyMask, &mapNotify);
	XFlush (dis);
}


int PanacheAddAllWindowsCmd CMD_ARGS {
	Window dummy;
	Window *children = NULL; 
	unsigned int nchildren;
	unsigned int i; 
	char *winId;
	char *transientForWinId;
	char str[] = "sendToPipe [list add [list $winTitle] $winId $winType $transientForWinId]";
	Window twin;
	
	XSync (dis, 0);
	/*XGrabServer (dis);*/
		
	if (XQueryTree (dis, 
			root, 
			&dummy, 
			&dummy, 
			&children, 
			&nchildren) == 0) {
	
		fprintf (stderr, "Error querying the tree for the root window.\n");
	}

	for (i = 0; i < nchildren; i++) {
		XTextProperty xtp;
		XWMHints *wmHints = XGetWMHints (dis, children[i]);
		XWindowAttributes wattr;
		
		xtp.value = NULL;
		
		if (wmHints == NULL) {
			continue;
		}
		
		if (wmHints->flags & IconWindowHint) {
			continue;
		}
		
		if (XGetWindowAttributes (dis, children[i], &wattr) == 0) {
			continue;
		}
		
		if (wattr.override_redirect == 1) {
			continue;
		}
			
		if (wmHints->flags & StateHint) { 
			if (wmHints->initial_state & WithdrawnState) {
				continue;
			} else if (wattr.map_state == 0 && PanacheGetWMState (children[i]) == 0) {
				continue;
			}  
		} 			
	
		XFree (wmHints);
		
		XGetWMName (dis, children[i], &xtp);
			
		winId = charMalloc (winIdLength);

		sprintf (winId, "%ld", children[i]);
		Tcl_SetVar (interp, "winTitle", (char *) xtp.value, 0);
		Tcl_SetVar (interp, "winId", winId, 0);

		if (XGetTransientForHint (dis, children[i], &twin) == 1) {
			Tcl_SetVar (interp, "winType", "transient", 0);
	
			transientForWinId =  charMalloc (winIdLength);
			sprintf (transientForWinId, "%ld", twin);
			Tcl_SetVar (interp, "transientForWinId", transientForWinId, 0);
			free (transientForWinId);
			
			PanacheSelectInputForRootParented (children[i]);
	
		} else {
			Tcl_SetVar (interp, "winType", "normal", 0);
			Tcl_SetVar (interp, "transientForWinId", "", 0);
				
			/*Maybe I should compare the first char and then do strcmp?*/	
			if (xtp.value != NULL && strcmp ((char *)xtp.value, "___Panache_GUI") != 0) {
				PanacheConfigureNormalWindow (children[i], CWX|CWY|CWWidth|CWHeight);	
				PanacheSelectInputForRootParented (children[i]);
			} 
		}
		
		XFree (xtp.value);
		free (winId);

		if (Tcl_Eval (interp, str) != TCL_OK) {
			fprintf (stderr, "Error in PanacheAddAllWindowsCmd: %s\n", Tcl_GetStringResult (interp));
		}
	}

	if (children != NULL) {
		XFree (children);
	}

	/*XUngrabServer (dis);*/ 
	XSync (dis, 0);

	return TCL_OK;
}


void PanacheConfigureRequest (XConfigureRequestEvent *event) {
	XWindowChanges wc;
	Window twin;
	int maxWidth;
	int maxHeight;

	if (event->parent != root) { 
		return;
	}

#ifdef DEBUG		
	fprintf (stderr, "ConfigureRequest win %ld\n", event->window);
	fprintf (stderr, "CWSibling %d\n", (event->value_mask & CWSibling) == 1);
	fprintf (stderr, "CWStackMode %d\n", (event->value_mask & CWStackMode) == 1);
#endif
	
	maxWidth = (DisplayWidth (dis, screen) - distance_from_edge - 4);
	maxHeight = DisplayHeight (dis, screen);
		
	wc.border_width = 0;
	wc.sibling = None;
	wc.stack_mode = Above;
	
	if (event->window == workspace_manager) {
		wc.width = distance_from_edge;
		wc.height = maxHeight;
		wc.x = 0;
		wc.y = 0;	
		XConfigureWindow(dis, event->window, CWX|CWY|CWWidth|CWHeight, &wc);
		sendConfigureNotify (event->window, CWX|CWY|CWWidth|CWHeight, &wc);
		return;
	} else {
		PanacheSelectInputForRootParented (event->window);
	} 
	
	if (XGetTransientForHint (dis, event->window, &twin) == 1) {
		if (event->width > maxWidth) {
			wc.width = maxWidth;
		} else {
			wc.width = event->width;
		} 
	
		wc.height = event->height;
			
		if (event->x < distance_from_edge) {
			wc.x = distance_from_edge;
		} else {
			wc.x = event->x;		
		}	 
	
		wc.y = event->y;		
		XConfigureWindow (dis, event->window, event->value_mask, &wc);
		sendConfigureNotify (event->window, event->value_mask, &wc);
	} else {
		PanacheConfigureNormalWindow (event->window, event->value_mask);
	}
				
	XFlush (dis);
}


/*This configures the window and sends a ConfigureNotify event. 
 *It's designed for normal non-transient windows
 */
void PanacheConfigureNormalWindow (
	Window win, unsigned long value_mask) 
{
	XWindowChanges wc;
	XSizeHints sizeHints;
	long ljunk = 0;
	int maxWidth = (DisplayWidth (dis, screen) - distance_from_edge - 4);
	int maxHeight = DisplayHeight (dis, screen);

	wc.border_width = 0;
	wc.sibling = None;
	wc.stack_mode = Above;
	
	wc.x = distance_from_edge;
	wc.y = 0;	
	wc.width = maxWidth;
	wc.height = maxHeight;
	
	if (XGetWMNormalHints (dis, win, &sizeHints, &ljunk)) {
		if (sizeHints.flags & PMaxSize) {
			wc.width = (sizeHints.max_width > maxWidth) ? maxWidth : sizeHints.max_width;
			wc.height = (sizeHints.max_height > maxHeight) ? maxHeight : sizeHints.max_height;
#ifdef DEBUG
			fprintf (stderr, "MaxSize %d %d\n", sizeHints.max_width, sizeHints.max_height);
#endif
		}	
#ifdef DEBUG
		if (sizeHints.flags & PResizeInc) {
			fprintf (stderr, "PResizeInc\n");
			fprintf (stderr, "incr %d %d\n", sizeHints.width_inc, sizeHints.height_inc);
		}		
		if (sizeHints.flags & PAspect) {
			fprintf (stderr, "PAspect x %d\n", sizeHints.min_aspect.x);
		}		
#endif
	}

	XConfigureWindow (dis, win, value_mask, &wc);
	sendConfigureNotify (win, value_mask, &wc);	
}


/*This appends windows that are not to be managed by 
 *Panache to a list, and Panache will later on raise 
 *them above other windows. 
 */
void PanacheCreateNotify (XCreateWindowEvent *event) {
							
	if (event->override_redirect == 0 || event->parent != root) {
		return;
	}
	
	CListAppend (keepAboveWindowList, event->window);
}

/*X has told Panache that a DestroyNotify event occured
 *to a child of the root window, so Panache removes the
 *window from the window list.
 */
void PanacheDestroyNotify (XDestroyWindowEvent *event) {
	Window win;
	char *winId;
	char str[] = "sendToPipe [list remove $winId]";

	win = event->window;

	winId = charMalloc (winIdLength);
	sprintf (winId, "%ld", win);
	
	Tcl_SetVar (interp, "winId", winId, 0);
	free (winId);

#ifdef DEBUG
	fprintf (stderr, "DestroyNotify\n");
#endif

	CListRemove (keepAboveWindowList, event->window);		

	/*Tell Panache_GUI to remove the window*/
	if (Tcl_Eval (interp, str) != TCL_OK) {
		fprintf (stderr, "Tcl_Eval error in PanacheDestroyNotify %s\n", Tcl_GetStringResult (interp));
	}	
}


/*Panache_GUI calls this to send WM_DELETE_WINDOW or 
 *invoke XKillClient (if the window doesn't support
 *WM_DELETE_WINDOW).  We can't use XKillClient on all
 *windows, because if the application has multiple 
 *toplevel windows sending XKillClient would destroy
 *them all.
 */
int PanacheDestroyCmd CMD_ARGS {
	XClientMessageEvent ev;
	Window win;
	Atom *wmProtocols = NULL;
	Atom *protocol;
	int i;
	int numAtoms;
	int handlesWM_DELETE_WINDOW = 0;
		
	
	Tcl_GetLongFromObj (interp, objv[1], (long *) &win);

	if (XGetWMProtocols (dis, win, &wmProtocols, &numAtoms) == 1) {
		for (i = 0, protocol = wmProtocols; i < numAtoms; i++, protocol++) {
			if (*protocol == (Atom)_XA_WM_DELETE_WINDOW) {
				handlesWM_DELETE_WINDOW = 1;
			}
		} 
		if (wmProtocols) {
			XFree (wmProtocols);
		}
	}
	
	if (handlesWM_DELETE_WINDOW == 1) {
		ev.type = ClientMessage;
		ev.window = win;
		ev.message_type = _XA_WM_PROTOCOLS;
		ev.format = 32;
		ev.data.l[0] = _XA_WM_DELETE_WINDOW; 
		ev.data.l[1] = CurrentTime;
		XSendEvent (dis, win, 0, 0L, (XEvent *) &ev); 
	} else {
		XKillClient (dis, win); 
	}
	
	XFlush (dis);
		
	return TCL_OK;
}


int PanacheDFECmd CMD_ARGS {
	Tcl_GetIntFromObj (interp, objv[1], &distance_from_edge);
	return TCL_OK;
}

		
/*Panache_GUI sends focus $winId to get here.*/
int PanacheFocusCmd CMD_ARGS {
	Window win;
	
	Tcl_GetLongFromObj (interp, objv[1], (long *) &win);

	if (XSetInputFocus (dis, win, RevertToParent, CurrentTime) != 1) {
		fprintf (stderr, "XSetInputFocus failure within PanacheFocusCmd()");
	}

	XFlush (dis);
	
	return TCL_OK;
}


int PanacheGetWMState (Window win) {
	int returnValue = 0;
	Atom type;
	int ijunk;
	unsigned long ljunk;
	unsigned long *state = NULL;

	XGetWindowProperty (
		dis, 
		win, 
		_XA_WM_STATE, 
		0L, 
		1L, 
		0, 
		_XA_WM_STATE,
		&type, 
		&ijunk, 
		&ljunk, 
		&ljunk, 
		(unsigned char **) &state
	);
		
	if (type == _XA_WM_STATE) {
 		returnValue = (int) *state;
	} else {
		/*Don't know what to do*/	
		returnValue = 0;
	}
	
	if (state != NULL) {
		XFree (state);
	}

	return returnValue;
}
	
/*A window to keep above has the override_redirect 
 *attribute set to 1.
 */
 	
void PanacheRaiseKeepAboveWindows () {
	Window win;

	CListRewind (keepAboveWindowList);
	
	while ((win = CListGet (keepAboveWindowList)) != NULL) {
		XRaiseWindow (dis, win);
	}

	XFlush (dis);
}
			

void PanacheRecursivelyGrabKey (Window win, int keycode) {
	Window dummy;
	Window *children = NULL; 
	unsigned int nchildren;
	int i;
	
	
	if (XQueryTree (dis, win, &dummy, &dummy, &children, &nchildren) == 0) {
		return;
	}	
	
	for (i = 0; i < nchildren; i++) {
		PanacheRecursivelyGrabKey (children[i], keycode); 
		XGrabKey (dis, keycode, Mod1Mask, win, 1, GrabModeAsync, GrabModeSync);
	} 
	
	if (children != NULL) { 
		XFree (children);
	}
}	


int PanacheReparentCmd CMD_ARGS {
	Window newParent;
	Window win;

	Tcl_GetLongFromObj (interp, objv[1], (long *) &win);
	Tcl_GetLongFromObj (interp, objv[2], (long *) &newParent);
		
	XReparentWindow (dis, win, newParent, 0, 20); 	
	
	return TCL_OK;
}

		
void PanacheSelectInputForRootParented (Window win) {
		
	XSelectInput (dis, win, eventMask);
}


void PanacheSetWMState (Window win, int state) {
	unsigned long data[2];
	data[0] = state;
	data[1] = None;

	XChangeProperty (dis, win, _XA_WM_STATE, _XA_WM_STATE, 32,
		PropModeReplace, (unsigned char *) data, 2
	);
		
	XSync (dis, 0);
}

	
int PanacheTransientCmd CMD_ARGS {
	Window parent;
	Window win;

	Tcl_GetLongFromObj (interp, objv[1], (long *) &win);
	Tcl_GetLongFromObj (interp, objv[2], (long *) &parent);
	
	XSetTransientForHint (dis, win, parent);
		
	return TCL_OK;
}
	
/*This sends a string to Panache_GUI with info about the window, 
 *such as its title and window id.  This information is processed
 *within Panache_GUI and if desired PanacheMapCmd will map the 
 *window.
 */
void PanacheMapRequest (XMapRequestEvent *event) {
	char *winId;
	char *transientForWinId;
	XTextProperty xtp;
	char str[] = "sendToPipe [list add [list $winTitle] $winId $winType $transientForWinId]";
	Window twin;
	
	if (event->window == NULL) { 
		return;			 
	}

	/*This makes the state iconic, so that if the user presses
	 *restart before mapping the window, the window will show up.
	 */
	PanacheSetWMState (event->window, IconicState);
	
	xtp.value = NULL;
	
	XGetWMName (dis, event->window, &xtp);
		
	winId = charMalloc (winIdLength);
		
	sprintf (winId, "%ld", event->window);
	PanacheSelectInputForRootParented (event->window);	
			
	Tcl_SetVar (interp, "winTitle", (char *) xtp.value, 0);
	Tcl_SetVar (interp, "winId", winId, 0);
	
	if (XGetTransientForHint (dis, event->window, &twin) == 1) {
		Tcl_SetVar (interp, "winType", "transient", 0);
		transientForWinId = charMalloc (winIdLength);
		sprintf (transientForWinId, "%ld", twin);
		Tcl_SetVar (interp, "transientForWinId", transientForWinId, 0);	
		free (transientForWinId);
	} else {
		Tcl_SetVar (interp, "winType", "normal", 0);
		Tcl_SetVar (interp, "transientForWinId", "", 0);	
	}
			
	XFree (xtp.value);
	free (winId);
		
	if (Tcl_Eval (interp, str) != TCL_OK) {
		fprintf (stderr, "Error in PanacheMapRequest: %s\n", Tcl_GetStringResult (interp));
	}
}


/*This maps a window.  It may be called after PanacheMapRequest by
 *Panache_GUI.  This is also called when a window is over another
 *window and the user selects the button for the window to display
 *which causes this function to raise the window.
 */
int PanacheMapCmd CMD_ARGS {
	Window win;
	Window twin;
	XWindowAttributes winAttrib; 
	
	Tcl_GetLongFromObj (interp, objv[1], (long *) &win);
	
	PanacheSelectInputForRootParented (win);

	/*XGrabKey (dis, XK_Tab, Mod1Mask, win, 1, GrabModeAsync, GrabModeAsync);*/ 
	/*PanacheRecursivelyGrabKey (win, XK_Tab);*/

	XGetWindowAttributes (dis, win, &winAttrib);	
	
	if (winAttrib.x < distance_from_edge) {
		winAttrib.x = distance_from_edge;
		if (winAttrib.y < 0) {
			winAttrib.y = 0;
		}
		XMoveWindow (dis, win, winAttrib.x, winAttrib.y);			
	}  
		
	if (XGetTransientForHint (dis, win, &twin) == 1) {
		PanacheSetWMState (win, NormalState);
		XMapRaised (dis, win);
		sendMapNotify (win);
		mapped_window = win;
		PanacheRaiseKeepAboveWindows ();
		
		return TCL_OK;
	}

	
	if ((PanacheGetWMState (win)) == 1) {
		XRaiseWindow (dis, win);
		PanacheRaiseKeepAboveWindows ();
			
		return TCL_OK;
	}	
	
	/*If we are here the window hasn't had its size set, or 
	 *the WM_STATE was not 1.
	 */
			
	PanacheSetWMState (win, NormalState);

	/*I've found that some applications get upset if you sent
	 *a ConfigureNotify before the MapNotify, when they are
	 *expecting the MapNotify to be eminent.
	 */
	
	XMapRaised (dis, win);
	sendMapNotify (win);

	PanacheConfigureNormalWindow (win, CWX|CWY|CWWidth|CWHeight);
		
	mapped_window = win;
	PanacheRaiseKeepAboveWindows ();

	return TCL_OK;
}


int PanacheMapWorkspaceCmd CMD_ARGS {
	XWindowChanges wc;
	Window win;
	
	Tcl_GetLongFromObj (interp, objv[1], (long *) &win);
	workspace_manager = win;
	PanacheSetWMState (win, NormalState);

	wc.x = 0;
	wc.y = 0;
	wc.width = distance_from_edge;
	wc.height = DisplayHeight (dis, screen);
	
	XConfigureWindow(dis, win, CWX|CWY|CWWidth|CWHeight, &wc);
	sendConfigureNotify (win, CWX|CWY|CWWidth|CWHeight, &wc);
	
	XMapWindow (dis, win);
	sendMapNotify (win);
	mapped_window = win;
	XFlush (dis);
	
	return TCL_OK;
}


int PanacheMoveCmd CMD_ARGS {
	XEvent event;
	unsigned int buttonPressed;
	Window wjunk;
	int ijunk;
	Cursor handCursor;		
	Window win;	 
	int oldX;
	int oldY;
	int x;
	int y;
	int internalX;
	int internalY;
	unsigned int maskReturn;	
	int continueEventLoop = 1;
	XWindowAttributes winAttr;
				
	handCursor = XCreateFontCursor (dis, XC_hand2);

	XGrabPointer (dis, root, 1, 
		ButtonPressMask | ButtonReleaseMask | ButtonMotionMask | \
			PointerMotionHintMask,
		GrabModeAsync, GrabModeAsync,
		None, 
		handCursor,
		CurrentTime
	);
		
	/*Wait until the user has selected the window to move.*/
	XMaskEvent (dis, ButtonPressMask, &event);

	/*The button being held down while dragging the window.*/
	buttonPressed = event.xbutton.button;

	/*fprintf (stderr, "ButtonPressed %d\n", buttonPressed);*/
			
	XQueryPointer (dis, root, 
		&wjunk, &win, 
		&oldX, &oldY, 
		&internalX, &internalY,
		&maskReturn
	);
		
	if (win == workspace_manager) {
		XUngrabPointer (dis, CurrentTime);	
		XFreeCursor (dis, handCursor);
		XSync (dis, 0);			
	
		return TCL_OK;
	} 
					
				
	XGetWindowAttributes (dis, win, &winAttr);
				
	while (continueEventLoop == 1) {
		XNextEvent (dis, &event);
		switch (event.type) {
			case ButtonRelease:
			{
				if (event.xbutton.button == buttonPressed) {
					continueEventLoop = 0;
				}
			}
			break;
			case MotionNotify:
			{
				XWindowChanges wc;
				int newX;
				int newY;
												
				while (XCheckTypedEvent (dis, MotionNotify, &event));
			
				XQueryPointer (dis, root, &wjunk, &wjunk, 
					&x, &y,
					&ijunk, &ijunk,
					&maskReturn
				);
						
				newX = x - oldX + winAttr.x;
				newY = y - oldY + winAttr.y;
				
				if (newX < distance_from_edge) {
				
					if (winAttr.override_redirect == 1) {		
						XMoveWindow (dis, win, distance_from_edge, newY);
					} else {
						wc.x = distance_from_edge;
						wc.y = newY;				
						XConfigureWindow (dis, win, CWX | CWY, &wc);			
						sendConfigureNotify (win, CWX | CWY, &wc);
					}
					continue;
				} 					
				
				if (winAttr.override_redirect == 1) {		
					XMoveWindow (dis, win, newX, newY);
				} else {
					wc.x = newX;
					wc.y = newY;				
					XConfigureWindow (dis, win, CWX | CWY, &wc);			
					sendConfigureNotify (win, CWX | CWY, &wc);
				}
			} 
			break;		
		}	
	}
		
	/*fprintf (stderr, "win is %ld\n", win);*/

	XUngrabPointer (dis, CurrentTime);	
	XFreeCursor (dis, handCursor);
	
	XSync (dis, 0);
	
	return TCL_OK;
}
	

XErrorHandler PanacheErrorHandler (Display *dis, XErrorEvent *event) {
/*I've discovered that errors are frequently timing problems.
Maybe XSync would help in some areas.
Most errors are not fatal.
*/
	return 0;
}


int main() {
	fd_set readfds;
	int nfds;
	int xFd;
	int pipeFd;
	int inputPipeFd;
	ClientData data;
	int fdsTcl;
	

	dis = XOpenDisplay (NULL);
	screen = DefaultScreen (dis);
	root = RootWindow (dis, screen);
	interp = Tcl_CreateInterp ();

	XSetErrorHandler ((XErrorHandler) PanacheErrorHandler);
			
	_XA_WM_STATE = XInternAtom (dis, "WM_STATE", 0);	
	_XA_WM_PROTOCOLS = XInternAtom (dis, "WM_PROTOCOLS", 0);
	_XA_WM_DELETE_WINDOW = XInternAtom (dis, "WM_DELETE_WINDOW", 0); 

	keepAboveWindowList = CListInit ();

#ifdef FORK_ON_START
	{
	int res;
		res = fork();
	
		if (res == -1) {
			fprintf (stderr, "Unable to fork process.");
			return 1;
		}

		if (res != 0) {
			exit (0);
		}
	}
#endif
		
	if (Tcl_Init (interp) != TCL_OK) {
		printf ("Tcl_Init error\n");
		exit (-1);
	}

#define CREATE_CMD(cmdName,func) Tcl_CreateObjCommand (interp, \
cmdName, func, (ClientData) NULL, (Tcl_CmdDeleteProc *) NULL)
	
	CREATE_CMD ("map_workspace", PanacheMapWorkspaceCmd);
	CREATE_CMD ("distance_from_edge", PanacheDFECmd);
	CREATE_CMD ("map", PanacheMapCmd);
	CREATE_CMD ("destroy", PanacheDestroyCmd);
	CREATE_CMD ("add_all_windows", PanacheAddAllWindowsCmd);
	CREATE_CMD ("focus", PanacheFocusCmd);
	CREATE_CMD ("transient", PanacheTransientCmd);
	CREATE_CMD ("reparent", PanacheReparentCmd);
	CREATE_CMD ("move", PanacheMoveCmd);

	Tcl_SetVar (interp, "wishInterpreter", WISH_INTERPRETER, 0);
	Tcl_SetVar (interp, "prefix", PREFIX, 0);
	Tcl_SetVar (interp, "panacheDirectory", PANACHE_DIRECTORY, 0);
			
		
	if (Tcl_Eval (interp, Panache_Init_script) != TCL_OK) {
		fprintf (stderr, "Error while evaluating Panache_Init_script within main()%s\n", Tcl_GetStringResult (interp));
		exit (-1);
	}	

	XSelectInput (dis, root, LeaveWindowMask | EnterWindowMask| \
		PropertyChangeMask | SubstructureRedirectMask | \
		SubstructureNotifyMask | KeyPressMask | KeyReleaseMask | \
		ResizeRedirectMask | FocusChangeMask
	);

	xFd = ConnectionNumber (dis);
	
	Tcl_GetChannelHandle (Tcl_GetChannel (interp, Tcl_GetVar (interp, "pipe", NULL), NULL), TCL_WRITABLE, &data);
	pipeFd = (int) data;
	/*fprintf (stderr, "pipeFd %d", pipeFd);*/ 
	
	Tcl_GetChannelHandle (Tcl_GetChannel (interp, Tcl_GetVar (interp, "pipe", NULL), NULL), TCL_READABLE, &data);
	inputPipeFd = (int) data;
	
	XFlush(dis);
		
	for (;;) {
			
		FD_ZERO (&readfds);
		FD_SET (xFd, &readfds);
		FD_SET (pipeFd, &readfds);
		FD_SET (inputPipeFd, &readfds);
						
		fdsTcl = (pipeFd > inputPipeFd) ? pipeFd : inputPipeFd;
		nfds = (xFd > fdsTcl) ? xFd + 1: fdsTcl + 1;	
	
		select (nfds, &readfds, NULL, NULL, NULL);

		if (FD_ISSET (inputPipeFd, &readfds) != 0) { 
			if (Tcl_Eval (interp, "getFromPipe") != TCL_OK) {
				fprintf (stderr, "getFromPipe error %s\n", Tcl_GetStringResult (interp));
			} 
		} 
			
		if (FD_ISSET (pipeFd, &readfds) != 0) {
			while (Tcl_DoOneEvent (TCL_DONT_WAIT));	
		}
						
		if (FD_ISSET (xFd, &readfds) == 0) {
			continue;
		}

		while (XPending (dis) > 0) {
			XNextEvent (dis, &report);	
			
			/*fprintf (stderr, "type %d\n", report.type);*/
			switch  (report.type) {
			case ConfigureNotify: 
			/*fprintf (stderr, "ConfigureNotify \n");*/
			break;	

			case CreateNotify:
				PanacheCreateNotify (&report.xcreatewindow);
			break;

			case ConfigureRequest:
				PanacheConfigureRequest (&report.xconfigurerequest);
			break;

			case DestroyNotify:
				PanacheDestroyNotify (&report.xdestroywindow);
			break;

			case EnterNotify:
			{
				Window win = report.xcrossing.window;
				char *winId = NULL; 
				char cmd[] = "sendToPipe [list activateWindow $winId]";
	
				winId = charMalloc (winIdLength);
				sprintf (winId, "%ld", win); 
				Tcl_SetVar (interp, "winId", winId, 0);
				free (winId);
				
				if (Tcl_Eval (interp, cmd) != TCL_OK) {
					fprintf (stderr, "Error evaluating cmd in EnterNotify within main() %s\n", Tcl_GetStringResult (interp));
				}
	
			}
			break;

			case FocusIn:
			break;

	
			case KeyPress:
			{
				char cmd[] = "sendToPipe next";
								
				if (XLookupKeysym (&report.xkey, 0) == XK_Tab && (report.xkey.state & Mod1Mask)) {	
					fprintf (stderr, "alt tab win %ld\n", report.xkey.window);
					if (Tcl_Eval (interp, cmd) != TCL_OK) { 
						fprintf (stderr, "Error evaluating cmd in KeyPress within main() %s\n", Tcl_GetStringResult (interp));
					}
				} else {
					/*Send XK_Tab*/
				}
													
				/*
				fprintf (stderr, "1 %d \n", report.xkey.state == Mod1Mask);
				fprintf (stderr, "2 %d \n", report.xkey.state == Mod2Mask);
				fprintf (stderr, "3 %d \n", report.xkey.state == Mod3Mask);
				fprintf (stderr, "4 %d \n", report.xkey.state == Mod4Mask);
				fprintf (stderr, "5 %d \n", report.xkey.state == Mod5Mask);
				*/
			}
			break;

			case MapRequest: 
				PanacheMapRequest (&report.xmaprequest);
			break;

			case UnmapNotify:
			{
				int state = PanacheGetWMState (report.xunmap.window);
				/*Mapped or Iconified*/
				if (state == 1 || state == 3) {
					char *winId = NULL;
					char cmd[] = "sendToPipe [list remove $winId]";
		
					winId = charMalloc (winIdLength);
					sprintf (winId, "%ld", report.xunmap.window);				
					
					Tcl_SetVar (interp, "winId", winId, 0);
					free (winId);
							
					PanacheSetWMState (report.xunmap.window, WithdrawnState);
				
					if (Tcl_Eval (interp, cmd) != TCL_OK) {
						fprintf (stderr, "Tcl_Eval error in UnmapNotify within main() %s", Tcl_GetStringResult (interp));
					}
				}
			}
			break;

			case PropertyNotify:
			{
				XTextProperty xtp;
				xtp.value = NULL;

				if (XGetWMName (dis, report.xproperty.window, &xtp) == 1) {
					char *winId;
					char cmd[] = "sendToPipe [list title [list $winTitle] $winId]";
						
					winId = charMalloc (winIdLength);
					sprintf (winId, "%ld", report.xproperty.window);
		
					Tcl_SetVar (interp, "winTitle", (char *) xtp.value, 0);
					Tcl_SetVar (interp, "winId", winId, 0);
					
					free (winId);
					XFree (xtp.value);
				
					if (Tcl_Eval (interp, cmd) != TCL_OK) {
						fprintf (stderr, "Tcl_Eval error in PropertyNotify: within main() %s\n", Tcl_GetStringResult (interp));
					}
				}
			}
			break;		


			case ReparentNotify:
			{
				Window win = report.xreparent.window;
				Window parent = report.xreparent.parent;
								
				/*
				fprintf (stderr, "ReparentNotify\n");
				fprintf (stderr, "win %ld parent %ld event %ld\n", win, parent, event);
				*/			
				XSelectInput (dis, win, 0); 

				if (parent != root) { 
					char *winId;				
					char cmd[] = "sendToPipe [list remove $winId]"; 
		
					winId = charMalloc (winIdLength);
					sprintf (winId, "%ld", win); 
					Tcl_SetVar (interp, "winId", winId, 0);		
					free (winId);
						
					if (Tcl_Eval (interp, cmd) != TCL_OK) { 
						fprintf (stderr, "Tcl_Eval error in ReparentNotify within main() %s\n", Tcl_GetStringResult (interp));
					} 
				}				
			}			
			break;


			case ResizeRequest:
			{
				Window twin;
				Window win = report.xresizerequest.window;				
								
				if (XGetTransientForHint (dis, win, &twin) == 1) {
					XResizeWindow (dis, win, 
						report.xresizerequest.width, report.xresizerequest.height
					);
				} 
				
				XFlush (dis);
			}
			break;
		
			default:
			break;
			}
		}
	}
	return 0;
}