Initial revision

20 files changed, 11021 insertions, 0 deletions

diff --git a/lisp/modules/indent.lsp b/lisp/modules/indent.lsp
new file mode 100644
index 0000000..4a7f7aa
--- /dev/null
+++ b/lisp/modules/indent.lsp
@@ -0,0 +1,1420 @@
+;
+;; Copyright (c) 2002 by The XFree86 Project, Inc.
+;;
+;; Permission is hereby granted, free of charge, to any person obtaining a
+;; copy of this software and associated documentation files (the "Software"),
+;; to deal in the Software without restriction, including without limitation
+;; the rights to use, copy, modify, merge, publish, distribute, sublicense,
+;; and/or sell copies of the Software, and to permit persons to whom the
+;; Software is furnished to do so, subject to the following conditions:
+;;
+;; The above copyright notice and this permission notice shall be included in
+;; all copies or substantial portions of the Software.
+;;
+;; THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
+;; IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
+;; FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT.  IN NO EVENT SHALL
+;; THE XFREE86 PROJECT BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY,
+;; WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF
+;; OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE
+;; SOFTWARE.
+;;
+;; Except as contained in this notice, the name of the XFree86 Project shall
+;; not be used in advertising or otherwise to promote the sale, use or other
+;; dealings in this Software without prior written authorization from the
+;; XFree86 Project.
+;;
+;; Author: Paulo César Pereira de Andrade
+;;
+;;
+;; $XFree86: xc/programs/xedit/lisp/modules/indent.lsp,v 1.7 2003/01/29 03:05:53 paulo Exp $
+;;
+
+(provide "indent")
+(require "xedit")
+(in-package "XEDIT")
+
+(defconstant indent-spaces '(#\Tab #\Space))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; The final indentation function.
+;; Parameters:
+;;	indent
+;;		Number of spaces to insert
+;;	offset
+;;		Offset to where indentation should be added
+;;	no-tabs
+;;		If set, tabs aren't inserted
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+(defun indent-text (indent offset &optional no-tabs
+		    &aux start line length index current tabs spaces string
+			 barrier base result (point (point))
+		   )
+
+    ;; Initialize
+    (setq
+	start	(scan offset :eol :left)
+	line	(read-text start (- offset start))
+	length	(length line)
+	index	(1- length)
+	current	0
+	base	0
+    )
+
+    (and (minusp indent) (setq indent 0))
+
+    ;; Skip any spaces after offset, "paranoia check"
+    (while (member (char-after offset) indent-spaces)
+	(incf offset)
+    )
+
+    ;; Check if there are only spaces before `offset' and the line `start'
+    (while (and (>= index 0) (member (char line index) indent-spaces))
+	(decf index)
+    )
+
+    ;; `index' will be zero if there are only spaces in the `line'
+    (setq barrier (+ start (incf index)))
+
+    ;; Calculate `base' unmodifiable indentation, if any
+    (dotimes (i index)
+	(if (char= (char line i) #\Tab)
+	    (incf base (- 8 (rem base 8)))
+	    (incf base)
+	)
+    )
+
+    ;; If any non blank character would need to be deleted
+    (and (> base indent) (return-from indent-text nil))
+
+    ;; Calculate `current' indentation
+    (setq current base)
+    (while (< index length)
+	(if (char= (char line index) #\Tab)
+	    (incf current (- 8 (rem current 8)))
+	    (incf current)
+	)
+	(incf index)
+    )
+
+    ;; Maybe could also "optimize" the indentation even if it is already
+    ;; correct, removing spaces "inside" tabs.
+    (when (/= indent current)
+	(if no-tabs
+	    (setq
+		length	(- indent base)
+		result	(+ barrier length)
+		string	(make-string length :initial-element #\Space)
+	    )
+	    (progn
+		(multiple-value-setq (tabs spaces) (floor (- indent base) 8))
+		(setq
+		    length	(+ tabs spaces)
+		    result	(+ barrier length)
+		    string	(make-string length :initial-element #\Tab)
+		)
+		(fill string #\Space :start tabs)
+	    )
+	)
+
+	(replace-text barrier offset string)
+	(and (>= offset point) (>= point barrier) (goto-char result))
+    )
+)
+(compile 'indent-text)
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; Helper function, returns indentation of a given offset
+;; If `align' is set, stop once a non blank character is seen, that
+;; is, use `offset' only as a line identifier
+;; If `resolve' is set, it means that the offset is just a hint, it
+;; maybe anywhere in the line
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+(defun offset-indentation (offset &key resolve align
+			   &aux
+			   char
+			   line
+			   (start (scan offset :eol :left))
+			   (indent 0))
+    (if resolve
+	(loop
+	    (if (characterp (setq char (char-after start)))
+		(if (char= char #\Tab)
+		    (incf indent (- 8 (rem indent 8)))
+		    ;; Not a tab, check if is a space
+		    (if (char= char #\Space)
+			(incf indent)
+			;; Not a tab neither a space
+			(return indent)
+		    )
+		)
+		;; EOF found
+		(return indent)
+	    )
+	    ;; Increment offset to check next character
+	    (incf start)
+	)
+	(progn
+	    (setq line (read-text start (- offset start)))
+	    (dotimes (i (length line) indent)
+		(if (char= (setq char (char line i)) #\Tab)
+		    (incf indent (- 8 (rem indent 8)))
+		    (progn
+			(or align (member char indent-spaces)
+			    (return indent)
+			)
+			(incf indent)
+		    )
+		)
+	    )
+	)
+    )
+)
+(compile 'offset-indentation)
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;  A default/fallback indentation function, just copy indentation
+;; of previous line.
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+(defun default-indent (syntax syntable)
+    (let
+	(
+	(offset (scan (point) :eol :left))
+	start
+	left
+	right
+	)
+
+	syntable	;; XXX hack to not generate warning about unused
+			;; variable, should be temporary (until unused
+			;; variables can be declared as such)
+
+	(if
+	    (or
+		;; if indentation is disabled
+		(and
+		    (hash-table-p (syntax-options syntax))
+		    (gethash :disable-indent (syntax-options syntax))
+		)
+		;; or if not at the start of a new line
+		(> (scan offset :eol :right) offset)
+	    )
+	    (return-from default-indent)
+	)
+
+	(setq left offset)
+	(loop
+	    (setq
+		start left
+		left (scan start :eol :left :count 2)
+		right (scan left :eol :right)
+	    )
+	    ;; if start of file reached
+	    (and (>= left start) (return))
+	    (when
+		(setq
+		    start
+		    (position-if-not
+			#'(lambda (char) (member char indent-spaces))
+			(read-text left (- right left))
+		    )
+		)
+
+		;; indent the current line
+		(indent-text (offset-indentation (+ left start) :align t) offset)
+		(return)
+	    )
+	)
+    )
+)
+(compile 'default-indent)
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; Helper function
+;;   Clear line before cursor if it is empty
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+(defun indent-clear-empty-line (&aux left offset right line index)
+    (setq
+	offset	(scan (point) :eol :left)
+	left	(scan offset :eol :left :count 2)
+	right	(scan left :eol :right)
+    )
+
+    ;; If not at the first line in the file and line is not already empty
+    (when (and (/= offset left) (/= left right))
+	(setq
+	    line	(read-text left (- right left))
+	    index	(1- (length line))
+	)
+	(while (and (>= index 0) (member (char line index) indent-spaces))
+	    (decf index)
+	)
+	;; If line was only spaces
+	(and (minusp index) (replace-text left right ""))
+    )
+)
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;  Macro to be called whenever an indentation rule decides that
+;; the parser is done.
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+(defmacro indent-macro-terminate (&optional result)
+    `(return-from ind-terminate-block ,result)
+)
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; Like indent-terminate, but "rejects" the input for the current line
+;; and terminates the loop.
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+(defmacro indent-macro-reject (&optional result)
+   `(progn
+	(setq ind-state ind-prev-state)
+	(return-from ind-terminate-block ,result)
+    )
+)
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; Like indent-reject, but "rejects" anything before the current token
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+(defmacro indent-macro-reject-left (&optional result)
+   `(progn
+	(setq ind-state ind-matches)
+	(return-from ind-terminate-block ,result)
+    )
+)
+
+
+(defstruct indtoken
+    regex			;; a string, character or regex
+    token			;; the resulting token, nil or a keyword
+    begin			;; begin a new table
+    switch			;; switch to another table
+    ;; begin and switch fields are used like the ones for the syntax highlight
+    ;; syntoken structure.
+    label			;; filed at compile time
+    code			;; code to execute when it matches
+)
+
+(defstruct indtable
+    label			;; a keyword, name of the table
+    tokens			;; list of indtoken structures
+    tables			;; list of indtable structures
+    augments			;; augment list
+)
+
+(defstruct indaugment
+    labels			;; list of keywords labeling tables
+)
+
+(defstruct indinit
+    variables			;; list of variables and optional initialization
+    ;; Format of variables must be suitable to LET*, example of call:
+    ;;	(indinit
+    ;;	    var1		;; initialized to NIL
+    ;;	    (var2 (afun))	;; initialized to the value returned by AFUN
+    ;;	)
+)
+
+(defstruct indreduce
+    token			;; reduced token
+    rules			;; list of rules
+    label			;; unique label associated with rule, this
+				;; field is automatically filled in the
+				;; compilation process. this field exists
+				;; to allow several indreduce definitions
+				;; that result in the same token
+    check			;; FORM evaluated, if T apply reduce rule
+    code			;; PROGN to be called when a rule matches
+)
+
+;; NOTE, unlike "reduce" rules, "resolve" rules cannot be duplicated
+(defstruct indresolve
+    match			;; the matched token (or a list of tokens)
+    code			;; PROGN to apply for this token
+)
+
+(defstruct indent
+    reduces			;; list of indreduce structures
+    tables			;; list of indtable structures
+    inits			;; initialization list
+    resolves			;; list of indresolve structures
+    token-code			;; code to execute when a token matches
+    check-code			;; code to execute before applying a reduce rule
+    reduce-code			;; code to execute after reduce rule
+    resolve-code		;; code to execute when matching a token
+)
+
+(defmacro defindent (variable label &rest lists)
+   `(if (boundp ',variable)
+	,variable
+	(progn
+	    (proclaim '(special ,variable))
+	    (setq ,variable (compile-indent-table ,label ,@lists))
+	)
+    )
+)
+
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; Create an indent token.
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+(defmacro indtoken (pattern token
+		    &key icase nospec begin switch code (nosub t))
+    (setq pattern (re-comp (eval pattern) :icase icase :nospec nospec :nosub nosub))
+    (when (consp (re-exec pattern "" :notbol t :noteol t))
+	(error "INDTOKEN: regex ~A matches empty string" pattern)
+    )
+
+    ;; result of macro, return token structure
+    (make-indtoken
+	:regex	pattern
+	:token	token
+	:begin	begin
+	:switch	switch
+	:code	code
+    )
+)
+
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; Create an indentation table. Basically a list of indentation tokens.
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+(defun indtable (label &rest definitions)
+    ;; check for simple errors
+    (unless (keywordp label)
+	(error "INDTABLE: ~A is not a keyword" label)
+    )
+    (dolist (item definitions)
+	(unless
+	    (or
+		(atom item)
+		(indtoken-p item)
+		(indtable-p item)
+		(indaugment-p item)
+	    )
+	    (error "INDTABLE: invalid indent table argument ~A" item)
+	)
+    )
+
+    ;; return indent table structure
+    (make-indtable
+	:label		label
+	:tokens		(remove-if-not #'indtoken-p definitions)
+	:tables		(remove-if-not #'indtable-p definitions)
+	:augments	(remove-if-not #'indaugment-p definitions)
+    )
+)
+
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; Add identifier to list of augment tables.
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+(defun indaugment (&rest keywords)
+    (dolist (keyword keywords)
+	(unless (keywordp keyword)
+	    (error "INDAUGMENT: bad indent table label ~A" keyword)
+	)
+    )
+
+    ;; return augment list structure
+    (make-indaugment :labels keywords)
+)
+
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; Add variables to initialization list
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+(defmacro indinit (&rest variables)
+    (make-indinit :variables variables)
+)
+
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; Create a "reduction rule"
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+(defmacro indreduce (token check rules &rest code &aux nullp consp)
+    ;; check for simple errors
+    (unless (or (keywordp token) (null token))
+	(error "INDREDUCE: ~A is not a keyword" token)
+    )
+    (dolist (rule rules)
+	(or (listp rule) (error "INDREDUCE: invalid indent rule ~A" rule))
+	;; XXX This test is not enough, maybe should add some sort of
+	;; runtime check to avoid circularity.
+	(and (eq token (car rule)) (null (cdr rule))
+	    (error "INDREDUCE: ~A reduces to ~A" token)
+	)
+	(dolist (item rule)
+	    (and (or nullp consp) (not (keywordp item))
+		(error "INDREDUCE: a keyword must special pattern")
+	    )
+	    (if (consp item)
+		(progn
+		    (unless
+			(or
+			    (and
+				(eq (car item) 'not)
+				(keywordp (cadr item))
+				(null (cddr item))
+			    )
+			    (and
+				(eq (car item) 'or)
+				(null (member-if-not #'keywordp (cdr item)))
+			    )
+			)
+			(error "INDREDUCE: syntax error parsing ~A" item)
+		    )
+		    (setq consp t)
+		)
+		(progn
+		    (setq nullp (null item) consp nil)
+		    (unless (or (keywordp item) nullp (eq item t))
+			(error "INDREDUCE: ~A is not a keyword" item)
+		    )
+		)
+	    )
+	)
+;	(and consp
+;	    (error "INDREDUCE: pattern must be followed by keyword")
+;	)
+    )
+
+    ;; result of macro, return indent reduce structure
+    (make-indreduce
+	:token	token
+	:check	check
+	:rules	(remove-if #'null rules)
+	:code	code
+    )
+)
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; Create a "resolve rule"
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+(defmacro indresolve (match &rest code)
+    ;; check for simple errors
+    (if (consp match)
+	(dolist (token match)
+	    (or (keywordp token) (error "INDRESOLVE: ~A is not a keyword" token))
+	)
+	(or (keywordp match) (error "INDRESOLVE: ~A is not a keyword" match))
+    )
+
+    ;; result of macro, return indent resolve structure
+    (make-indresolve
+	:match	match
+	:code	code
+    )
+)
+
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; Helper function for compile-indent-table. Returns a list of all
+;; tables and tokens for a given table, including tokens and tables
+;; of children.
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+(defun list-indtable-elements (table &aux result sub-result)
+    (setq result (cons (indtable-tokens table) (indtable-tables table)))
+    (dolist (child (indtable-tables table))
+	(setq sub-result (list-indtable-elements child))
+	(rplaca result (append (car result) (car sub-result)))
+	(rplacd result (append (cdr result) (cdr sub-result)))
+    )
+    ;; Return pair of all nested tokens and tables
+    result
+)
+
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; First pass adding augumented tokens to a table, done in two passes
+;; to respect inheritance order.
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+(defun compile-indent-augment-list (table table-list &aux labels augment tokens)
+
+    ;; Create a list of all augment tables.
+    (dolist (augment (indtable-augments table))
+	(setq labels (append labels (indaugment-labels augment)))
+    )
+
+    ;;  Remove duplicates and references to "itself", without warnings?
+    (setq
+	labels
+	(remove (indtable-label table) (remove-duplicates labels :from-end t))
+    )
+
+    ;; Check if the specified indent tables exists!
+    (dolist (label labels)
+	(unless
+	    (setq augment (car (member label table-list :key #'indtable-label)))
+	    (error "COMPILE-INDENT-AUGMENT-LIST: Cannot augment ~A in ~A"
+		label
+		(indtable-label table)
+	    )
+	)
+
+	;; Increase list of tokens.
+	(setq tokens (append tokens (indtable-tokens augment)))
+    )
+
+    ;;  Store the tokens in the augment list. They will be added
+    ;; to the indent table in the second pass.
+    (setf (indtable-augments table) tokens)
+
+    ;;  Recurse on every child table.
+    (dolist (child (indtable-tables table))
+	(compile-indent-augment-list child table-list)
+    )
+)
+
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; Last pass adding augmented tokens to a table.
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+(defun link-indent-augment-list (table)
+    (setf
+	(indtable-tokens table)
+	(remove-duplicates
+	    (nconc (indtable-tokens table) (indtable-augments table))
+	    :key	#'indtoken-regex
+	    :test	#'equal
+	    :from-end	t
+	)
+
+	;;  Don't need to keep this list anymore.
+	(indtable-augments table)
+	()
+    )
+
+    (dolist (child (indtable-tables table))
+	(link-indent-augment-list child)
+    )
+)
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; Compile the indent reduction rules
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+(defun compile-indent-reduces (reduces
+			       &aux need label check rules reduce
+				    check-code reduce-code)
+    (dolist (item reduces)
+	(setq
+	    label	(indreduce-label item)
+	    check	(indreduce-check item)
+	    rules	(indreduce-rules item)
+	    reduce	(indreduce-code  item)
+	    need	(and
+			    rules
+			    (not label)
+			    (or
+				reduce
+				(null check)
+				(not (constantp check))
+			    )
+			)
+	)
+	(when need
+	    (and (null label) (setq label (intern (string (gensym)) 'keyword)))
+
+	    (setf (indreduce-label item) label)
+
+	    (and
+		(or (null check)
+		    (not (constantp check))
+		)
+		(setq
+		    check	(list (list 'eq '*ind-label* label) check)
+		    check-code	(nconc check-code (list check))
+		)
+	    )
+
+	    (and reduce
+		(setq
+		    reduce	(cons (list 'eq '*ind-label* label) reduce)
+		    reduce-code	(nconc reduce-code (list reduce))
+		)
+	    )
+	)
+    )
+
+    ;; XXX Instead of using COND, could/should use CASE
+    ;; TODO Implement a smart CASE in the bytecode compiler, if
+    ;;	    possible, should generate a hashtable, or a table
+    ;;	    of indexes (for example when all elements in the cases
+    ;;	    are characters) and then jump directly to the code.
+    (if check-code
+	(setq check-code (cons 'cond (nconc check-code '((t t)))))
+	(setq check-code t)
+    )
+    (and reduce-code (setq reduce-code (cons 'cond reduce-code)))
+
+    (values check-code reduce-code)
+)
+
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; Compile the indent resolve code
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+(defun compile-indent-resolves (resolves &aux match resolve resolve-code)
+    (and
+	(/=
+	    (length resolves)
+	    (length (remove-duplicates resolves :key #'indresolve-match))
+	)
+	;; XXX Could do a more complete job and tell what is wrong...
+	(error "COMPILE-INDENT-RESOLVES: duplicated labels")
+    )
+
+    (dolist (item resolves)
+	(when (setq resolve (indresolve-code item))
+	    (setq
+		match
+		(indresolve-match item)
+
+		resolve
+		(cons
+		    (if (listp match)
+			(list 'member '*ind-token* `',match :test `#'eq)
+			(list 'eq '*ind-token* match)
+		    )
+		    resolve
+		)
+
+		resolve-code
+		(nconc resolve-code (list resolve))
+	    )
+	)
+    )
+
+    (and resolve-code (cons 'cond resolve-code))
+)
+
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; Create an indentation table
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+(defun compile-indent-table (name &rest lists
+			     &aux main elements switches begins tables symbols
+				  label code token-code check-code reduce-code
+				  (inits (remove-if-not #'indinit-p lists))
+				  (reduces (remove-if-not #'indreduce-p lists))
+				  (resolves (remove-if-not #'indresolve-p lists))
+			    )
+    (setq
+	lists	 (delete-if
+		    #'(lambda (object)
+			(or
+			    (indinit-p object)
+			    (indreduce-p object)
+			    (indresolve-p object)
+			)
+		    )
+		    lists)
+	main	 (apply #'indtable name lists)
+	elements (list-indtable-elements main)
+	switches (remove-if #'null (car elements) :key #'indtoken-switch)
+	begins   (remove-if #'null (car elements) :key #'indtoken-begin)
+	tables	 (cons main (cdr elements))
+    )
+
+    ;; Check for typos in the keywords, or for not defined indent tables.
+    (dolist (item (mapcar #'indtoken-switch switches))
+	(unless
+	    (or	(and (integerp item) (minusp item))
+		(member item tables :key #'indtable-label)
+	    )
+	    (error "COMPILE-INDENT-TABLE: SWITCH ~A cannot be matched" item)
+	)
+    )
+    (dolist (item (mapcar #'indtoken-begin begins))
+	(unless (member item tables :key #'indtable-label)
+	    (error "COMPILE-INDENT-TABLE: BEGIN ~A cannot be matched" item)
+	)
+    )
+
+    ;; Build augment list.
+    (compile-indent-augment-list main tables)
+    (link-indent-augment-list main)
+
+    ;; Change switch and begin fields to point to the indent table
+    (dolist (item switches)
+	(if (keywordp (indtoken-switch item))
+	    (setf
+		(indtoken-switch item)
+		(car (member (indtoken-switch item) tables :key #'indtable-label))
+	    )
+	)
+    )
+    (dolist (item begins)
+	(setf
+	    (indtoken-begin item)
+	    (car (member (indtoken-begin item) tables :key #'indtable-label))
+	)
+    )
+
+    ;; Build initialization list
+    (dolist (init inits)
+	(setq symbols (nconc symbols (indinit-variables init)))
+    )
+
+    ;; Build token code
+    (dolist (item (car elements))
+	(when (setq code (indtoken-code item))
+	    (setf
+		label
+		(intern (string (gensym)) 'keyword)
+
+		(indtoken-label item)
+		label
+
+		code
+		(list (list 'eq '*ind-label* label) code)
+
+		token-code
+		(nconc token-code (list code))
+	    )
+	)
+    )
+
+    (multiple-value-setq
+	(check-code reduce-code)
+	(compile-indent-reduces reduces)
+    )
+
+    (make-indent
+	:tables		tables
+	:inits		symbols
+	:reduces	reduces
+	:resolves	resolves
+	:token-code	(and token-code (cons 'cond token-code))
+	:check-code	check-code
+	:reduce-code	reduce-code
+	:resolve-code	(compile-indent-resolves resolves)
+    )
+)
+
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; Search rule-pattern in match-pattern
+;; Returns offset of match, and it's length, if any
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+(defun indent-search-rule (rule-pattern match-pattern
+			   &aux start rule rulep matchp test offset length)
+    (if (member-if-not #'keywordp rule-pattern)
+	;; rule has wildcards
+	(progn
+	    (setq
+		rulep	rule-pattern
+		matchp	match-pattern
+		start	match-pattern
+	    )
+	    (loop
+		(setq rule (car rulep))
+		(cond
+		    ;; Special pattern
+		    ((consp rule)
+			(if (eq (car rule) 'not)
+			    (progn
+				(setq
+				    test	(cadr rule)
+				    rulep	(cdr rulep)
+				    rule	(car rulep)
+				)
+				(while
+				    (and
+					;; something to match
+					matchp
+					;; NOT match is true
+					(not (eq (car matchp) test))
+					;; next match is not true
+					(not (eq (car matchp) rule))
+				    )
+				    (setq matchp (cdr matchp))
+				)
+				(if (eq (car matchp) rule)
+				    ;; rule matched
+				    (setq
+					matchp	(cdr matchp)
+					rulep	(cdr rulep)
+				    )
+				    ;; failed
+				    (setq
+					rulep	rule-pattern
+					matchp	(cdr start)
+					start	matchp
+				    )
+				)
+			    )
+			    ;; (eq (car rule) 'or)
+			    (progn
+				(if (member (car matchp) (cdr rule) :test #'eq)
+				    (setq rulep (cdr rulep) matchp (cdr matchp))
+				    ;; failed
+				    (progn
+					;; end of match found!
+					(and (null matchp) (return))
+					;; reset search
+					(setq
+					    rulep	rule-pattern
+					    matchp	(cdr start)
+					    start	matchp
+					)
+				    )
+				)
+			    )
+			)
+		    )
+
+		    ;; Skip until end of match-pattern or rule is found
+		    ((null rule)
+			(setq rulep (cdr rulep))
+			;; If matches everything
+			(if (null rulep)
+			    (progn (setq matchp nil) (return))
+			    ;; If next token cannot be matched
+			    (unless
+				(setq
+				    matchp
+				    (member (car rulep) matchp :test #'eq)
+				)
+				(setq rulep rule-pattern)
+				(return)
+			    )
+			)
+			(setq rulep (cdr rulep) matchp (cdr matchp))
+		    )
+
+		    ;; Matched
+		    ((eq rule t)
+			;; If there isn't a rule to skip
+			(and (null matchp) (return))
+			(setq rulep (cdr rulep) matchp (cdr matchp))
+		    )
+
+		    ;; Matched
+		    ((eq rule (car matchp))
+			(setq rulep (cdr rulep) matchp (cdr matchp))
+		    )
+
+		    ;; No match
+		    (t
+			;; end of match found!
+			(and (null matchp) (return))
+			;; reset search
+			(setq
+			    rulep	rule-pattern
+			    matchp	(cdr start)
+			    start	matchp
+			)
+		    )
+		)
+
+		;; if everything matched
+		(or rulep (return))
+	    )
+
+	    ;; All rules matched
+	    (unless rulep
+		;; Calculate offset and length of match
+		(setq offset 0 length 0)
+		(until (eq match-pattern start)
+		    (setq
+			offset		(1+ offset)
+			match-pattern	(cdr match-pattern)
+		    )
+		)
+		(until (eq match-pattern matchp)
+		    (setq
+			length		(1+ length)
+			match-pattern	(cdr match-pattern)
+		    )
+		)
+	    )
+	)
+	;; no wildcards
+	(and (setq offset (search rule-pattern match-pattern :test #'eq))
+	     (setq length (length rule-pattern))
+	)
+    )
+
+    (values offset length)
+)
+(compile 'indent-search-rule)
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; Indentation parser
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+(defmacro indent-macro (ind-definition ind-offset &optional ind-no-tabs)
+   `(prog*
+	(
+	;; Current indentation table
+	(ind-table (car (indent-tables ,ind-definition)))
+
+	;; The parser rules
+	(ind-reduces (indent-reduces ,ind-definition))
+
+	;; Token list for the table
+	(ind-tokens (indtable-tokens ind-table))
+
+	;; Stack of nested tables/states
+	ind-stack
+
+	;; indentation to be used
+	(*indent* 0)
+
+	;; offset to apply indentation
+	*offset*
+
+	;; Number of lines read
+	(*ind-lines* 1)
+
+	;; Matched token
+	*ind-token*
+
+	;; list of tokens after current match, should not be changed
+	*ind-token-list*
+
+	;; label associated with rule
+	*ind-label*
+
+	;; offset of match
+	*ind-offset*
+
+	;; length of match
+	*ind-length*
+
+	;; insert position
+	(*ind-point* (point))
+
+	(ind-from (scan ,ind-offset :eol :left))
+	(ind-to ,ind-offset)
+	(ind-line (read-text ind-from (- ind-to ind-from)))
+
+	;; start of current line
+	(*ind-start* ind-from)
+
+	;; State information
+	ind-state
+
+	;; For use with (indent-macro-reject)
+	ind-prev-state
+
+	;; Matches for the current line
+	ind-matches
+
+	;; Matched tokens not yet used
+	ind-cache
+
+	;; Pattern being tested
+	ind-token
+
+	;; Used when searching for a regex
+	ind-match
+
+	;; Table to change
+	ind-change
+
+	;; Length of ind-line
+	(ind-length (length ind-line))
+
+	;; Don't parse after this offset
+	(ind-end ind-length)
+
+	;; Temporary variables used during loops
+	ind-left
+	ind-right
+	ind-tleft
+	ind-tright
+
+	;; Set  when start of file is found
+	ind-startp
+
+	;; Flag for regex search
+	(ind-noteol (< ind-to (scan ind-from :eol :right)))
+
+	;; Initialization variables expanded here
+	,@(indent-inits (eval ind-definition))
+	)
+
+	;; Initial input already read
+	(go :ind-loop)
+
+;------------------------------------------------------------------------
+; Read a text line
+:ind-read
+	(setq
+	    ind-to	ind-from
+	    ind-from	(scan ind-from :eol :left :count 2)
+	)
+	;; If start of file reached
+	(and (= ind-to ind-from) (setq ind-startp t) (go :ind-process))
+
+	(setq
+	    *ind-lines*		(1+ *ind-lines*)
+	    ind-to		(scan ind-from :eol :right)
+	    ind-line		(read-text ind-from (- ind-to ind-from))
+	    ind-length		(length ind-line)
+	    ind-end		ind-length
+	    ind-noteol		nil
+	    ind-cache		nil
+	    ind-prev-state	ind-state
+	)
+
+;------------------------------------------------------------------------
+; Loop parsing backwards
+:ind-loop
+	(setq ind-matches nil)
+	(dolist (token ind-tokens)
+	    ;; Prepare to loop
+	    (setq
+		ind-token	(indtoken-regex token)
+		ind-left	0
+	    )
+	    ;; While the pattern matches
+	    (loop
+		(setq ind-right ind-left)
+		(if
+		    (consp
+			(setq
+			    ind-match
+			    (re-exec
+				ind-token
+				ind-line
+				:start	ind-left
+				:end	ind-end
+				:notbol (> ind-left 0)
+				:noteol ind-noteol
+			    )
+			)
+		    )
+
+		    ;; Remember about match
+		    (setq
+			ind-match   (car ind-match)
+			ind-left    (cdr ind-match)
+			ind-matches (cons (cons token ind-match) ind-matches)
+		    )
+
+		    ;; No match
+		    (return)
+		)
+		;; matched an empty string
+		(and (= ind-left ind-right) (incf ind-left))
+
+		;; matched a single eol or bol
+		(and (>= ind-left ind-end) (return))
+	    )
+	)
+
+	;; Add new matches to cache
+	(when ind-matches
+	    (setq
+		ind-cache
+		(stable-sort
+		    (nconc (nreverse ind-matches) ind-cache) #'< :key #'cadr
+		)
+	    )
+	)
+
+	;; If nothing in the cache
+	(or ind-cache (go :ind-process))
+
+	(setq
+	    ind-left	(cadar ind-cache)
+	    ind-right	(cddar ind-cache)
+	    ind-matches	(cdr ind-cache)
+	)
+
+	;; If only one element in the cache
+	(or ind-matches	(go :ind-parse))
+
+	(setq
+	    ind-tleft	(cadar ind-matches)
+	    ind-tright	(cddar ind-matches)
+	)
+
+	;; Remove overlaps
+	(loop
+	    (if (or (>= ind-tleft ind-right) (<= ind-tright ind-left))
+		;; No overlap
+		(progn
+		    (setq
+			ind-left    ind-tleft
+			ind-right   ind-tright
+			ind-matches (cdr ind-matches)
+		    )
+		    ;; If everything checked
+		    (or ind-matches (return))
+		)
+		;; Overlap found
+		(progn
+		    (if (consp (cdr ind-matches))
+			;; There are yet items to be checked
+			(progn
+			    (rplaca ind-matches (cadr ind-matches))
+			    (rplacd ind-matches (cddr ind-matches))
+			)
+			;; Last item
+			(progn
+			    (rplacd (last ind-cache 2) nil)
+			    (return)
+			)
+		    )
+		)
+	    )
+
+	    ;; Prepare for next check
+	    (setq
+		ind-tleft   (cadar ind-matches)
+		ind-tright  (cddar ind-matches)
+	    )
+	)
+
+;------------------------------------------------------------------------
+; Process the matched tokens
+:ind-parse
+	(setq ind-cache (nreverse ind-cache))
+
+:ind-parse-loop
+	(or (setq ind-match (car ind-cache)) (go :ind-process))
+
+	(setq
+	    ind-cache (cdr ind-cache)
+	    ind-token (car ind-match)
+	)
+
+	(or (member ind-token ind-tokens :test #'eq)
+	    (go :ind-parse-loop)
+	)
+
+	;; If a state should be added
+	(when (setq ind-change (indtoken-token ind-token))
+	    (setq
+		ind-left    (cadr ind-match)
+		ind-right   (cddr ind-match)
+
+		*ind-offset*
+		(+ ind-from ind-left)
+
+		*ind-length*
+		(- ind-right ind-left)
+
+		ind-state
+		(cons
+		    (cons ind-change (cons *ind-offset* *ind-length*))
+		    ind-state
+		)
+
+		*ind-label*
+		(indtoken-label ind-token)
+	    )
+
+	    ;; Expand token code
+	    ,(indent-token-code (eval ind-definition))
+	)
+
+	;; Check if needs to switch to another table
+	(when (setq ind-change (indtoken-switch ind-token))
+	    ;; Need to switch to a previous table
+	    (if (integerp ind-change)
+		;; Relative switch
+		(while (and ind-stack (minusp ind-change))
+		    (setq
+			ind-table	(pop ind-stack)
+			ind-change	(1+ ind-change)
+		    )
+		)
+		;; Search table in the stack
+		(until
+		    (or
+			(null ind-stack)
+			(eq
+			    (setq ind-table (pop ind-stack))
+			    ind-change
+			)
+		    )
+		)
+	    )
+
+	    ;; If no match or stack became empty
+	    (and (null ind-table)
+		(setq
+		    ind-table
+		    (car (indent-tables ,ind-definition))
+		)
+	    )
+	)
+
+	;; Check if needs to start a new table
+	;; XXX use ind-tleft to reduce number of local variables
+	(when (setq ind-tleft (indtoken-begin ind-token))
+	    (setq
+		ind-change  ind-tleft
+		ind-stack   (cons ind-table ind-stack)
+		ind-table   ind-change
+	    )
+	)
+
+	;; If current "indent pattern table" changed
+	(when ind-change
+	    (setq
+		ind-tokens  (indtable-tokens ind-table)
+		ind-cache   (nreverse ind-cache)
+		ind-end     (cadr ind-match)
+		ind-noteol  (> ind-length ind-end)
+	    )
+	    (go :ind-loop)
+	)
+
+	(and ind-cache (go :ind-parse-loop))
+
+;------------------------------------------------------------------------
+; Everything checked, process result
+:ind-process
+
+	;; If stack is not empty, don't apply rules
+	(and ind-stack (not ind-startp) (go :ind-read))
+
+	(block ind-terminate-block
+	    (setq ind-cache nil ind-tleft 0 ind-change (mapcar #'car ind-state))
+	    (dolist (entry ind-reduces)
+		(setq
+		    *ind-token* (indreduce-token entry)
+		    *ind-label* (indreduce-label entry)
+		)
+		(dolist (rule (indreduce-rules entry))
+		    (loop
+			;; Check if reduction can be applied
+			(or
+			    (multiple-value-setq
+				(ind-match ind-length)
+				(indent-search-rule rule ind-change)
+			    )
+			    (return)
+			)
+
+			(setq
+			    ;; First element matched
+			    ind-matches		(nthcdr ind-match ind-state)
+
+			    ;; Offset of match
+			    *ind-offset*	(cadar ind-matches)
+
+			    *ind-token-list*	(nthcdr ind-match ind-change)
+
+			    ;; Length of match, note that *ind-length*
+			    ;; Will be transformed to zero bellow if
+			    ;; the rule is deleting entries.
+			    *ind-length*
+			    (if (> ind-length 1)
+				(progn
+				    (setq
+					;; XXX using ind-tright, to reduce
+					;; number of local variables...
+					ind-tright
+					(nth (1- ind-length) ind-matches)
+
+					ind-right
+					(+  (cadr ind-tright)
+					    (cddr ind-tright)
+					)
+				    )
+				    (- ind-right *ind-offset*)
+				)
+				(cddar ind-matches)
+			    )
+			)
+
+			;; XXX using ind-tleft as a counter, to reduce
+			;; number of used variables...
+			(and (>= (incf ind-tleft) 1000)
+			    ;; Should never apply so many reduce rules on
+			    ;; every iteration, if needs to, something is
+			    ;; wrong in the indentation definition...
+			    (error "~D INDREDUCE iterations, ~
+				   now checking (~A ~A)"
+				ind-tleft *ind-token* rule
+			    )
+			)
+
+			;; Check if should apply the reduction
+			(or
+			    ;; Expand check code
+			    ,(indent-check-code (eval ind-definition))
+			    (return)
+			)
+
+			(if (null *ind-token*)
+			    ;; Remove match
+			    (progn
+				(setq *ind-length* 0)
+				(if (= ind-match 0)
+				    ;; Matched the first entry
+				    (setq
+					ind-state
+					(nthcdr ind-length ind-matches)
+				    )
+				    (progn
+					(setq
+					    ind-matches
+					    (nthcdr (1- ind-match) ind-state)
+					)
+					(rplacd
+					    ind-matches
+					    (nthcdr (1+ ind-length) ind-matches)
+					)
+				    )
+				)
+			    )
+
+			    ;; Substitute/simplify
+			    (progn
+				(rplaca (car ind-matches) *ind-token*)
+				(when (> ind-length 1)
+				    (rplacd (cdar ind-matches) *ind-length*)
+				    (rplacd
+					ind-matches
+					(nthcdr ind-length ind-matches)
+				    )
+				)
+			    )
+			)
+			(setq
+			    ind-cache	    t
+			    ind-change	    (mapcar #'car ind-state)
+			)
+
+			;; Expand reduce code
+			,(indent-reduce-code (eval ind-definition))
+		    )
+		)
+	    )
+
+	    ;; ind-cache will be T if at least one change was done
+	    (and ind-cache (go :ind-process))
+
+	    ;; Start of file reached
+	    (or ind-startp (go :ind-read))
+
+	)    ;; end of ind-terminate-block
+
+
+	(block ind-terminate-block
+	    (setq *ind-token-list* (mapcar #'car ind-state))
+	    (dolist (item ind-state)
+		(setq
+		    *ind-token*		(car item)
+		    *ind-offset*	(cadr item)
+		    *ind-length*	(cddr item)
+		)
+		;; Expand resolve code
+		,(indent-resolve-code (eval ind-definition))
+		(setq *ind-token-list* (cdr *ind-token-list*))
+	    )
+	)
+
+	(and (integerp *indent*)
+	     (integerp *offset*)
+	    (indent-text *indent* *offset* ,ind-no-tabs)
+	)
+    )
+)
diff --git a/lisp/modules/lisp.lsp b/lisp/modules/lisp.lsp
new file mode 100644
index 0000000..55d5e6c
--- /dev/null
+++ b/lisp/modules/lisp.lsp
@@ -0,0 +1,174 @@
+;;
+;; Copyright (c) 2001 by The XFree86 Project, Inc.
+;;
+;; Permission is hereby granted, free of charge, to any person obtaining a
+;; copy of this software and associated documentation files (the "Software"),
+;; to deal in the Software without restriction, including without limitation
+;; the rights to use, copy, modify, merge, publish, distribute, sublicense,
+;; and/or sell copies of the Software, and to permit persons to whom the
+;; Software is furnished to do so, subject to the following conditions:
+;;
+;; The above copyright notice and this permission notice shall be included in
+;; all copies or substantial portions of the Software.
+;;  
+;; THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
+;; IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
+;; FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT.  IN NO EVENT SHALL
+;; THE XFREE86 PROJECT BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY,
+;; WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF
+;; OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE
+;; SOFTWARE.
+;;
+;; Except as contained in this notice, the name of the XFree86 Project shall
+;; not be used in advertising or otherwise to promote the sale, use or other
+;; dealings in this Software without prior written authorization from the
+;; XFree86 Project.
+;;
+;; Author: Paulo César Pereira de Andrade
+;;
+;;
+;; $XFree86: xc/programs/xedit/lisp/modules/lisp.lsp,v 1.10 2002/12/20 04:32:47 paulo Exp $
+;;
+(provide "lisp")
+
+(in-package "LISP")
+
+(export '(
+    second third fourth fifth sixth seventh eighth ninth tenth
+    pathname merge-pathnames
+    logtest signum
+    alphanumericp copy-seq push pop prog prog*
+    with-open-file with-output-to-string
+))
+
+(defun second (a)	(nth 1 a))
+(defun third (a)	(nth 2 a))
+(defun fourth (a)	(nth 3 a))
+(defun fifth (a)	(nth 4 a))
+(defun sixth (a)	(nth 5 a))
+(defun seventh (a)	(nth 6 a))
+(defun eighth (a)	(nth 7 a))
+(defun ninth (a)	(nth 8 a))
+(defun tenth (a)	(nth 9 a))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; pathnames
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+(defun pathname (filename)
+    (values (parse-namestring filename)))
+
+(defun merge-pathnames (pathname &optional defaults default-version)
+    (if (null default-version)
+	(parse-namestring pathname nil defaults)
+	(parse-namestring pathname nil
+	    (make-pathname :defaults defaults :version default-version))))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; math
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+(defun logtest (integer1 integer2)
+    (not (zerop (logand integer1 integer2))))
+
+(defun signum (number)
+    (if (zerop number) number (/ number (abs number))))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; misc functions/macros
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+(defun alphanumericp (char)
+    (or (alpha-char-p char) (not (null (digit-char-p char)))))
+
+(defun copy-seq (sequence)
+    (subseq sequence 0))
+
+(defmacro prog (init &rest body)
+    `(block nil (let ,init (tagbody ,@body))))
+
+(defmacro prog* (init &rest body)
+    `(block nil (let* ,init (tagbody ,@body))))
+
+(defmacro with-open-file (file &rest body)
+    `(let ((,(car file) (open ,@(cdr file))))
+	(unwind-protect
+	    (progn ,@body)
+	    (if ,(car file) (close ,(car file))))))
+
+(defmacro with-output-to-string (stream &rest body)
+    `(let ((,(car stream) (make-string-output-stream)))
+	(unwind-protect
+	    (progn ,@body (get-output-stream-string ,(car stream)))
+	    (and ,(car stream) (close ,(car stream))))))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; setf
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+(defsetf car (list) (value)	`(progn (rplaca ,list ,value) ,value))
+(defsetf cdr (list) (value)	`(progn (rplacd ,list ,value) ,value))
+
+(defsetf caar (list) (value)	`(progn (rplaca (car ,list) ,value) ,value))
+(defsetf cadr (list) (value)	`(progn (rplaca (cdr ,list) ,value) ,value))
+(defsetf cdar (list) (value)	`(progn (rplacd (car ,list) ,value) ,value))
+(defsetf cddr (list) (value)	`(progn (rplacd (cdr ,list) ,value) ,value))
+(defsetf caaar (list) (value)	`(progn (rplaca (caar ,list) ,value) ,value))
+(defsetf caadr (list) (value)	`(progn (rplaca (cadr ,list) ,value) ,value))
+(defsetf cadar (list) (value)	`(progn (rplaca (cdar ,list) ,value) ,value))
+(defsetf caddr (list) (value)	`(progn (rplaca (cddr ,list) ,value) ,value))
+(defsetf cdaar (list) (value)	`(progn (rplacd (caar ,list) ,value) ,value))
+(defsetf cdadr (list) (value)	`(progn (rplacd (cadr ,list) ,value) ,value))
+(defsetf cddar (list) (value)	`(progn (rplacd (cdar ,list) ,value) ,value))
+(defsetf cdddr (list) (value)	`(progn (rplacd (cddr ,list) ,value) ,value))
+(defsetf caaaar (list) (value)	`(progn (rplaca (caaar ,list) ,value) ,value))
+(defsetf caaadr (list) (value)	`(progn (rplaca (caadr ,list) ,value) ,value))
+(defsetf caadar (list) (value)	`(progn (rplaca (cadar ,list) ,value) ,value))
+(defsetf caaddr (list) (value)	`(progn (rplaca (caddr ,list) ,value) ,value))
+(defsetf cadaar (list) (value)	`(progn (rplaca (cdaar ,list) ,value) ,value))
+(defsetf cadadr (list) (value)	`(progn (rplaca (cdadr ,list) ,value) ,value))
+(defsetf caddar (list) (value)	`(progn (rplaca (cddar ,list) ,value) ,value))
+(defsetf cadddr (list) (value)	`(progn (rplaca (cdddr ,list) ,value) ,value))
+(defsetf cdaaar (list) (value)	`(progn (rplacd (caaar ,list) ,value) ,value))
+(defsetf cdaadr (list) (value)	`(progn (rplacd (caadr ,list) ,value) ,value))
+(defsetf cdadar (list) (value)	`(progn (rplacd (cadar ,list) ,value) ,value))
+(defsetf cdaddr (list) (value)	`(progn (rplacd (caddr ,list) ,value) ,value))
+(defsetf cddaar (list) (value)	`(progn (rplacd (cdaar ,list) ,value) ,value))
+(defsetf cddadr (list) (value)	`(progn (rplacd (cdadr ,list) ,value) ,value))
+(defsetf cdddar (list) (value)	`(progn (rplacd (cddar ,list) ,value) ,value))
+(defsetf cddddr (list) (value)	`(progn (rplacd (cdddr ,list) ,value) ,value))
+
+(defsetf first (list) (value)	`(progn (rplaca ,list ,value) ,value))
+(defsetf second (list) (value)	`(progn (rplaca (nthcdr 1 ,list) ,value) ,value))
+(defsetf third (list) (value)	`(progn (rplaca (nthcdr 2 ,list) ,value) ,value))
+(defsetf fourth (list) (value)	`(progn (rplaca (nthcdr 3 ,list) ,value) ,value))
+(defsetf fifth (list) (value)	`(progn (rplaca (nthcdr 4 ,list) ,value) ,value))
+(defsetf sixth (list) (value)	`(progn (rplaca (nthcdr 5 ,list) ,value) ,value))
+(defsetf seventh (list) (value)	`(progn (rplaca (nthcdr 6 ,list) ,value) ,value))
+(defsetf eighth (list) (value)	`(progn (rplaca (nthcdr 7 ,list) ,value) ,value))
+(defsetf ninth (list) (value)	`(progn (rplaca (nthcdr 8 ,list) ,value) ,value))
+(defsetf tenth (list) (value)	`(progn (rplaca (nthcdr 9 ,list) ,value) ,value))
+
+(defsetf rest (list) (value)	`(progn (rplacd ,list ,value) ,value))
+
+(defun lisp::nth-store (index list value)
+    (rplaca (nthcdr index list) value) value)
+(defsetf nth lisp::nth-store)
+
+(defsetf aref (array &rest indices) (value)
+    `(lisp::vector-store ,array ,@indices ,value))
+
+(defsetf get (symbol key &optional default) (value)
+    `(lisp::put ,symbol ,key ,value))
+
+(defsetf symbol-plist lisp::set-symbol-plist)
+
+(defsetf gethash (key hash-table &optional default) (value)
+    `(lisp::puthash ,key ,hash-table ,value))
+
+(defsetf char lisp::char-store)
+(defsetf schar lisp::char-store)
+(defsetf elt lisp::elt-store)
+(defsetf svref lisp::elt-store)
+(defsetf documentation lisp::documentation-store)
+
+(defsetf symbol-value set)
+
+(defsetf subseq (sequence start &optional end) (value)
+    `(progn (replace ,sequence ,value :start1 ,start :end1 ,end) ,value))
diff --git a/lisp/modules/progmodes/c.lsp b/lisp/modules/progmodes/c.lsp
new file mode 100644
index 0000000..bc4474b
--- /dev/null
+++ b/lisp/modules/progmodes/c.lsp
@@ -0,0 +1,1118 @@
+;;
+;; Copyright (c) 2002 by The XFree86 Project, Inc.
+;;
+;; Permission is hereby granted, free of charge, to any person obtaining a
+;; copy of this software and associated documentation files (the "Software"),
+;; to deal in the Software without restriction, including without limitation
+;; the rights to use, copy, modify, merge, publish, distribute, sublicense,
+;; and/or sell copies of the Software, and to permit persons to whom the
+;; Software is furnished to do so, subject to the following conditions:
+;;
+;; The above copyright notice and this permission notice shall be included in
+;; all copies or substantial portions of the Software.
+;;
+;; THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
+;; IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
+;; FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT.  IN NO EVENT SHALL
+;; THE XFREE86 PROJECT BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY,
+;; WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF
+;; OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE
+;; SOFTWARE.
+;;
+;; Except as contained in this notice, the name of the XFree86 Project shall
+;; not be used in advertising or otherwise to promote the sale, use or other
+;; dealings in this Software without prior written authorization from the
+;; XFree86 Project.
+;;
+;; Author: Paulo César Pereira de Andrade
+;;
+;;
+;; $XFree86: xc/programs/xedit/lisp/modules/progmodes/c.lsp,v 1.26 2003/01/29 03:05:54 paulo Exp $
+;;
+
+(require "syntax")
+(require "indent")
+(in-package "XEDIT")
+
+(defsynprop *prop-format*
+    "format"
+    :font	"*lucidatypewriter-medium-r*12*"
+    :foreground	"RoyalBlue2"
+    :underline	t
+)
+
+(defsynoptions *c-DEFAULT-style*
+    ;; Positive number. Basic indentation.
+    (:indentation		.	4)
+
+    ;; Boolean. Support for GNU style indentation.
+    (:brace-indent		.	nil)
+
+    ;; Boolean. Add one indentation level to case and default?
+    (:case-indent		.	t)
+
+    ;; Boolean. Remove one indentation level for labels?
+    (:label-dedent		.	t)
+
+    ;; Boolean. Add one indentation level to continuations?
+    (:cont-indent		.	t)
+
+    ;; Boolean. Move cursor to the indent column after pressing <Enter>?
+    (:newline-indent		.	t)
+
+    ;; Boolean. Set to T if tabs shouldn't be used to fill indentation.
+    (:emulate-tabs		.	nil)
+
+    ;; Boolean. Force a newline before braces?
+    (:newline-before-brace	.	nil)
+
+    ;; Boolean. Force a newline after braces?
+    (:newline-after-brace	.	nil)
+
+    ;; Boolean. Force a newline after semicolons?
+    (:newline-after-semi	.	nil)
+
+    ;; Boolean. Only calculate indentation after pressing <Enter>?
+    ;;		This may be useful if the parser does not always
+    ;;		do what the user expects...
+    (:only-newline-indent	.	nil)
+
+    ;; Boolean. Remove extra spaces from previous line.
+    ;;		This should default to T when newline-indent is not NIL.
+    (:trim-blank-lines		.	t)
+
+    ;; Boolean. If this hash-table entry is set, no indentation is done.
+    ;;		Useful to temporarily disable indentation.
+    (:disable-indent		.	nil)
+)
+
+;; BSD like style
+(defsynoptions *c-BSD-style*
+    (:indentation		.	8)
+    (:brace-indent		.	nil)
+    (:case-indent		.	nil)
+    (:label-dedent		.	t)
+    (:cont-indent		.	t)
+    (:newline-indent		.	t)
+    (:emulate-tabs		.	nil)
+    (:newline-before-brace	.	nil)
+    (:newline-after-brace	.	t)
+    (:newline-after-semi	.	t)
+    (:trim-blank-lines		.	t)
+)
+
+;; GNU like style
+(defsynoptions *c-GNU-style*
+    (:indentation		.	2)
+    (:brace-indent		.	t)
+    (:case-indent		.	nil)
+    (:label-dedent		.	t)
+    (:cont-indent		.	t)
+    (:newline-indent		.	nil)
+    (:emulate-tabs		.	nil)
+    (:newline-before-brace	.	t)
+    (:newline-after-brace	.	t)
+    (:newline-after-semi	.	t)
+    (:trim-blank-lines		.	nil)
+)
+
+;; K&R like style
+(defsynoptions *c-K&R-style*
+    (:indentation		.	5)
+    (:brace-indent		.	nil)
+    (:case-indent		.	nil)
+    (:label-dedent		.	t)
+    (:cont-indent		.	t)
+    (:newline-indent		.	t)
+    (:emulate-tabs		.	t)
+    (:newline-before-brace	.	t)
+    (:newline-after-brace	.	t)
+    (:newline-after-semi	.	t)
+    (:trim-blank-lines		.	t)
+)
+
+(defvar *c-styles* '(
+    ("xedit"	.	*c-DEFAULT-style*)
+    ("BSD"	.	*c-BSD-style*)
+    ("GNU"	.	*c-GNU-style*)
+    ("K&R"	.	*c-K&R-style*)
+))
+
+(defvar *c-mode-options* *c-DEFAULT-style*)
+; (setq *c-mode-options* *c-gnu-style*)
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; This is a very lazy "pattern matcher" for the C language.
+;; If the syntax in the code is not correct, it may get confused, and
+;; because it is "lazy" some wrong constructs will be recognized as
+;; correct when reducing patterns.
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+(defindent *c-mode-indent* :main
+    ;; this must be the first token
+    (indtoken "^\\s*"		:start-of-line)
+    (indtoken "\\<case\\>"	:c-case)
+    (indtoken "\\<default\\>"	:c-default)
+    (indtoken "\\<do\\>"	:do)
+    (indtoken "\\<if\\>"	:c-if)
+    (indtoken "\\<else\\>"	:c-else)
+    (indtoken "\\<for\\>"	:c-for)
+    (indtoken "\\<switch\\>"	:c-switch)
+    (indtoken "\\<while\\>"	:c-while)
+    ;; Match identifiers and numbers as an expression
+    (indtoken "\\w+"		:expression)
+    (indtoken ";"		:semi		:nospec t)
+    (indtoken ","		:comma		:nospec t)
+    (indtoken ":"		:collon		:nospec t)
+    ;;  Ignore spaces before collon, this avoids dedenting ternary
+    ;; and bitfield definitions as the parser does not distinguish
+    ;; labels from those, another option would be to use the pattern
+    ;; "\\w+:", but this way should properly handle labels generated
+    ;; by macros, example: `MACRO_LABEL(value):'
+    (indtoken "\\s+:"		nil)
+
+    (indinit			(c-braces 0))
+    (indtoken "{"
+	:obrace
+	:nospec t
+	:code	(decf c-braces)
+    )
+    (indtoken "}"
+	:cbrace
+	:nospec t
+	:begin	:braces
+	:code	(incf c-braces)
+    )
+    (indtable :braces
+	(indtoken "{"
+	    :obrace
+	    :nospec t
+	    :switch -1
+	    :code   (decf c-braces)
+	)
+	(indtoken "}"
+	    :cbrace
+	    :nospec t
+	    :begin  :braces
+	    :code   (incf c-braces)
+	)
+    )
+
+    (indinit			(c-bra 0))
+    (indtoken ")"		:cparen		:nospec t :code (incf c-bra))
+    (indtoken "("		:oparen		:nospec t :code (decf c-bra))
+    (indtoken "]"		:cbrack		:nospec t :code (incf c-bra))
+    (indtoken "["		:obrack		:nospec t :code (decf c-bra))
+    (indtoken "\\\\$"		:continuation)
+
+    ;; C++ style comment, disallow other tokens to match inside comment
+    (indtoken "//.*$"		nil)
+
+    (indtoken "#"		:hash		:nospec t)
+
+    ;; if in the same line, reduce now, this must be done because the
+    ;; delimiters are identical
+    (indtoken "'([^\\']|\\\\.)*'"	:expression)
+    (indtoken "\"([^\\\"]|\\\\.)*\""	:expression)
+
+    (indtoken "\""		:cstring	:nospec t	:begin :string)
+
+    (indtoken "'"		:cconstant	:nospec t	:begin :constant)
+
+    (indtoken "*/"		:ccomment	:nospec t	:begin :comment)
+    ;; this must be the last token
+    (indtoken "$"		:end-of-line)
+
+    (indtable :string
+	;; Ignore escaped characters
+	(indtoken "\\." 	nil)
+	;; Return to the toplevel when the start of the string is found
+	(indtoken "\""		:ostring	:nospec t	:switch -1)
+    )
+    (indtable :constant
+	;; Ignore escaped characters
+	(indtoken "\\." 	nil)
+	;; Return to the toplevel when the start of the character is found
+	(indtoken "'"		:oconstant	:nospec t	:switch -1)
+    )
+    (indtable :comment
+	(indtoken "/*"		:ocomment	:nospec t	:switch -1)
+    )
+
+    ;; "Complex" statements
+    (indinit		(c-complex 0) (c-cases 0))
+
+    ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+    ;; Order of reduce rules here is important, process comment,
+    ;; continuations, preprocessor and set states when an eol is found.
+    ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+    (indinit	(c-offset (point-max))
+		(c-prev-offset c-offset)
+    )
+    (indreduce :indent
+	t
+	((:start-of-line))
+	(and (= *ind-start* *ind-offset*)
+	    (setq
+		*offset* (+ *ind-offset* *ind-length*)
+	    )
+	)
+	(setq
+	    c-prev-offset   c-offset
+	    c-offset	    *ind-offset*
+	)
+    )
+
+    ;; Delete comments
+    (indreduce nil
+	t
+	((:ocomment nil :ccomment))
+    )
+
+    ;; Join in a single token to simplify removal of possible multiline
+    ;; preprocessor directives
+    (indinit			c-continuation)
+    (indreduce :continuation
+	t
+	((:continuation :end-of-line))
+	(setq c-continuation t)
+    )
+
+    (indreduce :eol
+	t
+	((:end-of-line))
+	;; Anything after the eol offset is safe to parse now
+	(setq c-continuation nil)
+    )
+
+    ;; Delete blank lines
+    (indreduce nil
+	t
+	((:indent :eol))
+    )
+
+    ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+    ;; Preprocessor
+    ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+    (indreduce nil
+	(>= *ind-offset* *ind-start*)
+	((:indent :hash))
+	(setq *indent* 0)
+	(indent-macro-reject-left)
+    )
+    (indreduce nil
+	t
+	((:indent :hash nil :eol))
+    )
+
+    ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+    ;; Expressions
+    ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+    (indreduce :expression
+	t
+	;; Reduce to a single expression
+	((:expression :parens)
+	 (:expression :bracks)
+	 (:expression :expression)
+	;; These may be multiline
+	 (:ostring (not :ostring) :cstring)
+	 (:oconstant (not :oconstant) :cconstant)
+	)
+    )
+
+    (indreduce :expression
+	t
+	((:expression :eol :indent :expression)
+	 (:expression :eol :expression)
+	)
+    )
+
+    (indreduce :exp-comma
+	t
+	((:expression :comma)
+	)
+    )
+
+    ;; A semicollon, start a statement
+    (indreduce :stat
+	t
+	((:semi))
+    )
+
+    ;; Expression following (possibly empty) statement
+    (indreduce :stat
+	t
+	(((or :expression :exp-comma) :stat))
+    )
+
+    ;; Multiline statements
+    (indreduce :stat
+	t
+	(((or :expression :exp-comma) :eol :indent :stat)
+	 ;; rule below may have removed the :indent
+	 ((or :expression :exp-comma) :eol :stat)
+	)
+    )
+
+    (indinit	c-exp-indent)
+    ;; XXX This rule avoids parsing large amounts of code
+    (indreduce :stat
+	t
+	;; Eat eol if following expression
+	((:indent :stat :eol)
+	 (:indent :stat)
+	)
+	(if
+	    (or
+		(null c-exp-indent)
+		(/= (cdar c-exp-indent) (+ *ind-offset* *ind-length*))
+	    )
+	    ;; A new statement, i.e. not just joining a multiline one
+	    (push
+		(cons
+		    (offset-indentation *ind-offset* :resolve t)
+		    (+ *ind-offset* *ind-length*)
+		)
+		c-exp-indent
+	    )
+	    ;; Update start of statement
+	    (rplaca
+		(car c-exp-indent)
+		(offset-indentation *ind-offset* :resolve t)
+	    )
+	)
+	(when (consp (cdr c-exp-indent))
+	    (if (and
+		    (zerop c-complex)
+		    (zerop c-cases)
+		    (zerop c-bra)
+		    (= (caar c-exp-indent) (caadr c-exp-indent))
+		)
+		;; Two statements with the same indentation
+		(progn
+		    (setq *indent* (caar c-exp-indent))
+		    (indent-macro-reject-left)
+		)
+		;; Different indentation or complex state
+		(progn
+		    (rplacd c-exp-indent nil)
+		    (setq c-complex 0)
+		)
+	    )
+	)
+    )
+
+    ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+    ;; Handle braces
+    ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+    (indreduce :stat
+	;; If block finishes before current line, group as a statement
+	(< (+ *ind-offset* *ind-length*) *ind-start*)
+	((:obrace (not :obrace) :cbrace))
+    )
+    (indreduce :obrace
+	;; If not in the first line
+	(< *ind-offset* *ind-start*)
+	;; If the opening { is the first non blank char in the line
+	((:indent :obrace))
+	(setq *indent* (offset-indentation (+ *ind-offset* *ind-length*)))
+
+	;; XXX This may be the starting brace of a switch
+	(setq c-case-flag nil)
+	(indent-macro-reject-left)
+    )
+
+    ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+    ;; Labels
+    ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+    ;; XXX this frequently doesn't do what is expected, should redefine
+    ;; some rules, as it frequently will dedent while typing something
+    ;; like  test ? exp1 : exp2
+    ;;                   ^ dedents here because it reduces everything
+    ;;			   before ':' to a single :expression token.
+    (indreduce :label
+	t
+	((:indent :expression :collon :eol))
+	(when (and *label-dedent* (>= *ind-offset* *ind-start*))
+	    (setq
+		*indent*
+		(- (offset-indentation *ind-offset* :resolve t) *base-indent*)
+	    )
+	    (indent-macro-reject-left)
+	)
+    )
+
+    ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+    ;; Handle if
+    ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+    (indreduce :if
+	t
+	((:c-if :parens)
+	)
+	(incf c-complex)
+    )
+
+    (indreduce :else
+	t
+	((:c-else))
+	(incf c-complex)
+    )
+
+    ;; Join
+    (indreduce :else-if
+	t
+	((:else :if)
+	 (:else :eol :indent :if)
+	)
+	(incf c-complex)
+    )
+
+    ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+    ;; Handle for
+    ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+    ;; Join with the parentheses
+    (indreduce :for
+	t
+	((:c-for :parens)
+	)
+	(incf c-complex)
+    )
+    ;; Before current line, simplify
+    (indreduce :stat
+	(< (+ *ind-offset* *ind-length*) *ind-point*)
+	((:for :stat)
+	)
+    )
+
+    ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+    ;; Handle while and do
+    ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+    (indreduce :while
+	t
+	((:c-while :parens)
+	 ;; Assume that it is yet being edited, or adjusting indentation
+	(:c-while)
+	)
+	(incf c-complex)
+    )
+    (indreduce :stat
+	t
+	((:do :stat :while)
+	 (:while :stat)
+	)
+    )
+
+    ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+    ;; Handle switch
+    ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+    (indinit			c-case-flag)
+
+    (indreduce :switch
+	t
+	((:c-switch :parens)
+	)
+    )
+    ;; Transform in a statement
+    (indreduce :stat
+	(< (+ *ind-offset* *ind-length*) *ind-start*)
+	((:switch :stat)
+	 ;; Do it now or some rule may stop parsing, and calculate
+	 ;; a wrong indentation for nested switches
+	 (:switch :eol :indent :stat)
+	)
+    )
+    ;; An open switch
+    (indreduce :obrace
+	(and
+	    (<= c-braces 0)
+	    (> *ind-start* *ind-offset*)
+	)
+	((:indent :switch :obrace)
+	)
+	(setq
+	    *indent* (offset-indentation *ind-offset* :resolve t)
+	    c-case-flag nil
+	)
+	(indent-macro-reject-left)
+    )
+    (indreduce :obrace
+	(and
+	    (<= c-braces 0)
+	    (> *ind-start* *ind-offset*)
+	)
+	((:indent :switch :eol :indent :obrace)
+	)
+	(setq
+	    *indent* (- (offset-indentation *ind-offset* :resolve t) *base-indent*)
+	    c-case-flag nil
+	)
+	(and *brace-indent* (incf *indent* *base-indent*))
+	(indent-macro-reject-left)
+    )
+    ;; Before current line
+    (indreduce :case
+	(and
+	    (or
+		(not *case-indent*)
+		(prog1 c-case-flag (setq c-case-flag t))
+	    )
+	    (<= c-braces 0)
+	    (< *ind-offset* *ind-start*)
+	)
+	((:indent :case)
+	)
+	(setq
+	    *indent* (offset-indentation *ind-offset* :resolve t)
+	    c-case-flag nil
+	)
+	(indent-macro-reject-left)
+    )
+    (indreduce :case
+	t
+	((:c-case :expression :collon)
+	 (:c-default :collon)
+	 ;; Assume that it is yet being edited, or adjusting indentation
+	 (:c-case)
+	 (:c-default)
+	)
+	(and (>= *ind-offset* *ind-start*)
+	    (incf c-cases)
+	)
+    )
+
+    ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+    ;; Handle parentheses and brackets
+    ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+    ;; Reduce matches
+    (indreduce :parens
+	t
+	((:oparen (not :oparen) :cparen))
+	(when
+	    (and
+		(< *ind-offset* *ind-start*)
+		(> (+ *ind-offset* *ind-length*) *ind-start*)
+	    )
+	    (setq *indent* (1+ (offset-indentation *ind-offset* :align t)))
+	    (indent-macro-reject-left)
+	)
+    )
+    (indreduce :bracks
+	t
+	((:obrack (not :obrack) :cbrack))
+	(when
+	    (and
+		(< *ind-offset* *ind-start*)
+		(> (+ *ind-offset* *ind-length*) *ind-start*)
+	    )
+	    (setq *indent* (1+ (offset-indentation *ind-offset* :align t)))
+	    (indent-macro-reject-left)
+	)
+    )
+
+    ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+    ;; Assuming previous lines have correct indentation, this allows
+    ;; resolving the indentation fastly
+    ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+    ;; Line ended with an open brace
+    (indreduce :obrace
+	(< *ind-offset* *ind-start*)
+	((:indent (or :for :while :if :else-if :else :do) :obrace)
+	)
+	(setq *indent* (offset-indentation *ind-offset* :resolve t))
+	(indent-macro-reject-left)
+    )
+    ;; Adjust indentation level if current line starts with an open brace
+    (indreduce nil
+	(< *ind-offset* *ind-start* (+ *ind-offset* *ind-length*))
+	 ;; Just set initial indentation
+	((:indent (or :for :while :if :else-if :else :do) :eol :indent :obrace)
+	)
+	(setq
+	    *indent*
+	    (- (offset-indentation *ind-offset* :resolve t) *base-indent*)
+	)
+	(and *brace-indent* (incf *indent* *base-indent*))
+	(indent-macro-reject-left)
+    )
+    ;; Previous rule failed, current line does not start with an open brace
+    (indreduce :flow
+	;; first statement is in current line
+	(and
+	    (<= c-braces 0)
+	    (> (+ *ind-offset* *ind-length*) *ind-start* *ind-offset*)
+	)
+	((:indent (or :for :while :if :else-if :else :do) :eol :indent)
+	)
+	(setq *indent* (offset-indentation *ind-offset* :resolve t))
+	(indent-macro-reject-left)
+    )
+
+    ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+    ;; Simplify, remove old (:eol :indent)
+    ;; This must be the last rule, to avoid not matching the
+    ;; rules for fast calculation of indentation above
+    ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+    (indreduce nil
+	(> *ind-offset* c-prev-offset)
+	((:eol :indent))
+    )
+
+
+    (indinit			(c-flow 0))
+
+    ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+    ;; If
+    ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+    (indinit			c-if-flow)
+    (indresolve :if
+	(and (< *ind-offset* *ind-start*)
+	    (push c-flow c-if-flow)
+	    (incf *indent* *base-indent*)
+	    (incf c-flow)
+	)
+    )
+    (indresolve (:else-if :else)
+	(when c-if-flow
+	    (while (< c-flow (car c-if-flow))
+		(incf *indent* *base-indent*)
+		(incf c-flow)
+	    )
+	    (or (eq *ind-token* :else-if) (pop c-if-flow))
+	)
+	(and (< *ind-offset* *ind-start*)
+	    (incf *indent* *base-indent*)
+	    (incf c-flow)
+	)
+    )
+
+
+    ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+    ;; For/while/do
+    ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+    (indinit			c-do-flow)
+    (indresolve (:for :while :do)
+	(if (eq *ind-token* :do)
+	    (and (< *ind-offset* *ind-start*) (push c-flow c-do-flow))
+	    (when (and c-do-flow (eq *ind-token* :while))
+		(while (< c-flow (car c-do-flow))
+		    (incf *indent* *base-indent*)
+		    (incf c-flow)
+		)
+		(pop c-do-flow)
+	    )
+	)
+	(and (< *ind-offset* *ind-start*)
+	    (incf *indent* *base-indent*)
+	    (incf c-flow)
+	)
+    )
+
+
+    ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+    ;; Switch
+    ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+    (indresolve :switch
+	(setq c-case-flag nil)
+    )
+    (indresolve (:case :c-case)
+	(if (< *ind-offset* *ind-start*)
+	    (or c-case-flag
+		(setq
+		    *indent*
+		    (+ (offset-indentation *ind-offset* :resolve t)
+			*base-indent*
+		    )
+		)
+	    )
+	    (if c-case-flag
+		(and (= (decf c-cases) 0)
+		    (decf *indent* *base-indent*)
+		)
+		(or *case-indent*
+		    (decf *indent* *base-indent*)
+		)
+	    )
+	)
+	(setq c-case-flag t)
+    )
+
+
+    ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+    ;; Braces/flow control
+    ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+    (indresolve :flow
+	(incf *indent* *base-indent*)
+    )
+    (indresolve :obrace
+	(and (< *ind-offset* *ind-start*)
+	    (incf *indent* *base-indent*)
+	)
+    )
+    (indresolve :cbrace
+	(decf *indent* *base-indent*)
+	(and *case-indent* c-case-flag
+	    (decf *indent* *base-indent*)
+	    (setq c-case-flag nil)
+	)
+	(and (not *offset*) (>= *ind-offset* *ind-start*)
+	    (setq *offset* *ind-offset*)
+	)
+    )
+
+
+    ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+    ;; Statements
+    ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+    (indresolve :stat
+	(when (< *ind-offset* *ind-start*)
+	    (while (> c-flow 0)
+		(setq
+		    *indent*	(- *indent* *base-indent*)
+		    c-flow	(1- c-flow)
+		)
+	    )
+	)
+	(and
+	    *cont-indent*
+	    (< *ind-offset* *ind-start*)
+	    (> (+ *ind-offset* *ind-length*) *ind-start*)
+	    (incf *indent* *base-indent*)
+	)
+    )
+
+    (indresolve :expression
+	(and
+	    *cont-indent*
+	    (zerop c-bra)
+	    (> *indent* 0)
+	    (< *ind-offset* *ind-start*)
+	    (> (+ *ind-offset* *ind-length*) *ind-start*)
+	    (incf *indent* *base-indent*)
+	)
+    )
+
+    ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+    ;; Open
+    ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+    (indresolve (:oparen :obrack)
+	(and (< *ind-offset* *ind-start*)
+	    (setq *indent* (1+ (offset-indentation *ind-offset* :align t)))
+	)
+    )
+)
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; Find a "good" offset to start parsing backwards, so that it should
+;; always generate the same results.
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+(defun c-offset-indent (&aux char (point (point)))
+    ;; Skip spaces forward
+    (while (member (setq char (char-after point)) indent-spaces)
+	(incf point)
+    )
+    (or (characterp char) (return-from c-offset-indent point))
+
+    ;;	Skip word chars
+    (when (alphanumericp char)
+	(while (and (setq char (char-after point)) (alphanumericp char))
+	    (incf point)
+	)
+	(or (characterp char) (return-from c-offset-indent point))
+
+	;; Skip spaces forward
+	(while (member (setq char (char-after point)) indent-spaces)
+	    (incf point)
+	)
+	(or (characterp char) (return-from c-offset-indent point))
+    )
+
+    ;; don't include " or ' to avoid parsing strings "inverted"
+    (if (member char '(#\Newline #\" #\')) point (1+ point))
+)
+(compile 'c-offset-indent)
+
+(defun c-should-indent (options)
+    (when (hash-table-p options)
+	;; check if previous line has extra spaces
+	(and (gethash :trim-blank-lines options)
+	    (indent-clear-empty-line)
+	)
+
+	;; indentation disabled?
+	(and (gethash :disable-indent options)
+	    (return-from c-should-indent)
+	)
+
+	(let*
+	    (
+	    (point (point))
+	    (start (scan point :eol :left))
+	    (char (char-before point))
+	    offset
+	    match
+	    text
+	    )
+
+	    ;; at the start of an empty file
+	    (or (characterp char)
+		(return-from c-should-indent)
+	    )
+
+	    ;; if at bol and should indent only when starting a line
+	    (and (gethash :only-newline-indent options)
+		(return-from c-should-indent (= point start))
+	    )
+
+	    (and
+		(char= char #\;)
+		(gethash :newline-after-semi options)
+		(return-from c-should-indent t)
+	    )
+
+	    ;; if one of these was typed, must check indentation
+	    (and (member char '(#\{ #\} #\: #\] #\) #\#))
+		(return-from c-should-indent t)
+	    )
+
+	    ;; at the start of a line
+	    (and (= point start)
+		(return-from c-should-indent (gethash :newline-indent options))
+	    )
+
+	    ;; if first character
+	    (and (= point (1+ start))
+		(return-from c-should-indent t)
+	    )
+
+	    ;; check if is the first non-blank character in a new line
+	    (when
+		(and
+		    (gethash :cont-indent options)
+		    (= point (scan point :eol :right))
+		    (alphanumericp char)
+		)
+		(setq offset (1- point))
+		(while
+		    (and
+			(> offset start)
+			(member (char-before offset) indent-spaces)
+		    )
+		    (decf offset)
+		)
+		;; line has only one character with possible spaces before it
+		(and (<= offset start)
+		    (return-from c-should-indent t)
+		)
+	    )
+
+	    ;; check for keywords that change indentation
+	    (when (alphanumericp char)
+		(setq offset (1- point))
+		(while
+		    (and
+			(alphanumericp (char-before offset))
+			(> offset start)
+		    )
+		    (decf offset)
+		)
+		(setq
+		    text	(read-text offset (- point offset))
+		    match	(re-exec #.(re-comp "(case|else|while)\\w?\\>")
+				    text)
+		)
+		(and
+		    (consp match)
+		    (return-from c-should-indent (<= (- (caar match) offset) 2))
+		)
+	    )
+	)
+    )
+    ;; Should not indent
+    nil
+)
+(compile 'c-should-indent)
+
+
+(defun c-indent-check (syntax syntable options
+		       &aux start point char left brace change)
+    (setq
+	point	(point)
+	char	(char-before point)
+	left	point
+	brace	(member char '(#\{ #\}))
+    )
+
+    (when
+	(and brace (gethash :newline-before-brace options))
+	(setq start (scan point :eol :left))
+	(while
+	    (and
+		(> (decf left) start)
+		(member (char-before left) indent-spaces)
+	    )
+	    ;; skip blanks
+	)
+	(when (> left start)
+	    (replace-text left left (string #\Newline))
+	    (c-indent syntax syntable)
+	    (setq change t)
+	)
+    )
+
+    (when
+	(or
+	    (and brace (not change) (gethash :newline-after-brace options))
+	    (and (char= char #\;) (gethash :newline-after-semi options))
+	)
+	(setq left (point))
+	(replace-text left left (string #\Newline))
+	(goto-char (1+ left))
+	(c-indent syntax syntable)
+    )
+)
+
+(defun c-indent (syntax syntable)
+    (let*
+	(
+	(options (syntax-options syntax))
+	*base-indent*
+	*brace-indent*
+	*case-indent*
+	*label-dedent*
+	*cont-indent*
+	)
+
+	(or (c-should-indent options) (return-from c-indent))
+
+	(setq
+	    *base-indent*	(gethash :indentation options 4)
+	    *brace-indent*	(gethash :brace-indent options nil)
+	    *case-indent*	(gethash :case-indent options t)
+	    *label-dedent*	(gethash :label-dedent options t)
+	    *cont-indent*	(gethash :cont-indent options t)
+	)
+
+	(indent-macro
+	    *c-mode-indent*
+	    (c-offset-indent)
+	    (gethash :emulate-tabs options)
+	)
+
+	(c-indent-check syntax syntable options)
+    )
+)
+(compile 'c-indent)
+
+(defsyntax *c-mode* :main nil #'c-indent *c-mode-options*
+    ;;  All recognized C keywords.
+    (syntoken
+	(string-concat
+	    "\\<("
+	    "asm|auto|break|case|catch|char|class|const|continue|default|"
+	    "delete|do|double|else|enum|extern|float|for|friend|goto|if|"
+	    "inline|int|long|new|operator|private|protected|public|register|"
+	    "return|short|signed|sizeof|static|struct|switch|template|this|"
+	    "throw|try|typedef|union|unsigned|virtual|void|volatile|while"
+	    ")\\>")
+	:property *prop-keyword*)
+
+    ;; Numbers, this is optional, comment this rule if xedit is
+    ;; too slow to load c files.
+    (syntoken
+	(string-concat
+	    "\\<("
+	    ;; Integers
+	    "(\\d+|0x\\x+)(u|ul|ull|l|ll|lu|llu)?|"
+	    ;; Floats
+	    "\\d+\\.?\\d*(e[+-]?\\d+)?[lf]?"
+	    ")\\>")
+	:icase t
+	:property *prop-number*
+    )
+
+    ;; String start rule.
+    (syntoken "\"" :nospec t :begin :string :contained t)
+
+    ;; Character start rule.
+    (syntoken "'" :nospec t :begin :character :contained t)
+
+    ;; Preprocessor start rule.
+    (syntoken "^\\s*#\\s*\\w+" :begin :preprocessor :contained t)
+
+    ;; Comment start rule.
+    (syntoken "/*" :nospec t :begin :comment :contained t)
+
+    ;; C++ style comments.
+    (syntoken "//.*" :property *prop-comment*)
+
+    ;; Punctuation, this is also optional, comment this rule if xedit is
+    ;; too slow to load c files.
+    (syntoken "[][(){}/*+:;=<>,&.!%|^~?-][][(){}*+:;=<>,&.!%|^~?-]?"
+	:property *prop-punctuation*)
+
+
+    ;; Rules for comments.
+    (syntable :comment *prop-comment* #'default-indent
+	;; Match nested comments as an error.
+	(syntoken "/*" :nospec t :property *prop-error*)
+
+	(syntoken "XXX|TODO|FIXME" :property *prop-annotation*)
+
+	;;  Rule to finish a comment.
+	(syntoken "*/" :nospec t :switch -1)
+    )
+
+    ;; Rules for strings.
+    (syntable :string *prop-string* #'default-indent
+	;; Ignore escaped characters, this includes \".
+	(syntoken "\\\\.")
+
+	;; Match, most, printf arguments.
+	(syntoken "%%|%([+-]?\\d+)?(l?[deEfgiouxX]|[cdeEfgiopsuxX])"
+	    :property *prop-format*)
+
+	;; Ignore continuation in the next line.
+	(syntoken "\\\\$")
+
+	;; Rule to finish a string.
+	(syntoken "\"" :nospec t :switch -1)
+
+	;; Don't allow strings continuing in the next line.
+	(syntoken ".?$" :begin :error)
+    )
+
+    ;; Rules for characters.
+    (syntable :character *prop-constant* nil
+	;; Ignore escaped characters, this includes \'.
+	(syntoken "\\\\.")
+
+	;; Ignore continuation in the next line.
+	(syntoken "\\\\$")
+
+	;; Rule to finish a character constant.
+	(syntoken "'" :nospec t :switch -1)
+
+	;; Don't allow constants continuing in the next line.
+	(syntoken ".?$" :begin :error)
+    )
+
+    ;;  Rules for preprocessor.
+    (syntable :preprocessor *prop-preprocessor* #'default-indent
+	;;  Preprocessor includes comments.
+	(syntoken "/*" :nospec t :begin :comment :contained t)
+
+	;;  Ignore lines finishing with a backslash.
+	(syntoken "\\\\$")
+
+	;; Return to previous state if end of line found.
+	(syntoken ".?$" :switch -1)
+    )
+
+    (syntable :error *prop-error* nil
+	(syntoken "^.*$" :switch -2)
+    )
+
+    ;;  You may also want to comment this rule if the parsing is
+    ;; noticeably slow.
+    (syntoken "\\c" :property *prop-control*)
+)
diff --git a/lisp/modules/progmodes/html.lsp b/lisp/modules/progmodes/html.lsp
new file mode 100644
index 0000000..86f8eea
--- /dev/null
+++ b/lisp/modules/progmodes/html.lsp
@@ -0,0 +1,327 @@
+;;
+;; Copyright (c) 2002 by The XFree86 Project, Inc.
+;;
+;; Permission is hereby granted, free of charge, to any person obtaining a
+;; copy of this software and associated documentation files (the "Software"),
+;; to deal in the Software without restriction, including without limitation
+;; the rights to use, copy, modify, merge, publish, distribute, sublicense,
+;; and/or sell copies of the Software, and to permit persons to whom the
+;; Software is furnished to do so, subject to the following conditions:
+;;
+;; The above copyright notice and this permission notice shall be included in
+;; all copies or substantial portions of the Software.
+;;
+;; THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
+;; IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
+;; FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT.  IN NO EVENT SHALL
+;; THE XFREE86 PROJECT BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY,
+;; WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF
+;; OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE
+;; SOFTWARE.
+;;
+;; Except as contained in this notice, the name of the XFree86 Project shall
+;; not be used in advertising or otherwise to promote the sale, use or other
+;; dealings in this Software without prior written authorization from the
+;; XFree86 Project.
+;;
+;; Author: Paulo César Pereira de Andrade
+;;
+;;
+;; $XFree86: xc/programs/xedit/lisp/modules/progmodes/html.lsp,v 1.3 2002/10/06 17:11:48 paulo Exp $
+;;
+
+(require "syntax")
+(in-package "XEDIT")
+
+#|
+  This is not a validation tool for html.
+
+  It is possible to, using macros generate all combinations of text attributes,
+  to properly handle <b>...<i>...</i>...</b> etc, as well as generating macros
+  to automatically closing tags, but for now this file was built to work as an
+  experience with the syntax highlight code.
+|#
+
+(defsynprop *prop-html-default*
+    "default"
+    :font	"-*-lucida-medium-r-*-*-14-*-*-*-*-*-*-1"
+    :foreground	"Gray10")
+
+(defsynprop *prop-html-bold*
+    "bold"
+    :font	"-*-lucida-bold-r-*-*-14-*-*-*-*-*-*-1"
+    :foreground	"Gray15")
+
+(defsynprop *prop-html-italic*
+    "italic"
+    :font	"-*-lucida-medium-i-*-*-14-*-*-*-*-*-*-1"
+    :foreground	"Gray10")
+
+(defsynprop *prop-html-pre*
+    "pre"
+    :font	"-*-courier-medium-r-*-*-14-*-*-*-*-*-*-1"
+    :foreground	"Gray10")
+
+(defsynprop *prop-html-link*
+    "link"
+    :font	"-*-lucida-medium-r-*-*-14-*-*-*-*-*-*-1"
+    :foreground	"Blue"
+    :underline "t")
+
+(defsynprop *prop-html-small*
+    "small"
+    :font	"-*-lucida-medium-r-*-*-10-*-*-*-*-*-*-1"
+    :foreground	"Gray10")
+
+(defsynprop *prop-html-big*
+    "big"
+    :font	"-*-lucida-medium-r-*-*-20-*-*-*-*-*-*-1"
+    :foreground	"Gray15")
+
+(defsynprop *prop-html-name*
+    "name"
+    :font	"-*-lucida-bold-r-*-*-14-*-*-*-*-*-*-1"
+    :foreground	"Black"
+    :background "rgb:e/f/e")
+
+(defsynprop *prop-html-h1*
+    "h1"
+    :font	"-*-lucida-bold-r-*-*-20-*-*-*-*-*-*-1"
+    :foreground	"Gray15")
+
+(defsynprop *prop-html-h2*
+    "h2"
+    :font	"-*-lucida-bold-r-*-*-17-*-*-*-*-*-*-1"
+    :foreground	"Gray15")
+
+(defsynprop *prop-html-h4*
+    "h4"
+    :font	"-*-lucida-bold-r-*-*-12-*-*-*-*-*-*-1"
+    :foreground	"Gray15")
+
+(defsynprop *prop-html-h5*
+    "h5"
+    :font	"-*-lucida-bold-r-*-*-10-*-*-*-*-*-*-1"
+    :foreground	"Gray15")
+
+(defsynprop *prop-html-li*
+    "li"
+    :font	"-*-lucida-bold-r-*-*-8-*-*-*-*-*-*-1"
+    :foreground	"rgb:0/5/0"
+    :underline	t)
+
+(defsynprop *prop-html-hr*
+    "hr"
+    :font	"-*-courier-bold-r-*-*-12-*-*-*-*-*-*-1"
+    :foreground	"rgb:0/5/0"
+    :overstrike	t)
+
+(defsynprop *prop-html-title*
+    "title"
+    :font	"-*-lucida-medium-r-*-*-14-*-*-*-*-*-*-1"
+    :foreground	"Red3"
+    :underline "t")
+
+(defsynprop *prop-html-tag*
+    "tag"
+    :font	"-*-courier-medium-r-*-*-10-*-*-*-*-*-*-1"
+    :foreground	"green4")
+
+(defsynprop *prop-html-string*
+    "string"
+    :font	"-*-lucida-medium-r-*-*-10-*-*-*-*-*-*-1"
+    :foreground	"RoyalBlue2")
+
+(defsynprop *prop-html-comment*
+    "comment"
+    :font	"-*-courier-medium-o-*-*-10-*-*-*-*-*-*-1"
+    :foreground	"SlateBlue3")
+
+(defsynprop *prop-html-entity*
+    "entity"
+    :font	"-*-lucida-medium-r-*-*-12-*-*-*-*-*-*-1"
+    :foreground	"Red4")
+
+(defsynprop *prop-html-unknown*
+    "unknown"
+    :font	"-*-courier-bold-r-*-*-10-*-*-*-*-*-*-1"
+    :foreground	"yellow"
+    :background "red")
+
+(defmacro html-syntoken (name)
+    `(syntoken (string-concat "<" ,name "\\>")
+	:icase t :contained t
+	:begin (intern (string-concat ,name "$") 'keyword)))
+(defmacro html-syntable (name property)
+    `(let
+	((label (intern (string-concat ,name "$") 'keyword))
+	 (nested-label (intern (string (gensym)) 'keyword)))
+	(syntable label *prop-html-tag* nil
+	    (synaugment :generic-tag)
+	    (syntoken ">" :nospec t :property *prop-html-tag* :begin nested-label)
+	    (syntable nested-label ,property nil
+		(syntoken (string-concat "</" ,name ">")
+		    :icase t :nospec t :property *prop-html-tag* :switch -2)
+		(syntoken (string-concat "</" ,name "\\s*$")
+		    :icase t :contained t :begin :continued-end-tag)
+		(synaugment :main)))))
+
+
+(defsyntax *html-mode* :main *prop-html-default* nil nil
+    (syntoken "<!--" :nospec t :contained t :begin :comment)
+    (syntable :comment *prop-html-comment* nil
+	(syntoken "-->" :nospec t :switch -1))
+    (syntoken "&([a-zA-Z0-9_.-]+|#\\x\\x?);?" :property *prop-html-entity*)
+    (syntoken "<li>" :nospec t :icase t :property *prop-html-li*)
+    (syntoken "<hr>" :nospec t :icase t :property *prop-html-hr*)
+
+    (syntoken "<img\\>" :icase t :contained t :begin :tag)
+    (syntoken "<(p|br)>" :icase t :property *prop-html-tag*)
+
+    ;; If in the toplevel, unbalanced!
+    ;; XXX When adding new nested tables, don't forget to update this pattern.
+    (syntoken
+	(string-concat
+	    "</("
+	    "b|strong|i|em|address|pre|code|tt|small|big|a|span|div|"
+	    "h1|h2|h3|h4|h5|title|font|ol|ul|dl|dt|dd|menu"
+	    ")\\>")
+	:icase t :property *prop-html-unknown* :begin :unbalanced)
+    (syntable :unbalanced *prop-html-unknown* nil
+	(syntoken ">" :nospec t :switch :main)
+	(synaugment :generic-tag)
+    )
+
+    #||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||
+    ;; XXX ONLY add a rule for "html", "head" and "body" if you want to do a
+    ;; more complete check for common errors. If you add those rules, it will
+    ;; reparse the entire file at every character typed (unless there are
+    ;; errors in which case the parser resets the state).
+    ;; For visualization only that would be OK...
+    ||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||#
+
+    (html-syntoken "b")
+    (html-syntable "b" *prop-html-bold*)
+    (html-syntoken "strong")
+    (html-syntable "strong" *prop-html-bold*)
+
+    (html-syntoken "i")
+    (html-syntable "i" *prop-html-italic*)
+    (html-syntoken "em")
+    (html-syntable "em" *prop-html-italic*)
+    (html-syntoken "address")
+    (html-syntable "address" *prop-html-italic*)
+
+    (html-syntoken "pre")
+    (html-syntable "pre" *prop-html-pre*)
+    (html-syntoken "code")
+    (html-syntable "code" *prop-html-pre*)
+    (html-syntoken "tt")
+    (html-syntable "tt" *prop-html-pre*)
+
+    (html-syntoken "small")
+    (html-syntable "small" *prop-html-small*)
+
+    (html-syntoken "big")
+    (html-syntable "big" *prop-html-big*)
+
+    ;; Cannot hack html-syntoken and html-syntable to handle this,
+    ;; as the option to <a may be in the next line.
+    (syntoken "<a\\>" :icase t :contained t :begin :a)
+    (syntable :a *prop-html-tag* nil
+	;; Tag is open
+	(syntoken "\\<href\\>" :icase t :begin :a-href)
+	(syntoken "\\<name\\>" :icase t :begin :a-name)
+	(syntoken "<" :nospec t :property *prop-html-unknown* :switch -2)
+	(synaugment :generic-tag)
+	(syntoken ">" :nospec t :begin :a-generic-text)
+	(syntable :a-href *prop-html-tag* nil
+	    (syntoken ">" :nospec t :begin :a-href-text)
+	    (synaugment :generic-tag)
+	    (syntable :a-href-text *prop-html-link* nil
+		(syntoken "</a>"
+		    :icase t :nospec t :property *prop-html-tag* :switch -3)
+		(syntoken "</a\\s*$" :icase t :begin :continued-nested-end-tag)
+		(synaugment :main)
+	    )
+	)
+	(syntable :a-name *prop-html-tag* nil
+	    (syntoken ">" :nospec t :begin :a-name-text)
+	    (synaugment :generic-tag)
+	    (syntable :a-name-text *prop-html-name* nil
+		(syntoken "</a>"
+		    :icase t :nospec t :property *prop-html-tag* :switch -3)
+		(syntoken "</a\\s*$" :icase t :begin :continued-nested-end-tag)
+		(synaugment :main)
+	    )
+	)
+	(syntable :a-generic-text nil nil
+	    (syntoken "</a>"
+		:icase t :nospec t :property *prop-html-tag* :switch -2)
+	    (syntoken "<a/\\s$" :icase t :begin :continued-end-tag)
+	    (synaugment :main)
+	)
+    )
+
+    ;; Do nothing, just check start/end tags
+    (html-syntoken "ol")
+    (html-syntable "ol" nil)
+    (html-syntoken "ul")
+    (html-syntable "ul" nil)
+    (html-syntoken "dl")
+    (html-syntable "dl" nil)
+    ;; Maybe <dt> and <dd> should be in a special table, to not require
+    ;; and ending tag.
+    ;; XXX Maybe should also add a table for <p>.
+    (html-syntoken "dt")
+    (html-syntable "dt" nil)
+    (html-syntoken "dd")
+    (html-syntable "dd" nil)
+
+    (html-syntoken "span")
+    (html-syntable "span" nil)
+    (html-syntoken "div")
+    (html-syntable "div" nil)
+    (html-syntoken "menu")
+    (html-syntable "menu" nil)
+
+    (html-syntoken "h1")
+    (html-syntable "h1" *prop-html-h1*)
+    (html-syntoken "h2")
+    (html-syntable "h2" *prop-html-h2*)
+    (html-syntoken "h3")
+    (html-syntable "h3" *prop-html-bold*)
+    (html-syntoken "h4")
+    (html-syntable "h4" *prop-html-h4*)
+    (html-syntoken "h5")
+    (html-syntable "h5" *prop-html-h5*)
+    (html-syntoken "title")
+    (html-syntable "title" *prop-html-title*)
+
+    (html-syntoken "font")
+    (html-syntable "font" *prop-control*)
+
+    (syntoken "<" :nospec t :contained t :begin :tag)
+    (syntable :generic-tag *prop-html-tag* nil
+	(syntoken "\"" :nospec t :contained t :begin :string)
+	(syntoken "<" :nospec t :property *prop-html-unknown*)
+    )
+    (syntable :tag *prop-html-tag* nil
+	(syntoken ">" :nospec t :switch -1)
+	(synaugment :generic-tag)
+    )
+	;; Tag ended in a newline, common practice...
+    (syntable :continued-end-tag *prop-html-tag* nil
+	(syntoken ">" :nospec t :switch -3)
+	(synaugment :generic-tag)
+    )
+    (syntable :continued-nested-end-tag *prop-html-tag* nil
+	(syntoken ">" :nospec t :switch -4)
+	(synaugment :generic-tag)
+    )
+
+    (syntable :string *prop-html-string* nil
+	(syntoken "\\\\.")
+	(syntoken "\"" :nospec t :switch -1)
+    )
+)
diff --git a/lisp/modules/progmodes/imake.lsp b/lisp/modules/progmodes/imake.lsp
new file mode 100644
index 0000000..ea34ed6
--- /dev/null
+++ b/lisp/modules/progmodes/imake.lsp
@@ -0,0 +1,188 @@
+;;
+;; Copyright (c) 2002 by The XFree86 Project, Inc.
+;;
+;; Permission is hereby granted, free of charge, to any person obtaining a
+;; copy of this software and associated documentation files (the "Software"),
+;; to deal in the Software without restriction, including without limitation
+;; the rights to use, copy, modify, merge, publish, distribute, sublicense,
+;; and/or sell copies of the Software, and to permit persons to whom the
+;; Software is furnished to do so, subject to the following conditions:
+;;
+;; The above copyright notice and this permission notice shall be included in
+;; all copies or substantial portions of the Software.
+;;
+;; THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
+;; IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
+;; FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT.  IN NO EVENT SHALL
+;; THE XFREE86 PROJECT BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY,
+;; WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF
+;; OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE
+;; SOFTWARE.
+;;
+;; Except as contained in this notice, the name of the XFree86 Project shall
+;; not be used in advertising or otherwise to promote the sale, use or other
+;; dealings in this Software without prior written authorization from the
+;; XFree86 Project.
+;;
+;; Author: Paulo César Pereira de Andrade
+;;
+;;
+;; $XFree86: xc/programs/xedit/lisp/modules/progmodes/imake.lsp,v 1.2 2002/10/06 17:11:48 paulo Exp $
+;;
+
+(require "syntax")
+(in-package "XEDIT")
+
+(defsynprop *prop-shell*
+    "shell"
+    :font	"*courier-bold-r*12*"
+    :foreground	"Red4"
+)
+
+(defsynprop *prop-variable*
+    "variable"
+    :font	"*courier-medium-r*12*"
+    :foreground	"Red3"
+)
+
+;;  The syntax-highlight definition does not try to flag errors, just show
+;; tabs in the start of lines for better visualization.
+(defsynprop *prop-tabulation*
+    "tabulation"
+    :font	"*courier-medium-r*12*"
+    :background	"Gray90"
+)
+
+(defsynprop *prop-xcomm*
+    "xcomm"
+    :font	"*courier-medium-o*12*"
+    :foreground	"SkyBlue4"
+)
+
+
+(defsyntax *imake-mode* :main nil nil nil
+    (syntoken "^\\s*XCOMM\\W?.*$"
+	:property *prop-xcomm*)
+
+    (syntoken "^\\t+"
+	:property *prop-tabulation*)
+
+    (syntoken "$("
+	:nospec t
+	:begin :shell
+	:property *prop-shell*)
+
+    (syntoken "[][(){};$<=>&@/\\,.:~!|*?'`+-]"
+	:property *prop-shell*)
+
+    ;;  Preprocessor start rule.
+    (syntoken "^\\s*#\\s*\\w+"
+	:begin :preprocessor
+	:contained t)
+
+    ;;  Comment start rule.
+    (syntoken "/*"
+	:nospec t
+	:begin :comment
+	:contained t)
+
+    ;;  String start rule.
+    (syntoken "\""
+	:begin :string
+	:nospec t
+	:contained t)
+
+    ;;  Quoted string start rule.
+    (syntoken "\\\""
+	:begin :quoted-string
+	:nospec t
+	:contained t)
+
+    (syntable :shell *prop-variable* nil
+	(syntoken ")"
+	    :nospec t
+	    :property *prop-shell*
+	    :switch -1)
+    )
+
+    ;;  Rules for comments.
+    (syntable :comment *prop-comment* nil
+
+	;;  Match nested comments as an error.
+	(syntoken "/*"
+	    :nospec t
+	    :property *prop-error*)
+
+	(syntoken "XXX|TODO|FIXME"
+	    :property *prop-annotation*)
+
+	;;  Rule to finish a comment.
+	(syntoken "*/"
+	    :nospec t
+	    :switch -1)
+    )
+
+    ;;  Rules for preprocessor.
+    (syntable :preprocessor *prop-preprocessor* nil
+
+	;;  Preprocessor includes comments.
+	(syntoken "/*"
+	    :nospec t
+	    :begin :comment
+	    :contained t)
+
+	;;  Visualization help, show tabs in the start of lines.
+	(syntoken "^\\t+"
+	    :property *prop-tabulation*)
+
+	;;  Ignore lines finishing with a backslash.
+	(syntoken "\\\\$")
+
+	;;  Return to previous state if end of line found.
+	(syntoken ".?$"
+	    :switch -1)
+    )
+
+    ;;  Rules for strings.
+    (syntable :string *prop-string* nil
+
+	;;  Ignore escaped characters, this includes \".
+	(syntoken "\\\\.")
+
+	;;  Ignore continuation in the next line.
+	(syntoken "\\\\$")
+
+	;;  Rule to finish a string.
+	(syntoken "\""
+	    :nospec t
+	    :switch -1)
+
+	;;  Don't allow strings continuing in the next line.
+	(syntoken ".?$"
+	    :begin :error)
+    )
+
+    ;;  Rules for quoted strings.
+    (syntable :quoted-string *prop-constant* nil
+
+	;;  Rule to finish the quoted string.
+	(syntoken "\\\""
+	    :nospec t
+	    :switch -1)
+
+	;;  Ignore escaped characters
+	(syntoken "\\\\.")
+
+	;;  Ignore continuation in the next line.
+	(syntoken "\\\\$")
+
+	;;  Don't allow strings continuing in the next line.
+	(syntoken ".?$"
+	    :begin :error)
+    )
+
+    (syntable :error *prop-error* nil
+	(syntoken "^.*$"
+	    :switch -2)
+    )
+)
diff --git a/lisp/modules/progmodes/lisp.lsp b/lisp/modules/progmodes/lisp.lsp
new file mode 100644
index 0000000..ebf2c10
--- /dev/null
+++ b/lisp/modules/progmodes/lisp.lsp
@@ -0,0 +1,384 @@
+;;
+;; Copyright (c) 2002 by The XFree86 Project, Inc.
+;;
+;; Permission is hereby granted, free of charge, to any person obtaining a
+;; copy of this software and associated documentation files (the "Software"),
+;; to deal in the Software without restriction, including without limitation
+;; the rights to use, copy, modify, merge, publish, distribute, sublicense,
+;; and/or sell copies of the Software, and to permit persons to whom the
+;; Software is furnished to do so, subject to the following conditions:
+;;
+;; The above copyright notice and this permission notice shall be included in
+;; all copies or substantial portions of the Software.
+;;
+;; THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
+;; IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
+;; FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT.  IN NO EVENT SHALL
+;; THE XFREE86 PROJECT BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY,
+;; WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF
+;; OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE
+;; SOFTWARE.
+;;
+;; Except as contained in this notice, the name of the XFree86 Project shall
+;; not be used in advertising or otherwise to promote the sale, use or other
+;; dealings in this Software without prior written authorization from the
+;; XFree86 Project.
+;;
+;; Author: Paulo César Pereira de Andrade
+;;
+;;
+;; $XFree86: xc/programs/xedit/lisp/modules/progmodes/lisp.lsp,v 1.9 2003/01/30 02:46:26 paulo Exp $
+;;
+
+(require "syntax")
+(require "indent")
+(in-package "XEDIT")
+
+(defsynprop *prop-special*
+  "special"
+  :font		"*courier-bold-r*12*"
+  :foreground	"NavyBlue"
+)
+
+(defsynprop *prop-quote*
+  "quote"
+  :font		"*courier-bold-r*12*"
+  :foreground	"Red3"
+)
+
+(defsynprop *prop-package*
+  "package"
+  :font		"*lucidatypewriter-medium-r*12*"
+  :foreground	"Gold4"
+)
+
+(defsynprop *prop-unreadable*
+  "unreadable"
+  :font		"*courier-medium-r*12*"
+  :foreground	"Gray25"
+  :underline	t
+)
+
+(defsynoptions *lisp-DEFAULT-style*
+  ;; Positive number. Basic indentation.
+  (:indentation			.	2)
+
+  ;; Boolean. Move cursor to the indent column after pressing <Enter>?
+  (:newline-indent		.	t)
+
+  ;; Boolean. Use spaces instead of tabs to fill indentation?
+  (:emulate-tabs		.	nil)
+
+  ;; Boolean. Remove extra spaces from previous line.
+  ;;		This should default to T when newline-indent is not NIL.
+  (:trim-blank-lines		.	t)
+
+  ;; Boolean. If this hash-table entry is set, no indentation is done.
+  ;;		Useful to temporarily disable indentation.
+  (:disable-indent		.	nil)
+)
+
+(defvar *lisp-mode-options* *lisp-DEFAULT-style*)
+
+(defindent *lisp-mode-indent* :main
+  ;; this must be the first token
+  (indtoken "^\\s*"		:indent
+    :code (or *offset* (setq *offset* (+ *ind-offset* *ind-length*))))
+  ;; ignore single line comments
+  (indtoken ";.*$"		nil)
+  ;; multiline comments
+  (indtoken "|#"		:comment	:nospec t	:begin :comment)
+  ;; characters
+  (indtoken "#\\\\(\\W|\\w+(-\\w+)?)"		:character)
+  ;; numbers
+  (indtoken
+    (string-concat
+      "(\\<|[+-])\\d+("
+      ;; integers
+      "(\\>|\\.(\\s|$))|"
+      ;; ratios
+      "/\\d+\\>|"
+      ;;floats
+      "\\.?\\d*([SsFfDdLlEe][+-]?\\d+)?\\>"
+      ")")
+    :number)
+  ;; symbols, with optional package
+  (indtoken
+    (string-concat
+      ;; optional package name and ending ':'
+      "([A-Za-z_0-9%-]+:)?"
+      ;; internal symbol if after package name, or keyword
+      ":?"
+      ;; symbol name
+      "[][{}A-Za-z_0-9!$%&/<=>^~*+-]+")
+    :symbol)
+  ;; strings in the same line
+  (indtoken "\"([^\\\"]|\\\\.)*\""		:string)
+  ;; multiline strings
+  (indtoken "\""		:cstring	:nospec t	:begin :string)
+  ;; "quoted" symbols in the same line
+  (indtoken "\\|([^\\|]|\\\\.)*\\|"		:symbol)
+  ;; multiline
+  (indtoken "|"			:csymbol	:nospec t	:begin :symbol)
+  (indtoken "#"			:hash		:nospec t)
+
+  (indinit	(parens 0))
+  (indtoken "("			:oparen		:nospec t :code (incf parens))
+  (indtoken ")"			:cparen		:nospec t :code (decf parens))
+
+  (indtable :comment
+    ;; multiline comments can nest
+    (indtoken "|#"		nil		:nospec t	:begin :comment)
+    (indtoken "#|"		nil		:nospec t	:switch -1))
+
+  (indtable :string
+    ;; Ignore escaped characters
+    (indtoken "\\." 		nil)
+    ;; Return to the toplevel when the start of the string is found
+    (indtoken "\""		:ostring	:nospec t	:switch -1))
+
+  (indtable :symbol
+    ;; Ignore escaped characters
+    (indtoken "\\." 		nil)
+    ;; Return to the toplevel when the start of the symbol is found
+    (indtoken "|"		:osymbol	:nospec t	:switch -1))
+
+  ;; ignore comments
+  (indreduce nil
+    t
+    ((:comment)))
+
+  ;; reduce multiline strings
+  (indreduce :string
+    t
+    ((:ostring (not :ostring) :cstring)))
+
+  ;; reduce multiline symbols
+  (indreduce :symbol
+    t
+    ((:osymbol (not :osymbol) :csymbol)))
+
+  ;; reduce basic types, don't care if inside list or not
+  (indreduce :element
+    t
+    ((:number)
+      (:string)
+      (:character)
+      (:element :element)
+      (:indent :element)))
+
+  (indreduce :symbol
+    t
+    ((:symbol :symbol)
+      (:symbol :element)
+      (:indent :symbol)))
+
+  ;; the "real" indentation value, to make easier parsing code like:
+  ;;  (foo (bar (baz (blah
+  ;;        ^         ^
+  ;;        |         |
+  ;;        indent    |
+  ;;                  effective indentation to be used
+  (indinit	(indent 0))
+
+  ;; indentation values of opening parenthesis.
+  (indinit	stack)
+
+  ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+  ;; if before current line and open parenthesis >= 0, use indentation
+  ;; of current line to calculate relative indentation.
+  ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+  (indreduce :oparen	;; simple list?
+    (and (>= parens 0) (< *ind-offset* *ind-start*))
+    ((:indent :oparen))
+    (setq
+      *indent*	(offset-indentation (+ *ind-offset* *ind-length*) :resolve t)
+      indent	*indent*)
+    (indent-macro-reject-left))
+
+  ;; reduce list if there isn't indentation change
+  (indreduce :element
+    t
+    ((:oparen (not :oparen) :cparen)))
+
+  (indresolve :oparen
+    (setq
+      *indent*
+      (offset-indentation
+	(+ *ind-offset* *ind-length* -1 *base-indent*) :align t))
+    (push *indent* stack)
+    (incf indent *base-indent*)
+    (if (< *indent* indent) (setq *indent* indent)))
+
+  (indresolve :cparen
+    (decf indent *base-indent*)
+    (setq *indent* (pop stack))
+    (if (null stack)
+      (setq *indent* indent)
+      (setq *indent* (car stack))))
+)
+
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; Find a "good" offset to start parsing backwards, so that it should
+;; always generate the same results.
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+(defun lisp-offset-indent (&aux char (point (scan (point) :eol :left)))
+  ;; skip spaces
+  (while (member (setq char (char-after point)) indent-spaces)
+    (incf point))
+  (if (member char '(#\))) (1+ point) point))
+
+(defun lisp-should-indent (options &aux char point start)
+  (when (hash-table-p options)
+    ;; check if previous line has extra spaces
+    (and (gethash :trim-blank-lines options)
+      (indent-clear-empty-line))
+
+    ;; indentation disabled?
+    (and (gethash :disable-indent options)
+      (return-from lisp-should-indent))
+
+    (setq
+      point	(point)
+      char	(char-before (point))
+      start	(scan point :eol :left))
+
+    ;; at the start of a line
+    (and (= point start)
+      (return-from lisp-should-indent (gethash :newline-indent options)))
+
+    ;; if first character
+    (and (= point (1+ start)) (return-from lisp-should-indent t))
+
+    ;; if closing parenthesis and first nonblank char
+    (when (and (characterp char) (char= char #\)))
+      (decf point)
+      (while
+	(and (> point start) (member (char-before point) indent-spaces))
+	(decf point))
+      (return-from lisp-should-indent (<= point start)))
+  )
+  ;; should not indent
+  nil)
+
+(defun lisp-indent (syntax syntable)
+  (let*
+    ((options (syntax-options syntax))
+      *base-indent*)
+
+    (or (lisp-should-indent options) (return-from lisp-indent))
+
+    (setq *base-indent* (gethash :indentation options 2))
+
+    (indent-macro
+      *lisp-mode-indent*
+      (lisp-offset-indent)
+      (gethash :emulate-tabs options))))
+
+(compile 'lisp-indent)
+
+(defsyntax *lisp-mode* :main nil #'lisp-indent *lisp-mode-options*
+  ;; highlight car and parenthesis
+  (syntoken "\\(+\\s*[][{}A-Za-z_0-9!$%&/<=>?^~*:+-]*\\)*"
+    :property *prop-keyword*)
+  (syntoken "\\)+" :property *prop-keyword*)
+
+  ;; nil and t
+  (syntoken "\\<(nil|t)\\>" :icase t :property *prop-special*)
+
+  (syntoken "|" :nospec t :begin :unreadable :contained t)
+
+  ;; keywords
+  (syntoken ":[][{}A-Za-z_0-9!$%&/<=>^~+-]+" :property *prop-constant*)
+
+  ;; special symbol.
+  (syntoken "\\*[][{}A-Za-z_0-9!$%&7=?^~+-]+\\*"
+    :property *prop-special*)
+
+  ;; special identifiers
+  (syntoken "&(aux|key|optional|rest)\\>" :icase t :property *prop-constant*)
+
+  ;; numbers
+  (syntoken
+    ;; since lisp is very liberal in what can be a symbol, this pattern
+    ;; will not always work as expected, since \< and \> will not properly
+    ;; work for all characters that may be in a symbol name
+    (string-concat
+      "(\\<|[+-])\\d+("
+      ;; integers
+      "(\\>|\\.(\\s|$))|"
+      ;; ratios
+      "/\\d+\\>|"
+      ;;floats
+      "\\.?\\d*([SsFfDdLlEe][+-]?\\d+)?\\>"
+      ")")
+    :property *prop-number*)
+
+  ;; characters
+  (syntoken "#\\\\(\\W|\\w+(-\\w+)?)" :property *prop-constant*)
+
+  ;; quotes
+  (syntoken "[`'.]|,@?" :property *prop-quote*)
+
+  ;; package names
+  (syntoken "[A-Za-z_0-9%-]+::?" :property *prop-package*)
+
+  ;; read time evaluation
+  (syntoken "#\\d+#" :property *prop-preprocessor*)
+  (syntoken "#([+'cCsS-]|\\d+[aA=])?" :begin :preprocessor :contained t)
+
+  (syntoken "\\c" :property *prop-control*)
+
+  ;; symbols, do nothing, just resolve conflicting matches
+  (syntoken "[][{}A-Za-z_0-9!$%&/<=>^~*+-]+")
+
+  (syntable :simple-comment *prop-comment* nil
+    (syntoken "$" :switch -1)
+    (syntoken "XXX|FIXME|TODO" :property *prop-annotation*))
+
+  (syntable :comment *prop-comment* nil
+    ;; comments can nest
+    (syntoken "#|" :nospec t :begin :comment)
+    ;;  return to previous state
+    (syntoken "|#" :nospec t :switch -1)
+    (syntoken "XXX|FIXME|TODO" :property *prop-annotation*))
+
+  (syntable :unreadable *prop-unreadable* nil
+    ;; ignore escaped characters
+    (syntoken "\\\\.")
+    (syntoken "|" :nospec t :switch -1))
+
+  (syntable :string *prop-string* nil
+    ;; ignore escaped characters
+    (syntoken "\\\\.")
+    (syntoken "\"" :nospec t :switch -1))
+
+  (syntable :preprocessor *prop-preprocessor* nil
+    ;; a symbol
+    (syntoken "[][{}A-Za-z_0-9!$%&/<=>^~:*+-]+" :switch -1)
+
+    ;; conditional expression
+    (syntoken "(" :nospec t :begin :preprocessor-expression :contained t)
+
+    (syntable :preprocessor-expression *prop-preprocessor* nil
+      ;; recursive
+      (syntoken "(" :nospec t :begin :preprocessor-recursive :contained t)
+      (syntoken ")" :nospec t :switch -2)
+
+      (syntable :preprocessor-recursive *prop-preprocessor* nil
+	(syntoken "(" :nospec t
+	  :begin :preprocessor-recursive
+	  :contained t)
+	(syntoken ")" :nospec t :switch -1)
+	(synaugment :comments-and-strings))
+      (synaugment :comments-and-strings))
+    (synaugment :comments-and-strings))
+
+  (syntable :comments-and-strings nil nil
+    (syntoken "\"" :nospec t :begin :string :contained t)
+    (syntoken "#|" :nospec t :begin :comment :contained t)
+    (syntoken ";" :begin :simple-comment :contained t))
+
+  (synaugment :comments-and-strings)
+)
diff --git a/lisp/modules/progmodes/make.lsp b/lisp/modules/progmodes/make.lsp
new file mode 100644
index 0000000..d5cbc00
--- /dev/null
+++ b/lisp/modules/progmodes/make.lsp
@@ -0,0 +1,135 @@
+;;
+;; Copyright (c) 2002 by The XFree86 Project, Inc.
+;;
+;; Permission is hereby granted, free of charge, to any person obtaining a
+;; copy of this software and associated documentation files (the "Software"),
+;; to deal in the Software without restriction, including without limitation
+;; the rights to use, copy, modify, merge, publish, distribute, sublicense,
+;; and/or sell copies of the Software, and to permit persons to whom the
+;; Software is furnished to do so, subject to the following conditions:
+;;
+;; The above copyright notice and this permission notice shall be included in
+;; all copies or substantial portions of the Software.
+;;
+;; THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
+;; IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
+;; FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT.  IN NO EVENT SHALL
+;; THE XFREE86 PROJECT BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY,
+;; WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF
+;; OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE
+;; SOFTWARE.
+;;
+;; Except as contained in this notice, the name of the XFree86 Project shall
+;; not be used in advertising or otherwise to promote the sale, use or other
+;; dealings in this Software without prior written authorization from the
+;; XFree86 Project.
+;;
+;; Author: Paulo César Pereira de Andrade
+;;
+;;
+;; $XFree86: xc/programs/xedit/lisp/modules/progmodes/make.lsp,v 1.2 2002/10/06 17:11:48 paulo Exp $
+;;
+
+(require "syntax")
+(in-package "XEDIT")
+
+(defsynprop *prop-shell*
+    "shell"
+    :font	"*courier-bold-r*12*"
+    :foreground	"Red4"
+)
+
+(defsynprop *prop-variable*
+    "variable"
+    :font	"*courier-medium-r*12*"
+    :foreground	"Red3"
+)
+
+;;  The syntax-highlight definition does not try to flag errors, just show
+;; tabs in the start of lines for better visualization.
+(defsynprop *prop-tabulation*
+    "tabulation"
+    :font	"*courier-medium-r*12*"
+    :background	"Gray90"
+)
+
+
+(defsyntax *make-mode* :main nil nil nil
+    (syntoken "^\\t+" :property *prop-tabulation*)
+
+    (syntoken "^\\.\\w+" :property *prop-keyword*)
+
+    (syntoken "$("
+	:nospec t
+	:begin :shell
+	:property *prop-shell*)
+
+    (syntoken "[][(){};$<=>&@/\\,.:~!|*?'`+-]"
+	:property *prop-shell*)
+
+    ;;  Preprocessor start rule.
+    (syntoken "#.*"
+	:property *prop-comment*)
+
+    ;;  String start rule.
+    (syntoken "\""
+	:begin :string
+	:nospec t
+	:contained t)
+
+    ;;  Quoted string start rule.
+    (syntoken "\\\""
+	:begin :quoted-string
+	:nospec t
+	:contained t)
+
+    (syntable :shell *prop-variable* nil
+	(syntoken ")"
+	    :nospec t
+	    :property *prop-shell*
+	    :switch -1)
+    )
+
+    ;;  Rules for strings.
+    (syntable :string *prop-string* nil
+
+	;;  Ignore escaped characters, this includes \".
+	(syntoken "\\\\.")
+
+	;;  Ignore continuation in the next line.
+	(syntoken "\\\\$")
+
+	;;  Rule to finish a string.
+	(syntoken "\""
+	    :nospec t
+	    :switch -1)
+
+	;;  Don't allow strings continuing in the next line.
+	(syntoken ".?$"
+	    :begin :error)
+    )
+
+    ;;  Rules for quoted strings.
+    (syntable :quoted-string *prop-constant* nil
+
+	;;  Rule to finish the quoted string.
+	(syntoken "\\\""
+	    :nospec t
+	    :switch -1)
+
+	;;  Ignore escaped characters
+	(syntoken "\\\\.")
+
+	;;  Ignore continuation in the next line.
+	(syntoken "\\\\$")
+
+	;;  Don't allow strings continuing in the next line.
+	(syntoken ".?$"
+	    :begin :error)
+    )
+
+    (syntable :error *prop-error* nil
+	(syntoken "^.*$"
+	    :switch -2)
+    )
+)
diff --git a/lisp/modules/progmodes/man.lsp b/lisp/modules/progmodes/man.lsp
new file mode 100644
index 0000000..77a59a8
--- /dev/null
+++ b/lisp/modules/progmodes/man.lsp
@@ -0,0 +1,160 @@
+;;
+;; Copyright (c) 2002 by The XFree86 Project, Inc.
+;;
+;; Permission is hereby granted, free of charge, to any person obtaining a
+;; copy of this software and associated documentation files (the "Software"),
+;; to deal in the Software without restriction, including without limitation
+;; the rights to use, copy, modify, merge, publish, distribute, sublicense,
+;; and/or sell copies of the Software, and to permit persons to whom the
+;; Software is furnished to do so, subject to the following conditions:
+;;
+;; The above copyright notice and this permission notice shall be included in
+;; all copies or substantial portions of the Software.
+;;
+;; THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
+;; IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
+;; FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT.  IN NO EVENT SHALL
+;; THE XFREE86 PROJECT BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY,
+;; WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF
+;; OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE
+;; SOFTWARE.
+;;
+;; Except as contained in this notice, the name of the XFree86 Project shall
+;; not be used in advertising or otherwise to promote the sale, use or other
+;; dealings in this Software without prior written authorization from the
+;; XFree86 Project.
+;;
+;; Author: Paulo César Pereira de Andrade
+;;
+;;
+;; $XFree86: xc/programs/xedit/lisp/modules/progmodes/man.lsp,v 1.2 2002/10/06 17:11:48 paulo Exp $
+;;
+
+(require "syntax")
+(in-package "XEDIT")
+
+(defsynprop *prop-man-b*
+    "b"
+    :font	"*courier-bold-r*12*"
+    :foreground	"gray12"
+)
+
+(defsynprop *prop-man-i*
+    "i"
+    :font	"*courier-medium-o*12*"
+    :foreground	"black"
+)
+
+(defsynprop *prop-man-bi*
+    "bi"
+    :font	"*courier-bold-o*12*"
+    :foreground	"gray20"
+)
+
+(defsynprop *prop-man-th*
+    "th"
+    :font	"-*-courier-*-*-*-*-18-*-*-*-*-*-*-1"
+    :foreground	"Red3"
+)
+
+(defsynprop *prop-man-sh*
+    "sh"
+    :font	"-*-courier-*-*-*-*-14-*-*-*-*-*-*-1"
+    :foreground	"OrangeRed3"
+)
+
+(defsynprop *prop-man-ss*
+    "ss"
+    :font	"-*-courier-*-*-*-*-12-*-*-*-*-*-*-1"
+    :foreground	"Gold4"
+)
+
+(defsynprop *prop-man-escape*
+    "escape"
+    :font	"*lucidatypewriter-medium-r*12*"
+    :foreground	"RoyalBlue4"
+)
+
+(defsynprop *prop-man-string*
+    "string"
+    :font	"*lucidatypewriter-bold-r*12*"
+    :foreground	"RoyalBlue3"
+;    :underline	t
+)
+
+(defmacro man-syntoken (pattern)
+    `(syntoken (string-concat "^\\.(" ,pattern ")(\\s+|$)")
+	:icase t
+;	:contained t
+	:property *prop-preprocessor*
+	:begin (intern (string ,pattern) 'keyword)))
+
+(defmacro man-syntable (pattern property)
+    `(syntable (intern (string ,pattern) 'keyword) ,property nil
+	(syntoken "$" :switch -1)
+	(synaugment :extras)))
+
+
+(defsyntax *man-mode* :main nil nil nil
+    (syntoken "^\\.\\\\\".*"
+	:property *prop-comment*)
+
+    (man-syntoken "b|br|nm")
+    (man-syntable "b|br|nm" *prop-man-b*)
+
+    (man-syntoken "i|ir|ri|ip")
+    (man-syntable "i|ir|ri|ip" *prop-man-i*)
+
+    (man-syntoken "th|dt")
+    (man-syntable "th|dt" *prop-man-th*)
+
+    (man-syntoken "sh")
+    (man-syntable "sh" *prop-man-sh*)
+
+    (man-syntoken "ss")
+    (man-syntable "ss" *prop-man-ss*)
+
+    (man-syntoken "bi")
+    (man-syntable "bi" *prop-man-bi*)
+
+    ;; Anything not matched...
+    (syntoken "^\\.[a-z][a-z](\\s+|$)"
+	:icase t
+	:property *prop-preprocessor*)
+
+    (syntable :extras nil nil
+	(syntoken "\\<__\\l+__\\>"
+	    :property *prop-constant*)
+	(syntoken "\\\\fB"
+	    :property *prop-preprocessor*
+	    :begin :b)
+	(syntoken "\\\\fI"
+	    :property *prop-preprocessor*
+	    :begin :i)
+	(syntoken "\\\\f\\u"
+	    :property *prop-preprocessor*)
+
+	(syntoken "\\\\\\*?."
+	    :property *prop-man-escape*)
+
+	(syntoken "\""
+	    :property *prop-man-string*)
+
+	(syntable :i *prop-man-i* nil
+	    (syntoken "$"
+		:switch :main)
+	    (syntoken "\\\\f\\u"
+		:property *prop-preprocessor*
+		:switch -1)
+	)
+	(syntable :b *prop-man-b* nil
+	    (syntoken "$"
+		:switch :main)
+	    (syntoken "\\\\f\\u"
+		:property *prop-preprocessor*
+		:switch -1)
+	)
+    )
+
+    (synaugment :extras)
+)
diff --git a/lisp/modules/progmodes/rpm.lsp b/lisp/modules/progmodes/rpm.lsp
new file mode 100644
index 0000000..bd0cc6c
--- /dev/null
+++ b/lisp/modules/progmodes/rpm.lsp
@@ -0,0 +1,166 @@
+;;
+;; Copyright (c) 2003 by The XFree86 Project, Inc.
+;;
+;; Permission is hereby granted, free of charge, to any person obtaining a
+;; copy of this software and associated documentation files (the "Software"),
+;; to deal in the Software without restriction, including without limitation
+;; the rights to use, copy, modify, merge, publish, distribute, sublicense,
+;; and/or sell copies of the Software, and to permit persons to whom the
+;; Software is furnished to do so, subject to the following conditions:
+;;
+;; The above copyright notice and this permission notice shall be included in
+;; all copies or substantial portions of the Software.
+;;
+;; THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
+;; IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
+;; FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT.  IN NO EVENT SHALL
+;; THE XFREE86 PROJECT BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY,
+;; WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF
+;; OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE
+;; SOFTWARE.
+;;
+;; Except as contained in this notice, the name of the XFree86 Project shall
+;; not be used in advertising or otherwise to promote the sale, use or other
+;; dealings in this Software without prior written authorization from the
+;; XFree86 Project.
+;;
+;; Author: Paulo César Pereira de Andrade
+;;
+;;
+;; $XFree86: xc/programs/xedit/lisp/modules/progmodes/rpm.lsp,v 1.1 2003/01/16 03:50:46 paulo Exp $
+;;
+
+(require "syntax")
+(in-package "XEDIT")
+
+;; Only for testing, unifinished, good for viewing but too slow for real use...
+#|
+(defsynprop *prop-rpm-special*
+    "rpm-special"
+    :font	"*courier-bold-r*12*"
+    :foreground	"NavyBlue"
+)
+
+(defsynprop *prop-rpm-escape*
+    "rpm-escape"
+    :font	"*lucidatypewriter-medium-r*12*"
+    :foreground	"Red3")
+
+;; main package is implicit
+(defsyntax *rpm-mode* :package nil nil nil
+    (syntable :sections nil nil
+	(syntoken "^%package"
+	    :icase t
+	    :switch :package
+	    ;; XXX :begin :package was added just to test finishing and
+	    ;; starting a new syntax-table, unfortunately if using it
+	    ;; this way, frequently the entire file will be reparsed
+	    ;; at every character typed.
+	    ;; TODO study these cases and implement code to avoid it,
+	    ;; the easiest way is limiting the number of backtracked lines,
+	    ;; the screen contents sometimes could not correctly reflect
+	    ;; file contents in this case...
+	    :begin :package
+	    :property *prop-rpm-special*)
+	(syntoken "^%(build|setup|install|pre|preun|post|postun)\\>"
+	    :icase t
+	    :property *prop-rpm-special*
+	    :switch :package
+	    :begin :shell)
+	;; %changelog, XXX no rules to return to the toplevel
+	(syntoken "^%changelog\\>"
+	    :icase t
+	    :switch :package
+	    :begin :changelog
+	    :property *prop-rpm-special*)
+	(syntable :changelog nil nil
+	    ;; ignore if escaped
+	    (syntoken "%%")
+	    ;; "warn" if not escaped
+	    (syntoken "%" :property *prop-control*)
+	    ;; emails
+	    (syntoken "<[a-z0-9_-]+@[a-z0-9_-]+\\.\\w+(\\.\\w+)?>"
+		:icase t
+		:property *prop-string*)
+	)
+	;; comments
+	(syntoken "#" :contained t :nospec t :begin :comment)
+	(syntable :comment *prop-comment* nil
+	    ;; some macros are expanded even when inside comments, and may
+	    ;; cause surprises, "warn" about it
+	    (syntoken "%\\{?\\w+\\}?" :property *prop-rpm-special*)
+	    (syntoken "$" :switch -1)
+	)
+	(synaugment :global)
+    )
+
+    ;; may appear anywhere
+    (syntable :global nil nil
+	;; preprocessor like commands
+	(syntoken "^%(define|if|ifarch|else|endif)\\>"
+	    :icase t
+	    :property *prop-preprocessor*)
+	;; variables
+	(syntoken "%\\{.*\\}" :property *prop-constant*)
+    )
+
+    ;; example: "Group: ..." or "Group(pt_BR): ..."
+    (syntoken "^\\w+(\\(\\w+\\))?:" :property *prop-keyword*)
+
+    ;; for sections with shell commands
+    (syntable :shell nil nil
+	(syntoken "\\<(if|then|elif|else|fi|for|do|done|case|esac|while|until)\\>"
+	    :property *prop-keyword*)
+	(syntable :strings nil nil
+	    (syntoken "\"" :nospec t :begin :string :contained t)
+	    (syntable :string *prop-string* nil
+		(syntoken "\\$\\(?\\w+\\)?" :property *prop-constant*)
+		(syntoken "\\\\.")
+		(syntoken "\"" :nospec t :switch -1)
+	    )
+	    (syntoken "\'" :nospec t :begin :constant :contained t)
+	    (syntable :constant *prop-constant* nil
+		(syntoken "\\\\.")
+		(syntoken "\'" :nospec t :switch -1)
+	    )
+	    (syntoken "\`" :nospec t :begin :escape :contained t)
+	    (syntable :escape *prop-rpm-escape* nil
+		(syntoken "\\$\\(?\\w+\\)?" :property *prop-constant*)
+		(syntoken "\\\\.")
+		(syntoken "\`" :nospec t :switch -1)
+	    )
+	)
+	(synaugment :strings :sections)
+    )
+    (synaugment :sections)
+)
+|#
+
+
+(defsyntax *rpm-mode* :package nil nil nil
+    ;; commands, macro definitions, etc
+    (syntoken "^\\s*%\\s*\\w+" :property *prop-keyword*)
+
+    ;; rpm "variables"
+    (syntoken "%\\{.*\\}" :property *prop-constant*)
+
+    ;; package info, example: "Group: ...", "Group(pt_BR): ...", etc.
+    (syntoken "^\\w+(\\(\\w+\\))?:" :property *prop-preprocessor*)
+
+    ;; comments
+    (syntoken "#" :contained t :nospec t :begin :comment)
+    (syntable :comment *prop-comment* nil
+	;; some macros are expanded even when inside comments, and may
+	;; cause surprises, "warn" about it
+	(syntoken "%define\\>" :property *prop-control*)
+	(syntoken "%\\{?\\w+\\}?" :property *prop-string*)
+	(syntoken "$" :switch -1)
+    )
+
+    ;; emails
+    (syntoken "<?[a-z0-9_-]+@[a-z0-9_-]+\\.\\w+(\\.\\w+)*>?"
+	:icase t
+	:property *prop-string*)
+    ;; links
+    (syntoken "\\<(http|ftp)://\\S+" :property *prop-string*)
+)
diff --git a/lisp/modules/progmodes/sgml.lsp b/lisp/modules/progmodes/sgml.lsp
new file mode 100644
index 0000000..511aae5
--- /dev/null
+++ b/lisp/modules/progmodes/sgml.lsp
@@ -0,0 +1,428 @@
+;;
+;; Copyright (c) 2002 by The XFree86 Project, Inc.
+;;
+;; Permission is hereby granted, free of charge, to any person obtaining a
+;; copy of this software and associated documentation files (the "Software"),
+;; to deal in the Software without restriction, including without limitation
+;; the rights to use, copy, modify, merge, publish, distribute, sublicense,
+;; and/or sell copies of the Software, and to permit persons to whom the
+;; Software is furnished to do so, subject to the following conditions:
+;;
+;; The above copyright notice and this permission notice shall be included in
+;; all copies or substantial portions of the Software.
+;;
+;; THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
+;; IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
+;; FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT.  IN NO EVENT SHALL
+;; THE XFREE86 PROJECT BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY,
+;; WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF
+;; OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE
+;; SOFTWARE.
+;;
+;; Except as contained in this notice, the name of the XFree86 Project shall
+;; not be used in advertising or otherwise to promote the sale, use or other
+;; dealings in this Software without prior written authorization from the
+;; XFree86 Project.
+;;
+;; Author: Paulo César Pereira de Andrade
+;;
+;;
+;; $XFree86: xc/programs/xedit/lisp/modules/progmodes/sgml.lsp,v 1.2 2002/10/06 17:11:48 paulo Exp $
+;;
+
+(require "syntax")
+(in-package "XEDIT")
+
+;; Default property the text is shown.
+(defsynprop *prop-sgml-default*
+    "default"
+    :font	"-*-helvetica-medium-r-*-*-12-*-*-*-*-*-*-1"
+    :foreground	"Gray10"
+)
+
+(defsynprop *prop-sgml-default-short*
+    "default-short"
+    :font	"-*-helvetica-medium-r-*-*-12-*-*-*-*-*-*-1"
+    :foreground	"Gray10"
+    :underline	t
+)
+
+;; Large font.
+(defsynprop *prop-sgml-sect*
+    "sect"
+    :font	"-*-helvetica-bold-r-*-*-17-*-*-*-*-*-*-1"
+    :foreground	"Gray20"
+)
+
+;; Monospaced property.
+(defsynprop *prop-sgml-tt*
+    "tt"
+    :font	"-*-courier-medium-r-*-*-12-*-*-*-*-*-*-1"
+    :foreground	"Black"
+)
+
+;; Italic property.
+(defsynprop *prop-sgml-it*
+    "it"
+    :font	"-*-helvetica-medium-o-*-*-12-*-*-*-*-*-*-1"
+    :foreground	"Black"
+)
+
+;; Bold font property.
+(defsynprop *prop-sgml-bf*
+    "bf"
+    :font	"-*-helvetica-bold-r-*-*-12-*-*-*-*-*-*-1"
+    :foreground	"Gray10"
+)
+
+;; Looks like a link...
+(defsynprop *prop-sgml-link*
+    "link"
+    :font	"-*-helvetica-medium-r-*-*-12-*-*-*-*-*-*-1"
+    :foreground	"blue"
+    :underline	t
+)
+
+;; Monospaced, also looks like a link...
+(defsynprop *prop-sgml-email*
+    "email"
+    :font	"-*-courier-medium-r-*-*-12-*-*-*-*-*-*-1"
+    :foreground	"blue"
+    :underline	t
+)
+
+;; Another monospaced property,
+(defsynprop *prop-sgml-screen*
+    "screen"
+    :font	"-*-fixed-*-*-*-*-*-*-*-*-*-*-*-1"
+    :foreground	"Gray10"
+)
+
+(defsynprop *prop-sgml-maybe-entity*
+    "maybe-entity"
+    :font	"*lucidatypewriter-medium-r*12*"
+    :foreground	"VioletRed4"
+    :background	"LightYellow"
+)
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;  The macros sgml-syntoken and sgml-syntable allows creating rules for
+;; matching text inside tags in the format:
+;;	<tag> or <tag arg=value> or <tag arg1=value ... argn=value>
+;;		any-text
+;;	</tag>
+;;  The generated rules don't allow things like: < tag> or </tag >
+;;
+;;  This could also be done as a normal definition, with a starting rule like:
+;;	"<(tag1|tag2|tag3)\\>"
+;; and an ending rule like:
+;;	"</(tag1|tag2|tag3)>"
+;;  But is implemented in way that will fail on purpose for things like:
+;;	<tag1>any text</tag3></tag1>
+;;
+;; NOTE: These definitions aren't cheap in the time required to process the
+;;	file, and are just adaptations/tests with the syntax-highlight code,
+;;	probably it is better to avoid using it in other syntax definitions.
+;; NOTE2: It cannot be defined as a single macro because it is required to
+;;	  generate 2 entries in the main SGML syntax highlight definition,
+;;	  or, should generate the entire definition from a macro; you will
+;;	  need to type the tag name twice, but shouldn't be a problem if
+;;	  you are using sgml :-)
+;; XXX: Maybe the syntax-highlight code could save the starting match and
+;;	apply a regex generated at run-time to check for the ending tag,
+;;	but this probably would make the parser too slow, better to have
+;;	a specialized parser if that is required...
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+(defmacro sgml-syntoken (name)
+    `(syntoken (string-concat "<" ,name "\\>")
+	:icase t
+	:contained t
+	:begin (intern (string-concat ,name "$") 'keyword))
+)
+(defmacro sgml-syntable (name property)
+    `(let
+	(
+	(label (intern (string-concat ,name "$") 'keyword))
+	(nested-label (intern (string (gensym)) 'keyword))
+	)
+	(syntable label *prop-preprocessor* nil
+	    ;; tag is still open, process any options
+	    (synaugment :generic-tag)
+	    (syntoken ">"
+		:nospec t
+		:property *prop-preprocessor*
+		:begin nested-label)
+	    ;;	Generate a nested table that includes everything, and only
+	    ;; returns when the closing tag is found.
+	    (syntable nested-label ,property nil
+		(syntoken (string-concat "</" ,name ">")
+		    :icase t
+		    :nospec t
+		    :property *prop-preprocessor*
+		    :switch -2)
+		(synaugment :main)
+	    )
+	)
+    )
+)
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; Generate tokens for tags that don't require and ending tag.
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+(defmacro sgml-syntable-simple (name property)
+    `(let
+	(
+	(label (intern (string-concat ,name "$") 'keyword))
+	(nested-label (intern (string (gensym)) 'keyword))
+	)
+	(syntable label *prop-preprocessor* nil
+	    ;; tag is still open, process any options
+	    (synaugment :generic-tag)
+	    (syntoken ">"
+		:nospec t
+		:property *prop-preprocessor*
+		:begin nested-label)
+	    ;;	Generate a nested table that finishes whenever an unmatched
+	    ;; start or end tag is found.
+	    (syntable nested-label ,property nil
+		(syntoken "</"
+		    :icase t
+		    :nospec t
+		    :contained t
+		    :begin :simple-nested-tag)
+		;;  These will take precedence over other rules
+		(syntoken "<"
+		    :icase t
+		    :nospec t
+		    :contained t
+		    :begin :simple-nested-tag)
+		(syntoken "<p>"
+		    :icase t
+		    :nospec t
+		    :property *prop-preprocessor*
+		    :switch :main)
+		(synaugment :main)
+	    )
+	)
+    )
+)
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; Define some macros to generate tokens for tags in the format:
+;;	<tag/  ... /
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+(defmacro sgml-syntoken-short (name)
+    `(syntoken (string-concat "<" ,name "/")
+	:icase t
+	:property *prop-preprocessor*
+	:begin (intern (string-concat ,name "/") 'keyword))
+)
+(defmacro sgml-syntable-short (name property)
+    `(syntable (intern (string-concat ,name "/") 'keyword) ,property nil
+	(syntoken "/"
+	    :nospec t
+	    :property *prop-preprocessor*
+	    :switch -1)
+	(syntoken "</?\\w+>"
+	    :property *prop-control*
+	    :switch :main)
+    )
+)
+
+
+;; The main SGML syntax table
+(defsyntax *sgml-mode* :main *prop-sgml-default* nil nil
+    ;; Comments
+    (syntoken "<!--"
+	:nospec t
+	:contained t
+	:begin :comment)
+    (syntable :comment *prop-comment* nil
+	;; Only one rule, to finish the comment.
+	(syntoken "-->"
+	    :nospec t
+	    :switch -1)
+    )
+
+    ;; Entities
+    (syntoken "&[a-zA-Z0-9_.-]+;"
+	:property *prop-constant*)
+    ;; Probably an entity, missing ending `;'
+    (syntoken "&[a-zA-Z0-9_.-]+"
+	:property *prop-sgml-maybe-entity*)
+
+    ;; Strings
+    (syntable :string *prop-string* nil
+	;;  Ignore escaped characters.
+	(syntoken "\\\\.")
+	;;  Rule to finish the string.
+	(syntoken "\""
+	    :nospec t
+	    :switch -1)
+    )
+
+    ;; Links
+    (syntable :link *prop-preprocessor* nil
+	;; No link string following "url="
+	(syntoken ">"
+	    :nospec t
+	    :property *prop-control*
+	    :switch -1)
+	(syntoken "\""
+	    :nospec t
+	    :contained t
+	    :begin :link-string)
+	(syntable :link-string *prop-sgml-link* nil
+	    ;; Ignore escaped characters.
+	    (syntoken "\\\\.")
+	    ;; Rule to finish the link, note that returns two levels.
+	    (syntoken "\""
+		:nospec t
+		:switch -2)
+	)
+    )
+
+    ;; "Special" tag
+    (syntoken "<!"
+	:nospec t
+	:contained t
+	:begin :special-tag)
+    ;;  Rules for "special" tags
+    (syntable :special-tag *prop-preprocessor* nil
+	(syntoken "["
+	    :nospec t
+	    :property *prop-preprocessor*
+	    :begin :brackets)
+	;; Finish the "special" tag
+	(syntoken ">"
+	    :nospec t
+	    :switch -1)
+	(syntable :brackets *prop-sgml-default* nil
+	    (syntoken "]"
+		:nospec t
+		:property *prop-preprocessor*
+		:switch -1)
+	    ;; Allow nesting.
+	    (syntoken "["
+		:nospec t
+		:property *prop-preprocessor*
+		:begin :brackets)
+	    ;; Entities.
+	    (syntoken "%[a-zA-Z0-9_.-]+;?"
+		:property *prop-annotation*)
+	    ;;  Allow everything inside the brackets
+	    (synaugment :main)
+	)
+	;; Don't use generic tag tokens, only create a rule for strings
+	(syntoken "\""
+	    :nospec t
+	    :begin :string
+	    :contained t)
+	;; Allow everything inside the "special" tag
+	(synaugment :main)
+    )
+
+    ;; Some "short" tags
+    (sgml-syntoken-short "tt")
+    (sgml-syntable-short "tt" *prop-sgml-tt*)
+    (sgml-syntoken-short "it")
+    (sgml-syntable-short "it" *prop-sgml-it*)
+    (sgml-syntoken-short "bf")
+    (sgml-syntable-short "bf" *prop-sgml-bf*)
+    (sgml-syntoken-short "em")
+    (sgml-syntable-short "em" *prop-sgml-bf*)
+
+    ;; Short tag
+    (syntoken "<\\w+/"
+	:property *prop-preprocessor*
+	:begin :short-tag)
+    (syntable :short-tag *prop-sgml-default-short* nil
+	(syntoken "/"
+	    :nospec t
+	    :property *prop-preprocessor*
+	    :switch -1)
+	(syntoken "</?\\w+>"
+	    :property *prop-control*
+	    :switch -1)
+    )
+
+    ;;  Don't allow spaces, this may and may not be the start of a tag,
+    ;; but the syntax-highlight definition is not specialized...
+    (syntoken "<([^/a-zA-Z]|$)"
+	:property *prop-control*)
+
+    ;; Some tags that require an end tag
+    (sgml-syntoken "tt")
+    (sgml-syntable "tt" *prop-sgml-tt*)
+    (sgml-syntoken "code")
+    (sgml-syntable "code" *prop-sgml-tt*)
+    (sgml-syntoken "tag")
+    (sgml-syntable "tag" *prop-sgml-tt*)
+    (sgml-syntoken "verb")
+    (sgml-syntable "verb" *prop-sgml-tt*)
+    (sgml-syntoken "programlisting")
+    (sgml-syntable "programlisting" *prop-sgml-tt*)
+    (sgml-syntoken "it")
+    (sgml-syntable "it" *prop-sgml-it*)
+    (sgml-syntoken "bf")
+    (sgml-syntable "bf" *prop-sgml-bf*)
+    (sgml-syntoken "em")
+    (sgml-syntable "em" *prop-sgml-bf*)
+    (sgml-syntoken "mail")
+    (sgml-syntable "mail" *prop-sgml-email*)
+    (sgml-syntoken "email")
+    (sgml-syntable "email" *prop-sgml-email*)
+    (sgml-syntoken "screen")
+    (sgml-syntable "screen" *prop-sgml-screen*)
+    (sgml-syntoken "tscreen")
+    (sgml-syntable "tscreen" *prop-sgml-screen*)
+
+
+    ;;  Helper for tags that don't need an ending one.
+    ;;  NOTE: Since the parser is not specialized, if the tag is
+    ;;	      folowed by one that has a special property defined here,
+    ;;	      it may not be detected, i.e. put a <p> after the <sect>
+    ;;	      and it will work.
+    (syntable :simple-nested-tag *prop-preprocessor* nil
+	;; tag is still open, process any options
+	(synaugment :generic-tag)
+	(syntoken ">"
+	    :nospec t
+	    :property *prop-preprocessor*
+	    :switch -3)
+    )
+    (sgml-syntoken "sect")
+    (sgml-syntable-simple "sect" *prop-sgml-sect*)
+    (sgml-syntoken "sect1")
+    (sgml-syntable-simple "sect1" *prop-sgml-sect*)
+    (sgml-syntoken "sect2")
+    (sgml-syntable-simple "sect2" *prop-sgml-sect*)
+
+    ;; Generic tags
+    (syntoken "<"
+	:nospec t
+	:contained t
+	:begin :tag)
+    ;; Table :generic-tag is defined to be augmented, no rule to finish it.
+    (syntable :generic-tag *prop-preprocessor* nil
+	;; Start string
+	(syntoken "\""
+	    :nospec t
+	    :begin :string
+	    :contained t)
+	;; Start url link
+	(syntoken "url="
+	    :nospec t
+	    :begin :link)
+	;; Cannot nest
+	(syntoken "<"
+	    :nospec t
+	    :property *prop-control*)
+    )
+    (syntable :tag *prop-preprocessor* nil
+	;; Finish the tag
+	(syntoken ">"
+	    :nospec t
+	    :switch -1)
+	;; Import generic definitions
+	(synaugment :generic-tag)
+    )
+)
diff --git a/lisp/modules/progmodes/sh.lsp b/lisp/modules/progmodes/sh.lsp
new file mode 100644
index 0000000..79679ed
--- /dev/null
+++ b/lisp/modules/progmodes/sh.lsp
@@ -0,0 +1,113 @@
+;;
+;; Copyright (c) 2003 by The XFree86 Project, Inc.
+;;
+;; Permission is hereby granted, free of charge, to any person obtaining a
+;; copy of this software and associated documentation files (the "Software"),
+;; to deal in the Software without restriction, including without limitation
+;; the rights to use, copy, modify, merge, publish, distribute, sublicense,
+;; and/or sell copies of the Software, and to permit persons to whom the
+;; Software is furnished to do so, subject to the following conditions:
+;;
+;; The above copyright notice and this permission notice shall be included in
+;; all copies or substantial portions of the Software.
+;;
+;; THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
+;; IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
+;; FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT.  IN NO EVENT SHALL
+;; THE XFREE86 PROJECT BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY,
+;; WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF
+;; OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE
+;; SOFTWARE.
+;;
+;; Except as contained in this notice, the name of the XFree86 Project shall
+;; not be used in advertising or otherwise to promote the sale, use or other
+;; dealings in this Software without prior written authorization from the
+;; XFree86 Project.
+;;
+;; Author: Paulo César Pereira de Andrade
+;;
+;;
+;; $XFree86: xc/programs/xedit/lisp/modules/progmodes/sh.lsp,v 1.1 2003/01/16 03:50:46 paulo Exp $
+;;
+
+(require "syntax")
+(require "indent")
+(in-package "XEDIT")
+
+(defsynprop *prop-escape*
+    "escape"
+    :font	"*lucidatypewriter-medium-r*12*"
+    :foreground	"Red3")
+
+(defsynprop *prop-variable*
+    "variable"
+    :font	"*lucidatypewriter-medium-r*12*"
+    :foreground	"Gold4")
+
+(defsynprop *prop-backslash*
+    "backslash"
+    :font	"*courier-bold-r*12*"
+    :foreground	"green4")
+
+;; XXX it would be interesting if "here-documents" could be parsed
+;; just searching for "<<\s*EOF\\>" and then for "^EOF\\>" should
+;; handle most cases, but would be a hack...
+(defsyntax *sh-mode* :main nil #'default-indent nil
+    ;; keywords and common commands/builtins
+    (syntoken "\\<(if|then|elif|else|fi|case|in|esac|for|do|done|while|until|break|continue|eval|exit|exec|test|echo|cd|shift|local|return)\\>"
+	:property *prop-keyword*)
+
+    ; comments
+    (syntoken "#.*$" :property *prop-comment*)
+
+    ;; punctuation
+    (syntoken "[][;:*?(){}<>&!|$#]+" :property *prop-punctuation*)
+
+    ;; variable declaration
+    (syntoken "\\w+=" :property *prop-preprocessor*)
+
+    ;; numbers
+    (syntoken "\\<\\d+\\>" :property *prop-number*)
+
+    ;; escaped characters at toplevel
+    (syntoken "\\\\." :property *prop-backslash*)
+
+    ;; single quote
+    (syntoken "'" :nospec t :contained t :begin :single)
+    (syntable :single *prop-constant* nil
+	;; do nothing, escaped characters
+	(syntoken "\\\\.")
+	(syntoken "'" :nospec t :switch -1)
+    )
+
+    ;; double quote
+    (syntoken "\"" :nospec t :contained t :begin :double)
+    (syntable :double *prop-string* #'default-indent
+	;; escaped characters
+	(syntoken "\\\\." :property *prop-backslash*)
+	(syntoken "\"" :nospec t :switch -1)
+	;; rule to start escape
+	(syntoken "`" :nospec t :contained t :begin :escape)
+	;; ignore single quote, required because escape is augmented
+	(syntoken "'" :nospec t)
+	(synaugment :escape :variable)
+    )
+
+    ;; escaped commands
+    (syntoken "`" :nospec t :contained t :begin :escape)
+    (syntable :escape *prop-escape* #'default-indent
+	;; escaped characters
+	(syntoken "\\\\." :property *prop-backslash*)
+	(syntoken "`" :nospec t :switch -1)
+	;; rule to start double quote inside escape
+	(syntoken "\"" :nospec t :contained t :begin :double)
+	;; rule to start single quote
+	(syntoken "'" :nospec t :contained t :begin :single)
+	(synaugment :double :variable)
+    )
+
+    (syntable :variable nil nil
+	(syntoken "\\$\\w+" :property *prop-variable*)
+    )
+    (synaugment :variable)
+)
diff --git a/lisp/modules/progmodes/xconf.lsp b/lisp/modules/progmodes/xconf.lsp
new file mode 100644
index 0000000..dea70a2
--- /dev/null
+++ b/lisp/modules/progmodes/xconf.lsp
@@ -0,0 +1,68 @@
+;;
+;; Copyright (c) 2003 by The XFree86 Project, Inc.
+;;
+;; Permission is hereby granted, free of charge, to any person obtaining a
+;; copy of this software and associated documentation files (the "Software"),
+;; to deal in the Software without restriction, including without limitation
+;; the rights to use, copy, modify, merge, publish, distribute, sublicense,
+;; and/or sell copies of the Software, and to permit persons to whom the
+;; Software is furnished to do so, subject to the following conditions:
+;;
+;; The above copyright notice and this permission notice shall be included in
+;; all copies or substantial portions of the Software.
+;;
+;; THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
+;; IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
+;; FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT.  IN NO EVENT SHALL
+;; THE XFREE86 PROJECT BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY,
+;; WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF
+;; OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE
+;; SOFTWARE.
+;;
+;; Except as contained in this notice, the name of the XFree86 Project shall
+;; not be used in advertising or otherwise to promote the sale, use or other
+;; dealings in this Software without prior written authorization from the
+;; XFree86 Project.
+;;
+;; Author: Paulo César Pereira de Andrade
+;;
+;;
+;; $XFree86: xc/programs/xedit/lisp/modules/progmodes/xconf.lsp,v 1.1 2003/01/16 03:50:46 paulo Exp $
+;;
+
+(require "syntax")
+(require "indent")
+(in-package "XEDIT")
+
+(defsyntax *xconf-mode* :main nil #'default-indent nil
+    ;; section start
+    (syntoken "\\<(Section|SubSection)\\>"
+	:property *prop-keyword* :icase t :begin :section)
+    ;; just for fun, highlight the section name differently
+    (syntable :section *prop-constant* #'default-indent
+	(syntoken "\"" :nospec t :begin :name)
+	(syntable :name *prop-constant* nil
+	    ;; ignore escaped characters
+	    (syntoken "\\\\.")
+	    (syntoken "\"" :nospec t :switch -2)
+	)
+    )
+
+    ;; section end
+    (syntoken "\\<(EndSection|EndSubSection)\\>"
+	:property *prop-keyword* :icase t)
+
+    ;; numeric options
+    (syntoken "\\<\\d+(\\.\\d+)?\\>" :property *prop-number*)
+
+    ;; comments
+    (syntoken "#.*$" :property *prop-comment*)
+
+    ;; strings
+    (syntoken "\"" :nospec t :begin :string :contained t)
+    (syntable :string *prop-string* #'default-indent
+	;; ignore escaped characters
+	(syntoken "\\\\.")
+	(syntoken "\"" :nospec t :switch -1)
+    )
+)
diff --git a/lisp/modules/progmodes/xlog.lsp b/lisp/modules/progmodes/xlog.lsp
new file mode 100644
index 0000000..6bc8b57
--- /dev/null
+++ b/lisp/modules/progmodes/xlog.lsp
@@ -0,0 +1,102 @@
+;;
+;; Copyright (c) 2003 by The XFree86 Project, Inc.
+;;
+;; Permission is hereby granted, free of charge, to any person obtaining a
+;; copy of this software and associated documentation files (the "Software"),
+;; to deal in the Software without restriction, including without limitation
+;; the rights to use, copy, modify, merge, publish, distribute, sublicense,
+;; and/or sell copies of the Software, and to permit persons to whom the
+;; Software is furnished to do so, subject to the following conditions:
+;;
+;; The above copyright notice and this permission notice shall be included in
+;; all copies or substantial portions of the Software.
+;;
+;; THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
+;; IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
+;; FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT.  IN NO EVENT SHALL
+;; THE XFREE86 PROJECT BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY,
+;; WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF
+;; OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE
+;; SOFTWARE.
+;;
+;; Except as contained in this notice, the name of the XFree86 Project shall
+;; not be used in advertising or otherwise to promote the sale, use or other
+;; dealings in this Software without prior written authorization from the
+;; XFree86 Project.
+;;
+;; Author: Paulo César Pereira de Andrade
+;;
+;;
+;; $XFree86: xc/programs/xedit/lisp/modules/progmodes/xlog.lsp,v 1.1 2003/01/16 06:25:51 paulo Exp $
+;;
+
+(require "syntax")
+(in-package "XEDIT")
+
+(defsynprop *prop-xlog-probe*
+    "xlog-probe"
+    :font	"*courier-medium-r*12*"
+    :background	"rgb:c/f/c")
+
+(defsynprop *prop-xlog-config*
+    "xlog-config"
+    :font	"*courier-medium-r*12*"
+    :background	"rgb:c/e/f")
+
+(defsynprop *prop-xlog-default*
+    "xlog-default"
+    :font	"*courier-medium-r*12*"
+    :background	"rgb:e/c/f")
+
+(defsynprop *prop-xlog-warning*
+    "xlog-warning"
+    :font	"*courier-bold-r*12*"
+    :foreground	"Red4"
+    :background	"Yellow1"
+)
+
+(defsynprop *prop-xlog-error*
+    "xlog-error"
+    :font	"*courier-bold-r*12*"
+    :foreground	"Yellow2"
+    :background	"Red3"
+)
+
+(defsyntax *xlog-mode* :main nil nil nil
+    ;; highlight version
+    (syntoken "^XFree86 Version \\S+" :property *prop-annotation*)
+
+    ;; release date
+    (syntoken "^Release Date: " :property *prop-keyword* :begin :note)
+
+    ;; highlight operating system description
+    (syntoken "^Build Operating System: " :property *prop-keyword* :begin :note)
+
+    (syntable :note *prop-annotation* nil (syntoken "$" :switch -1))
+
+    ;; don't highlight info lines
+    (syntoken "^\\(II\\) " :property *prop-keyword*)
+
+    ;; default lines
+    (syntoken "^\\(==\\) " :property *prop-keyword* :begin :default)
+    (syntable :default *prop-xlog-default* nil (syntoken "$" :switch -1))
+
+    ;; probe lines
+    (syntoken "^\\(--\\) " :property *prop-keyword* :begin :probe)
+    (syntable :probe *prop-xlog-probe* nil (syntoken "$" :switch -1))
+
+    ;; config lines
+    (syntoken "^\\(\\*\\*\\) " :property *prop-keyword* :begin :config)
+    (syntable :config *prop-xlog-config* nil (syntoken "$" :switch -1))
+
+    ;; warnings
+    (syntoken "^\\(WW\\) " :property *prop-keyword* :begin :warning)
+    (syntable :warning *prop-xlog-warning* nil (syntoken "$" :switch -1))
+
+    ;; errors
+    (syntoken "^\\(EE\\) " :property *prop-keyword* :begin :error)
+    (syntable :error *prop-xlog-error* nil (syntoken "$" :switch -1))
+
+    ;; command line and "uncommon" messages
+    (syntoken "^\\(..\\) " :property *prop-control* :begin :warning)
+)
diff --git a/lisp/modules/progmodes/xrdb.lsp b/lisp/modules/progmodes/xrdb.lsp
new file mode 100644
index 0000000..c0a099c
--- /dev/null
+++ b/lisp/modules/progmodes/xrdb.lsp
@@ -0,0 +1,115 @@
+;;
+;; Copyright (c) 2002 by The XFree86 Project, Inc.
+;;
+;; Permission is hereby granted, free of charge, to any person obtaining a
+;; copy of this software and associated documentation files (the "Software"),
+;; to deal in the Software without restriction, including without limitation
+;; the rights to use, copy, modify, merge, publish, distribute, sublicense,
+;; and/or sell copies of the Software, and to permit persons to whom the
+;; Software is furnished to do so, subject to the following conditions:
+;;
+;; The above copyright notice and this permission notice shall be included in
+;; all copies or substantial portions of the Software.
+;;
+;; THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
+;; IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
+;; FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT.  IN NO EVENT SHALL
+;; THE XFREE86 PROJECT BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY,
+;; WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF
+;; OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE
+;; SOFTWARE.
+;;
+;; Except as contained in this notice, the name of the XFree86 Project shall
+;; not be used in advertising or otherwise to promote the sale, use or other
+;; dealings in this Software without prior written authorization from the
+;; XFree86 Project.
+;;
+;; Author: Paulo César Pereira de Andrade
+;;
+;;
+;; $XFree86: xc/programs/xedit/lisp/modules/progmodes/xrdb.lsp,v 1.2 2002/10/06 17:11:48 paulo Exp $
+;;
+
+(require "syntax")
+(in-package "XEDIT")
+
+(defsynprop *prop-xrdb-comment*
+    "xrdb-comment"
+    :font	"*courier-medium-o*12*"
+    :foreground	"sienna"
+)
+
+(defsynprop *prop-xrdb-special*
+    "format"
+    :font	"*lucidatypewriter-medium-r*12*"
+    :foreground	"RoyalBlue4"
+)
+
+(defsynprop *prop-xrdb-punctuation*
+    "punctuation"
+    :font	"-*-courier-bold-r-*-*-14-*-*-*-*-*-*-1"
+    :foreground	"OrangeRed4"
+)
+
+(defsyntax *xrdb-mode* :main nil nil nil
+    (syntoken "^\\s*!.*"
+	:property *prop-xrdb-comment*)
+    (syntoken "^\\s*#.*"
+	:property *prop-preprocessor*)
+    (syntoken "\\*|\\.|\\?"
+	:property *prop-xrdb-punctuation*
+	:begin :resource)
+    (syntoken "."
+	:nospec t
+	:begin :resource)
+
+    ;; Extra comments
+    (syntoken "/*" :nospec t :begin :comment :contained t)
+    (syntable :comment *prop-comment* nil
+	(syntoken "/*" :nospec t :property *prop-error*)
+	;;  Rule to finish a comment.
+	(syntoken "*/" :nospec t :switch -1)
+    )
+
+    (syntable :resource nil nil
+	(syntoken "\\*|\\.|\\?" :property *prop-xrdb-punctuation*)
+	(syntoken ":\\s*" :property *prop-xrdb-punctuation* :begin :value)
+    )
+
+    (syntable :value *prop-string* nil
+	(syntoken "\\\\$" :property *prop-constant*)
+
+
+	;; If the pattern ends at a newline, must switch to the previous state.
+	;; Not sure yet how to better handle this. The parser does not detect
+	;; eol because it is a match to the empty string. A possible hack
+	;; would be to check if the pattern string ends in a "$", but probably
+	;; better in this case to have a syntoken option, to tell the parser
+	;; an eol may exist.
+	(syntoken
+	    (string-concat
+		"("
+		"\\d+|"				;; numbers
+		"(#\\x+|rgb:\\x+/\\x+/\\x+)|"	;; color spec
+		"#\\w+"				;; translation table
+		")$")
+	    :property *prop-xrdb-special* :switch -2)
+	(syntoken "(\\\\n?|\")$"
+	    :property *prop-constant* :switch -2)
+
+	;; XXX Cut&paste of the above, only without the match to eol
+	(syntoken
+	    (string-concat
+		"("
+		"\\d+|"
+		"(#\\x+|rgb:\\x+/\\x+/\\x+)|"
+		"#\\w+"
+		")")
+	    :property *prop-xrdb-special*)
+	(syntoken "(\\\\n?|\")"
+	    :property *prop-constant*)
+
+	(syntoken "/*" :nospec t :begin :comment :contained t)
+	(syntoken ".?$" :switch -2)
+    )
+)
diff --git a/lisp/modules/psql.c b/lisp/modules/psql.c
new file mode 100644
index 0000000..6945947
--- /dev/null
+++ b/lisp/modules/psql.c
@@ -0,0 +1,983 @@
+/*
+ * Copyright (c) 2001 by The XFree86 Project, Inc.
+ *
+ * Permission is hereby granted, free of charge, to any person obtaining a
+ * copy of this software and associated documentation files (the "Software"),
+ * to deal in the Software without restriction, including without limitation
+ * the rights to use, copy, modify, merge, publish, distribute, sublicense,
+ * and/or sell copies of the Software, and to permit persons to whom the
+ * Software is furnished to do so, subject to the following conditions:
+ *
+ * The above copyright notice and this permission notice shall be included in
+ * all copies or substantial portions of the Software.
+ *  
+ * THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
+ * IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
+ * FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT.  IN NO EVENT SHALL
+ * THE XFREE86 PROJECT BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY,
+ * WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF
+ * OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE
+ * SOFTWARE.
+ *
+ * Except as contained in this notice, the name of the XFree86 Project shall
+ * not be used in advertising or otherwise to promote the sale, use or other
+ * dealings in this Software without prior written authorization from the
+ * XFree86 Project.
+ *
+ * Author: Paulo César Pereira de Andrade
+ */
+
+/* $XFree86: xc/programs/xedit/lisp/modules/psql.c,v 1.12 2002/11/23 08:26:52 paulo Exp $ */
+
+#include <stdlib.h>
+#include <libpq-fe.h>
+#undef USE_SSL		/* cannot get it to compile... */
+#include <postgres.h>
+#include <utils/geo_decls.h>
+#include "internal.h"
+#include "private.h"
+
+/*
+ * Prototypes
+ */
+int psqlLoadModule(void);
+
+LispObj *Lisp_PQbackendPID(LispBuiltin*);
+LispObj *Lisp_PQclear(LispBuiltin*);
+LispObj *Lisp_PQconsumeInput(LispBuiltin*);
+LispObj *Lisp_PQdb(LispBuiltin*);
+LispObj *Lisp_PQerrorMessage(LispBuiltin*);
+LispObj *Lisp_PQexec(LispBuiltin*);
+LispObj *Lisp_PQfinish(LispBuiltin*);
+LispObj *Lisp_PQfname(LispBuiltin*);
+LispObj *Lisp_PQfnumber(LispBuiltin*);
+LispObj *Lisp_PQfsize(LispBuiltin*);
+LispObj *Lisp_PQftype(LispBuiltin*);
+LispObj *Lisp_PQgetlength(LispBuiltin*);
+LispObj *Lisp_PQgetvalue(LispBuiltin*);
+LispObj *Lisp_PQhost(LispBuiltin*);
+LispObj *Lisp_PQnfields(LispBuiltin*);
+LispObj *Lisp_PQnotifies(LispBuiltin*);
+LispObj *Lisp_PQntuples(LispBuiltin*);
+LispObj *Lisp_PQoptions(LispBuiltin*);
+LispObj *Lisp_PQpass(LispBuiltin*);
+LispObj *Lisp_PQport(LispBuiltin*);
+LispObj *Lisp_PQresultStatus(LispBuiltin*);
+LispObj *Lisp_PQsetdb(LispBuiltin*);
+LispObj *Lisp_PQsetdbLogin(LispBuiltin*);
+LispObj *Lisp_PQsocket(LispBuiltin*);
+LispObj *Lisp_PQstatus(LispBuiltin*);
+LispObj *Lisp_PQtty(LispBuiltin*);
+LispObj *Lisp_PQuser(LispBuiltin*);
+
+/*
+ * Initialization
+ */
+static LispBuiltin lispbuiltins[] = {
+    {LispFunction, Lisp_PQbackendPID, "pq-backend-pid connection"},
+    {LispFunction, Lisp_PQclear, "pq-clear result"},
+    {LispFunction, Lisp_PQconsumeInput, "pq-consume-input connection"},
+    {LispFunction, Lisp_PQdb, "pq-db connection"},
+    {LispFunction, Lisp_PQerrorMessage, "pq-error-message connection"},
+    {LispFunction, Lisp_PQexec, "pq-exec connection query"},
+    {LispFunction, Lisp_PQfinish, "pq-finish connection"},
+    {LispFunction, Lisp_PQfname, "pq-fname result field-number"},
+    {LispFunction, Lisp_PQfnumber, "pq-fnumber result field-name"},
+    {LispFunction, Lisp_PQfsize, "pq-fsize result field-number"},
+    {LispFunction, Lisp_PQftype, "pq-ftype result field-number"},
+    {LispFunction, Lisp_PQgetlength, "pq-getlength result tupple field-number"},
+    {LispFunction, Lisp_PQgetvalue, "pq-getvalue result tupple field-number &optional type"},
+    {LispFunction, Lisp_PQhost, "pq-host connection"},
+    {LispFunction, Lisp_PQnfields, "pq-nfields result"},
+    {LispFunction, Lisp_PQnotifies, "pq-notifies connection"},
+    {LispFunction, Lisp_PQntuples, "pq-ntuples result"},
+    {LispFunction, Lisp_PQoptions, "pq-options connection"},
+    {LispFunction, Lisp_PQpass, "pq-pass connection"},
+    {LispFunction, Lisp_PQport, "pq-port connection"},
+    {LispFunction, Lisp_PQresultStatus, "pq-result-status result"},
+    {LispFunction, Lisp_PQsetdb, "pq-setdb host port options tty dbname"},
+    {LispFunction, Lisp_PQsetdbLogin, "pq-setdb-login host port options tty dbname login password"},
+    {LispFunction, Lisp_PQsocket, "pq-socket connection"},
+    {LispFunction, Lisp_PQstatus, "pq-status connection"},
+    {LispFunction, Lisp_PQtty, "pq-tty connection"},
+    {LispFunction, Lisp_PQuser, "pq-user connection"},
+};
+
+LispModuleData psqlLispModuleData = {
+    LISP_MODULE_VERSION,
+    psqlLoadModule
+};
+
+static int PGconn_t, PGresult_t;
+
+/*
+ * Implementation
+ */
+int
+psqlLoadModule(void)
+{
+    int i;
+    char *fname = "PSQL-LOAD-MODULE";
+
+    PGconn_t = LispRegisterOpaqueType("PGconn*");
+    PGresult_t = LispRegisterOpaqueType("PGresult*");
+
+    GCDisable();
+    /* NOTE: Implemented just enough to make programming examples
+     * (and my needs) work.
+     * Completing this is an exercise to the reader, or may be implemented
+     * when/if required.
+     */
+    LispExecute("(DEFSTRUCT PG-NOTIFY RELNAME BE-PID)\n"
+		"(DEFSTRUCT PG-POINT X Y)\n"
+		"(DEFSTRUCT PG-BOX HIGH LOW)\n"
+		"(DEFSTRUCT PG-POLYGON SIZE NUM-POINTS BOUNDBOX POINTS)\n");
+
+    /* enum ConnStatusType */
+    (void)LispSetVariable(ATOM2("PG-CONNECTION-OK"),
+			  REAL(CONNECTION_OK), fname, 0);
+    (void)LispSetVariable(ATOM2("PG-CONNECTION-BAD"),
+			  REAL(CONNECTION_BAD), fname, 0);
+    (void)LispSetVariable(ATOM2("PG-CONNECTION-STARTED"),
+			  REAL(CONNECTION_STARTED), fname, 0);
+    (void)LispSetVariable(ATOM2("PG-CONNECTION-MADE"),
+			  REAL(CONNECTION_MADE), fname, 0);
+    (void)LispSetVariable(ATOM2("PG-CONNECTION-AWAITING-RESPONSE"),
+			  REAL(CONNECTION_AWAITING_RESPONSE), fname, 0);
+    (void)LispSetVariable(ATOM2("PG-CONNECTION-AUTH-OK"),
+			  REAL(CONNECTION_AUTH_OK), fname, 0);
+    (void)LispSetVariable(ATOM2("PG-CONNECTION-SETENV"),
+			  REAL(CONNECTION_SETENV), fname, 0);
+
+
+    /* enum ExecStatusType */
+    (void)LispSetVariable(ATOM2("PGRES-EMPTY-QUERY"),
+			  REAL(PGRES_EMPTY_QUERY), fname, 0);
+    (void)LispSetVariable(ATOM2("PGRES-COMMAND-OK"),
+			  REAL(PGRES_COMMAND_OK), fname, 0);
+    (void)LispSetVariable(ATOM2("PGRES-TUPLES-OK"),
+			  REAL(PGRES_TUPLES_OK), fname, 0);
+    (void)LispSetVariable(ATOM2("PGRES-COPY-OUT"),
+			  REAL(PGRES_COPY_OUT), fname, 0);
+    (void)LispSetVariable(ATOM2("PGRES-COPY-IN"),
+			  REAL(PGRES_COPY_IN), fname, 0);
+    (void)LispSetVariable(ATOM2("PGRES-BAD-RESPONSE"),
+			  REAL(PGRES_BAD_RESPONSE), fname, 0);
+    (void)LispSetVariable(ATOM2("PGRES-NONFATAL-ERROR"),
+			  REAL(PGRES_NONFATAL_ERROR), fname, 0);
+    (void)LispSetVariable(ATOM2("PGRES-FATAL-ERROR"),
+			  REAL(PGRES_FATAL_ERROR), fname, 0);
+    GCEnable();
+
+    for (i = 0; i < sizeof(lispbuiltins) / sizeof(lispbuiltins[0]); i++)
+	LispAddBuiltinFunction(&lispbuiltins[i]);
+
+    return (1);
+}
+
+LispObj *
+Lisp_PQbackendPID(LispBuiltin *builtin)
+/*
+ pq-backend-pid connection
+ */
+{
+    int pid;
+    PGconn *conn;
+
+    LispObj *connection;
+
+    connection = ARGUMENT(0);
+
+    if (!CHECKO(connection, PGconn_t))
+	LispDestroy("%s: cannot convert %s to PGconn*",
+		    STRFUN(builtin), STROBJ(connection));
+    conn = (PGconn*)(connection->data.opaque.data);
+
+    pid = PQbackendPID(conn);
+
+    return (INTEGER(pid));
+}
+
+LispObj *
+Lisp_PQclear(LispBuiltin *builtin)
+/*
+ pq-clear result
+ */
+{
+    PGresult *res;
+
+    LispObj *result;
+
+    result = ARGUMENT(0);
+
+    if (!CHECKO(result, PGresult_t))
+	LispDestroy("%s: cannot convert %s to PGresult*",
+		    STRFUN(builtin), STROBJ(result));
+    res = (PGresult*)(result->data.opaque.data);
+
+    PQclear(res);
+
+    return (NIL);
+}
+
+LispObj *
+Lisp_PQconsumeInput(LispBuiltin *builtin)
+/*
+ pq-consume-input connection
+ */
+{
+    int result;
+    PGconn *conn;
+
+    LispObj *connection;
+
+    connection = ARGUMENT(0);
+
+    if (!CHECKO(connection, PGconn_t))
+	LispDestroy("%s: cannot convert %s to PGconn*",
+		    STRFUN(builtin), STROBJ(connection));
+    conn = (PGconn*)(connection->data.opaque.data);
+
+    result = PQconsumeInput(conn);
+
+    return (INTEGER(result));
+}
+
+LispObj *
+Lisp_PQdb(LispBuiltin *builtin)
+/*
+ pq-db connection
+ */
+{
+    char *string;
+    PGconn *conn;
+
+    LispObj *connection;
+
+    connection = ARGUMENT(0);
+
+    if (!CHECKO(connection, PGconn_t))
+	LispDestroy("%s: cannot convert %s to PGconn*",
+		    STRFUN(builtin), STROBJ(connection));
+    conn = (PGconn*)(connection->data.opaque.data);
+
+    string = PQdb(conn);
+
+    return (string ? STRING(string) : NIL);
+}
+
+LispObj *
+Lisp_PQerrorMessage(LispBuiltin *builtin)
+{
+    char *string;
+    PGconn *conn;
+
+    LispObj *connection;
+
+    connection = ARGUMENT(0);
+
+    if (!CHECKO(connection, PGconn_t))
+	LispDestroy("%s: cannot convert %s to PGconn*",
+		    STRFUN(builtin), STROBJ(connection));
+    conn = (PGconn*)(connection->data.opaque.data);
+
+    string = PQerrorMessage(conn);
+
+    return (string ? STRING(string) : NIL);
+}
+
+LispObj *
+Lisp_PQexec(LispBuiltin *builtin)
+/*
+ pq-exec connection query
+ */
+{
+    PGconn *conn;
+    PGresult *res;
+
+    LispObj *connection, *query;
+
+    query = ARGUMENT(1);
+    connection = ARGUMENT(0);
+
+    if (!CHECKO(connection, PGconn_t))
+	LispDestroy("%s: cannot convert %s to PGconn*",
+		    STRFUN(builtin), STROBJ(connection));
+    conn = (PGconn*)(connection->data.opaque.data);
+
+    CHECK_STRING(query);
+    res = PQexec(conn, THESTR(query));
+
+    return (res ? OPAQUE(res, PGresult_t) : NIL);
+}
+
+LispObj *
+Lisp_PQfinish(LispBuiltin *builtin)
+/*
+ pq-finish connection
+ */
+{
+    PGconn *conn;
+
+    LispObj *connection;
+
+    connection = ARGUMENT(0);
+
+    if (!CHECKO(connection, PGconn_t))
+	LispDestroy("%s: cannot convert %s to PGconn*",
+		    STRFUN(builtin), STROBJ(connection));
+    conn = (PGconn*)(connection->data.opaque.data);
+
+    PQfinish(conn);
+
+    return (NIL);
+}
+
+LispObj *
+Lisp_PQfname(LispBuiltin *builtin)
+/*
+ pq-fname result field-number
+ */
+{
+    char *string;
+    int field;
+    PGresult *res;
+
+    LispObj *result, *field_number;
+
+    field_number = ARGUMENT(1);
+    result = ARGUMENT(0);
+
+    if (!CHECKO(result, PGresult_t))
+	LispDestroy("%s: cannot convert %s to PGresult*",
+		    STRFUN(builtin), STROBJ(result));
+    res = (PGresult*)(result->data.opaque.data);
+
+    CHECK_INDEX(field_number);
+    field = FIXNUM_VALUE(field_number);
+
+    string = PQfname(res, field);
+
+    return (string ? STRING(string) : NIL);
+}
+
+LispObj *
+Lisp_PQfnumber(LispBuiltin *builtin)
+/*
+ pq-fnumber result field-name
+ */
+{
+    int number;
+    int field;
+    PGresult *res;
+
+    LispObj *result, *field_name;
+
+    field_name = ARGUMENT(1);
+    result = ARGUMENT(0);
+
+    if (!CHECKO(result, PGresult_t))
+	LispDestroy("%s: cannot convert %s to PGresult*",
+		    STRFUN(builtin), STROBJ(result));
+    res = (PGresult*)(result->data.opaque.data);
+
+    CHECK_STRING(field_name);
+    number = PQfnumber(res, THESTR(field_name));
+
+    return (INTEGER(number));
+}
+
+LispObj *
+Lisp_PQfsize(LispBuiltin *builtin)
+/*
+ pq-fsize result field-number
+ */
+{
+    int size, field;
+    PGresult *res;
+
+    LispObj *result, *field_number;
+
+    field_number = ARGUMENT(1);
+    result = ARGUMENT(0);
+
+    if (!CHECKO(result, PGresult_t))
+	LispDestroy("%s: cannot convert %s to PGresult*",
+		    STRFUN(builtin), STROBJ(result));
+    res = (PGresult*)(result->data.opaque.data);
+
+    CHECK_INDEX(field_number);
+    field = FIXNUM_VALUE(field_number);
+
+    size = PQfsize(res, field);
+
+    return (INTEGER(size));
+}
+
+LispObj *
+Lisp_PQftype(LispBuiltin *builtin)
+{
+    Oid oid;
+    int field;
+    PGresult *res;
+
+    LispObj *result, *field_number;
+
+    field_number = ARGUMENT(1);
+    result = ARGUMENT(0);
+
+    if (!CHECKO(result, PGresult_t))
+	LispDestroy("%s: cannot convert %s to PGresult*",
+		    STRFUN(builtin), STROBJ(result));
+    res = (PGresult*)(result->data.opaque.data);
+
+    CHECK_INDEX(field_number);
+    field = FIXNUM_VALUE(field_number);
+
+    oid = PQftype(res, field);
+
+    return (INTEGER(oid));
+}
+
+LispObj *
+Lisp_PQgetlength(LispBuiltin *builtin)
+/*
+ pq-getlength result tupple field-number
+ */
+{
+    PGresult *res;
+    int tuple, field, length;
+
+    LispObj *result, *otupple, *field_number;
+
+    field_number = ARGUMENT(2);
+    otupple = ARGUMENT(1);
+    result = ARGUMENT(0);
+
+    if (!CHECKO(result, PGresult_t))
+	LispDestroy("%s: cannot convert %s to PGresult*",
+		    STRFUN(builtin), STROBJ(result));
+    res = (PGresult*)(result->data.opaque.data);
+
+    CHECK_INDEX(otupple);
+    tuple = FIXNUM_VALUE(otupple);
+
+    CHECK_INDEX(field_number);
+    field = FIXNUM_VALUE(field_number);
+
+    length = PQgetlength(res, tuple, field);
+
+    return (INTEGER(length));
+}
+
+LispObj *
+Lisp_PQgetvalue(LispBuiltin *builtin)
+/*
+ pq-getvalue result tuple field &optional type-specifier
+ */
+{
+    char *string;
+    double real = 0.0;
+    PGresult *res;
+    int tuple, field, isint = 0, isreal = 0, integer;
+
+    LispObj *result, *otupple, *field_number, *type;
+
+    type = ARGUMENT(3);
+    field_number = ARGUMENT(2);
+    otupple = ARGUMENT(1);
+    result = ARGUMENT(0);
+
+    if (!CHECKO(result, PGresult_t))
+	LispDestroy("%s: cannot convert %s to PGresult*",
+		    STRFUN(builtin), STROBJ(result));
+    res = (PGresult*)(result->data.opaque.data);
+
+    CHECK_INDEX(otupple);
+    tuple = FIXNUM_VALUE(otupple);
+
+    CHECK_INDEX(field_number);
+    field = FIXNUM_VALUE(field_number);
+
+    string = PQgetvalue(res, tuple, field);
+
+    if (type != UNSPEC) {
+	char *typestring;
+
+	CHECK_SYMBOL(type);
+	typestring = ATOMID(type);
+
+	if (strcmp(typestring, "INT16") == 0) {
+	    integer = *(short*)string;
+	    isint = 1;
+	    goto simple_type;
+	}
+	else if (strcmp(typestring, "INT32") == 0) {
+	    integer = *(int*)string;
+	    isint = 1;
+	    goto simple_type;
+	}
+	else if (strcmp(typestring, "FLOAT") == 0) {
+	    real = *(float*)string;
+	    isreal = 1;
+	    goto simple_type;
+	}
+	else if (strcmp(typestring, "REAL") == 0) {
+	    real = *(double*)string;
+	    isreal = 1;
+	    goto simple_type;
+	}
+	else if (strcmp(typestring, "PG-POLYGON") == 0)
+	    goto polygon_type;
+	else if (strcmp(typestring, "STRING") != 0)
+	    LispDestroy("%s: unknown type %s",
+			STRFUN(builtin), typestring);
+    }
+
+simple_type:
+    return (isint ? INTEGER(integer) : isreal ? DFLOAT(real) :
+	    (string ? STRING(string) : NIL));
+
+polygon_type:
+  {
+    LispObj *poly, *box, *p = NIL, *cdr, *obj;
+    POLYGON *polygon;
+    int i, size;
+
+    size = PQgetlength(res, tuple, field);
+    polygon = (POLYGON*)(string - sizeof(int));
+
+    GCDisable();
+    /* get polygon->boundbox */
+    cdr = EVAL(CONS(ATOM("MAKE-PG-POINT"),
+		    CONS(KEYWORD("X"),
+			 CONS(REAL(polygon->boundbox.high.x),
+			      CONS(KEYWORD("Y"),
+				   CONS(REAL(polygon->boundbox.high.y), NIL))))));
+    obj = EVAL(CONS(ATOM("MAKE-PG-POINT"),
+		    CONS(KEYWORD("X"),
+			 CONS(REAL(polygon->boundbox.low.x),
+			      CONS(KEYWORD("Y"),
+				   CONS(REAL(polygon->boundbox.low.y), NIL))))));
+    box = EVAL(CONS(ATOM("MAKE-PG-BOX"),
+		    CONS(KEYWORD("HIGH"),
+			 CONS(cdr,
+			      CONS(KEYWORD("LOW"),
+				   CONS(obj, NIL))))));
+    /* get polygon->p values */
+    for (i = 0; i < polygon->npts; i++) {
+	obj = EVAL(CONS(ATOM("MAKE-PG-POINT"),
+			CONS(KEYWORD("X"),
+			     CONS(REAL(polygon->p[i].x),
+			      CONS(KEYWORD("Y"),
+				   CONS(REAL(polygon->p[i].y), NIL))))));
+	if (i == 0)
+	    p = cdr = CONS(obj, NIL);
+	else {
+	    RPLACD(cdr, CONS(obj, NIL));
+	    cdr = CDR(cdr);
+	}
+    }
+
+    /* make result */
+    poly = EVAL(CONS(ATOM("MAKE-PG-POLYGON"),
+		     CONS(KEYWORD("SIZE"),
+			  CONS(REAL(size),
+			       CONS(KEYWORD("NUM-POINTS"),
+				    CONS(REAL(polygon->npts),
+					 CONS(KEYWORD("BOUNDBOX"),
+					      CONS(box,
+						   CONS(KEYWORD("POINTS"),
+							CONS(QUOTE(p), NIL))))))))));
+    GCEnable();
+
+    return (poly);
+  }
+}
+
+LispObj *
+Lisp_PQhost(LispBuiltin *builtin)
+/*
+ pq-host connection
+ */
+{
+    char *string;
+    PGconn *conn;
+
+    LispObj *connection;
+
+    connection = ARGUMENT(0);
+
+    if (!CHECKO(connection, PGconn_t))
+	LispDestroy("%s: cannot convert %s to PGconn*",
+		    STRFUN(builtin), STROBJ(connection));
+    conn = (PGconn*)(connection->data.opaque.data);
+
+    string = PQhost(conn);
+
+    return (string ? STRING(string) : NIL);
+}
+
+LispObj *
+Lisp_PQnfields(LispBuiltin *builtin)
+/*
+ pq-nfields result
+ */
+{
+    int nfields;
+    PGresult *res;
+
+    LispObj *result;
+
+    result = ARGUMENT(0);
+
+    if (!CHECKO(result, PGresult_t))
+	LispDestroy("%s: cannot convert %s to PGresult*",
+		    STRFUN(builtin), STROBJ(result));
+    res = (PGresult*)(result->data.opaque.data);
+
+    nfields = PQnfields(res);
+
+    return (INTEGER(nfields));
+}
+
+LispObj *
+Lisp_PQnotifies(LispBuiltin *builtin)
+/*
+ pq-notifies connection
+ */
+{
+    LispObj *result, *code, *cod = COD;
+    PGconn *conn;
+    PGnotify *notifies;
+
+    LispObj *connection;
+
+    connection = ARGUMENT(0);
+
+    if (!CHECKO(connection, PGconn_t))
+	LispDestroy("%s: cannot convert %s to PGconn*",
+		    STRFUN(builtin), STROBJ(connection));
+    conn = (PGconn*)(connection->data.opaque.data);
+
+    if ((notifies = PQnotifies(conn)) == NULL)
+	return (NIL);
+
+    GCDisable();
+    code = CONS(ATOM("MAKE-PG-NOTIFY"),
+		  CONS(KEYWORD("RELNAME"),
+		       CONS(STRING(notifies->relname),
+			    CONS(KEYWORD("BE-PID"),
+				 CONS(REAL(notifies->be_pid), NIL)))));
+    COD = CONS(code, COD);
+    GCEnable();
+    result = EVAL(code);
+    COD = cod;
+
+    free(notifies);
+
+    return (result);
+}
+
+LispObj *
+Lisp_PQntuples(LispBuiltin *builtin)
+/*
+ pq-ntuples result
+ */
+{
+    int ntuples;
+    PGresult *res;
+
+    LispObj *result;
+
+    result = ARGUMENT(0);
+
+    if (!CHECKO(result, PGresult_t))
+	LispDestroy("%s: cannot convert %s to PGresult*",
+		    STRFUN(builtin), STROBJ(result));
+    res = (PGresult*)(result->data.opaque.data);
+
+    ntuples = PQntuples(res);
+
+    return (INTEGER(ntuples));
+}
+
+LispObj *
+Lisp_PQoptions(LispBuiltin *builtin)
+/*
+ pq-options connection
+ */
+{
+    char *string;
+    PGconn *conn;
+
+    LispObj *connection;
+
+    connection = ARGUMENT(0);
+
+    if (!CHECKO(connection, PGconn_t))
+	LispDestroy("%s: cannot convert %s to PGconn*",
+		    STRFUN(builtin), STROBJ(connection));
+    conn = (PGconn*)(connection->data.opaque.data);
+
+    string = PQoptions(conn);
+
+    return (string ? STRING(string) : NIL);
+}
+
+LispObj *
+Lisp_PQpass(LispBuiltin *builtin)
+/*
+ pq-pass connection
+ */
+{
+    char *string;
+    PGconn *conn;
+
+    LispObj *connection;
+
+    connection = ARGUMENT(0);
+
+    if (!CHECKO(connection, PGconn_t))
+	LispDestroy("%s: cannot convert %s to PGconn*",
+		    STRFUN(builtin), STROBJ(connection));
+    conn = (PGconn*)(connection->data.opaque.data);
+
+    string = PQpass(conn);
+
+    return (string ? STRING(string) : NIL);
+}
+
+LispObj *
+Lisp_PQport(LispBuiltin *builtin)
+/*
+ pq-port connection
+ */
+{
+    char *string;
+    PGconn *conn;
+
+    LispObj *connection;
+
+    connection = ARGUMENT(0);
+
+    if (!CHECKO(connection, PGconn_t))
+	LispDestroy("%s: cannot convert %s to PGconn*",
+		    STRFUN(builtin), STROBJ(connection));
+    conn = (PGconn*)(connection->data.opaque.data);
+
+    string = PQport(conn);
+
+    return (string ? STRING(string) : NIL);
+}
+
+LispObj *
+Lisp_PQresultStatus(LispBuiltin *builtin)
+/*
+ pq-result-status result
+ */
+{
+    int status;
+    PGresult *res;
+
+    LispObj *result;
+
+    result = ARGUMENT(0);
+
+    if (!CHECKO(result, PGresult_t))
+	LispDestroy("%s: cannot convert %s to PGresult*",
+		    STRFUN(builtin), STROBJ(result));
+    res = (PGresult*)(result->data.opaque.data);
+
+    status = PQresultStatus(res);
+
+    return (INTEGER(status));
+}
+
+LispObj *
+LispPQsetdb(LispBuiltin *builtin, int loginp)
+/*
+ pq-setdb host port options tty dbname
+ pq-setdb-login host port options tty dbname login password
+ */
+{
+    PGconn *conn;
+    char *host, *port, *options, *tty, *dbname, *login, *password;
+
+    LispObj *ohost, *oport, *ooptions, *otty, *odbname, *ologin, *opassword;
+
+    if (loginp) {
+	opassword = ARGUMENT(6);
+	ologin = ARGUMENT(5);
+    }
+    else
+	opassword = ologin = NIL;
+    odbname = ARGUMENT(4);
+    otty = ARGUMENT(3);
+    ooptions = ARGUMENT(2);
+    oport = ARGUMENT(1);
+    ohost = ARGUMENT(0);
+
+    if (ohost != NIL) {
+	CHECK_STRING(ohost);
+	host = THESTR(ohost);
+    }
+    else
+	host = NULL;
+
+    if (oport != NIL) {
+	CHECK_STRING(oport);
+	port = THESTR(oport);
+    }
+    else
+	port = NULL;
+
+    if (ooptions != NIL) {
+	CHECK_STRING(ooptions);
+	options = THESTR(ooptions);
+    }
+    else
+	options = NULL;
+
+    if (otty != NIL) {
+	CHECK_STRING(otty);
+	tty = THESTR(otty);
+    }
+    else
+	tty = NULL;
+
+    if (odbname != NIL) {
+	CHECK_STRING(odbname);
+	dbname = THESTR(odbname);
+    }
+    else
+	dbname = NULL;
+
+    if (ologin != NIL) {
+	CHECK_STRING(ologin);
+	login = THESTR(ologin);
+    }
+    else
+	login = NULL;
+
+    if (opassword != NIL) {
+	CHECK_STRING(opassword);
+	password = THESTR(opassword);
+    }
+    else
+	password = NULL;
+
+    conn = PQsetdbLogin(host, port, options, tty, dbname, login, password);
+
+    return (conn ? OPAQUE(conn, PGconn_t) : NIL);
+}
+
+LispObj *
+Lisp_PQsetdb(LispBuiltin *builtin)
+/*
+ pq-setdb host port options tty dbname
+ */
+{
+    return (LispPQsetdb(builtin, 0));
+}
+
+LispObj *
+Lisp_PQsetdbLogin(LispBuiltin *builtin)
+/*
+ pq-setdb-login host port options tty dbname login password
+ */
+{
+    return (LispPQsetdb(builtin, 1));
+}
+
+LispObj *
+Lisp_PQsocket(LispBuiltin *builtin)
+/*
+ pq-socket connection
+ */
+{
+    int sock;
+    PGconn *conn;
+
+    LispObj *connection;
+
+    connection = ARGUMENT(0);
+
+    if (!CHECKO(connection, PGconn_t))
+	LispDestroy("%s: cannot convert %s to PGconn*",
+		    STRFUN(builtin), STROBJ(connection));
+    conn = (PGconn*)(connection->data.opaque.data);
+
+    sock = PQsocket(conn);
+
+    return (INTEGER(sock));
+}
+
+LispObj *
+Lisp_PQstatus(LispBuiltin *builtin)
+/*
+ pq-status connection
+ */
+{
+    int status;
+    PGconn *conn;
+
+    LispObj *connection;
+
+    connection = ARGUMENT(0);
+
+    if (!CHECKO(connection, PGconn_t))
+	LispDestroy("%s: cannot convert %s to PGconn*",
+		    STRFUN(builtin), STROBJ(connection));
+    conn = (PGconn*)(connection->data.opaque.data);
+
+    status = PQstatus(conn);
+
+    return (INTEGER(status));
+}
+
+LispObj *
+Lisp_PQtty(LispBuiltin *builtin)
+/*
+ pq-tty connection
+ */
+{
+    char *string;
+    PGconn *conn;
+
+    LispObj *connection;
+
+    connection = ARGUMENT(0);
+
+    if (!CHECKO(connection, PGconn_t))
+	LispDestroy("%s: cannot convert %s to PGconn*",
+		    STRFUN(builtin), STROBJ(connection));
+    conn = (PGconn*)(connection->data.opaque.data);
+
+    string = PQtty(conn);
+
+    return (string ? STRING(string) : NIL);
+}
+
+LispObj *
+Lisp_PQuser(LispBuiltin *builtin)
+/*
+ pq-user connection
+ */
+{
+    char *string;
+    PGconn *conn;
+
+    LispObj *connection;
+
+    connection = ARGUMENT(0);
+
+    if (!CHECKO(connection, PGconn_t))
+	LispDestroy("%s: cannot convert %s to PGconn*",
+		    STRFUN(builtin), STROBJ(connection));
+    conn = (PGconn*)(connection->data.opaque.data);
+
+    string = PQuser(conn);
+
+    return (string ? STRING(string) : NIL);
+}
diff --git a/lisp/modules/syntax.lsp b/lisp/modules/syntax.lsp
new file mode 100644
index 0000000..c297235
--- /dev/null
+++ b/lisp/modules/syntax.lsp
@@ -0,0 +1,1452 @@
+;;
+;; Copyright (c) 2002 by The XFree86 Project, Inc.
+;;
+;; Permission is hereby granted, free of charge, to any person obtaining a
+;; copy of this software and associated documentation files (the "Software"),
+;; to deal in the Software without restriction, including without limitation
+;; the rights to use, copy, modify, merge, publish, distribute, sublicense,
+;; and/or sell copies of the Software, and to permit persons to whom the
+;; Software is furnished to do so, subject to the following conditions:
+;;
+;; The above copyright notice and this permission notice shall be included in
+;; all copies or substantial portions of the Software.
+;;
+;; THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
+;; IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
+;; FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT.  IN NO EVENT SHALL
+;; THE XFREE86 PROJECT BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY,
+;; WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF
+;; OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE
+;; SOFTWARE.
+;;
+;; Except as contained in this notice, the name of the XFree86 Project shall
+;; not be used in advertising or otherwise to promote the sale, use or other
+;; dealings in this Software without prior written authorization from the
+;; XFree86 Project.
+;;
+;; Author: Paulo César Pereira de Andrade
+;;
+;;
+;; $XFree86: xc/programs/xedit/lisp/modules/syntax.lsp,v 1.11 2003/01/16 03:50:46 paulo Exp $
+;;
+
+(provide "syntax")
+(require "xedit")
+(in-package "XEDIT")
+
+(defvar *syntax-symbols* '(
+    syntax-highlight defsyntax defsynprop synprop-p syntax-p
+    syntable syntoken synaugment
+    *prop-default* *prop-keyword* *prop-number* *prop-string*
+    *prop-constant* *prop-comment* *prop-preprocessor*
+    *prop-punctuation* *prop-error* *prop-annotation*
+))
+(export *syntax-symbols*)
+(in-package "USER")
+(dolist (symbol xedit::*syntax-symbols*)
+    (import symbol)
+)
+(in-package "XEDIT")
+(makunbound '*syntax-symbols*)
+
+#|
+TODO:
+o Add a command to match without increment the offset in the input, this
+  may be useful for example in a case like:
+	some-table
+	    match "<"
+		switch -1
+	match "<"	<- the table already eated this, so it won't be matched.
+  This must be carefully checked at compile time, such instruction should
+  be in a token that returns or starts a new one, and even then, may need
+  runtime check to make sure it won't enter an infinite loop.
+o Allow combining properties, this is supported in Xaw, and could allow some
+  very interesting effects for complex documents.
+o Maybe have an separated function/loop for tables that don't have tokens
+  that start/switch to another table, and/or have the contained attribute set.
+  This could allow running considerably faster.
+o Do a better handling of interactive edition for tokens that start and end
+  with the same pattern, as an example strings, if the user types '"', it
+  will parse up to the end of the file, "inverting" all strings.
+o Allow generic code to be run once a match is found, such code could handle
+  some defined variables and take decisions based on the parser state. This
+  should be detected at compile time, to maybe run a different parser for
+  such syntax tables, due to the extra time building the environment to
+  call the code. This would be useful to "really" parse documents with
+  complex syntax, for example, a man page source file.
+o Add command to change current default property without initializing a new
+  state.
+o Fix problems matching EOL. Since EOL is an empty string match, if there
+  is a rule to match only EOL, but some other rule matches up to the end
+  of the input, the match to EOL will not be recognized. Currently the only
+  way to handle this is to have a nested table that always returns once a
+  match is found, so that it will restart the match loop code even if the
+  input is at EOL.
+  One possible solution would be to add the ending newline to the input,
+  and then instead of matching "$", should match "\\n".
+o XXX Usage of the variable newline-property must be reviewed in function
+  syntax-highlight, if the text property has a background attribute,
+  visual effect will look "strange", will paint a square with the
+  background attribute at the end of every line in the matched text.
+|#
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; Some annotations to later write documentation for the module...
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+#|
+    The current interface logic should be easy to understand for people
+that have written lex scanners before. It has some extended semantics,
+that could be translated to stacked BEGIN() statements in lex, but
+currently does not have rules for matches in the format RE/TRAILING, as
+well as code attached to rules (the biggest difference) and/or things
+like REJECT and unput(). Also, at least currently, it is *really* quite
+slower than lex.
+
+	MATCHING RULES
+	--------------
+    When two tokens are matched at the same input offset, the longest
+token is used, if the length is the same, the first definition is
+used. For example:
+	token1	=>	int
+	token2	=>	[A-Za-z]+
+	input	=>	integer
+    Token1 matches "int" and token2 matches "integer", but since token2 is
+longer, it is used. But in the case:
+	token1	=>	int
+	token2	=>	[A-Za-z]+
+	input	=>	int
+    Both, token1 and token2 match "int", since token1 is defined first, it
+is used.
+|#
+
+
+;;  Initialize some default properties that may be shared in syntax
+;; highlight definitions. Use of these default properties is encouraged,
+;; so that "tokens" will be shown identically when editing program
+;; sources in different programming languages.
+(defsynprop *prop-default*
+    "default"
+    :font	"*courier-medium-r*12*"
+    :foreground	"black")
+
+(defsynprop *prop-keyword*
+    "keyword"
+    :font	"*courier-bold-r*12*"
+    :foreground	"gray12")
+
+(defsynprop *prop-number*
+    "number"
+    :font	"*courier-bold-r*12*"
+    :foreground	"OrangeRed3")
+
+(defsynprop *prop-string*
+    "string"
+    :font	"*lucidatypewriter-medium-r*12*"
+    :foreground	"RoyalBlue2")
+
+(defsynprop *prop-constant*
+    "constant"
+    :font	"*lucidatypewriter-medium-r*12*"
+    :foreground	"VioletRed3")
+
+(defsynprop *prop-comment*
+    "comment"
+    :font	"*courier-medium-o*12*"
+    :foreground	"SlateBlue3")
+
+(defsynprop *prop-preprocessor*
+    "preprocessor"
+    :font	"*courier-medium-r*12*"
+    :foreground	"green4")
+
+(defsynprop *prop-punctuation*
+    "punctuation"
+    :font	"*courier-bold-r*12*"
+    :foreground	"gray12")
+
+;; Control characters, not always errors...
+(defsynprop *prop-control*
+    "control"
+    :font	"*courier-bold-r*12*"
+    :foreground	"yellow2"
+    :background	"red3")
+
+(defsynprop *prop-error*
+    "error"
+    :font	"*new century schoolbook-bold*24*"
+    :foreground	"yellow"
+    :background	"red")
+
+(defsynprop *prop-annotation*
+    "annotation"
+    :font	"*courier-medium-r*12*"
+    :foreground	"black"
+    :background	"PaleGreen")
+
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;  The "main" definition of the syntax highlight coding interface.
+;;  Creates a "special" variable with the given name, associating to
+;; it an already compiled syntax table.
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+(defmacro defsyntax (variable label property indent options &rest lists)
+    `(if (boundp ',variable)
+	,variable
+	(progn
+	    (proclaim '(special ,variable))
+	    (setq ,variable
+		(compile-syntax-table
+		    (string ',variable) ,options
+		    (syntable ,label ,property ,indent ,@lists)
+		)
+	    )
+	)
+    )
+)
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;  Just a wrapper to create a hash-table and bound it to a symbol.
+;;  Example of call:
+;;	(defsynoptions *my-syntax-options*
+;;	    (:indent		.	8)
+;;	    (:indent-option-1	.	1)
+;;	    (:indent-option-2	.	2)
+;;	)
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+(defmacro defsynoptions (variable &rest options)
+    `(if (boundp ',variable)
+	,variable
+	(progn
+	    (proclaim '(special ,variable))
+	    (setq ,variable (make-hash-table :initial-contents ',options))
+	)
+    )
+)
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; These definitions should be "private".
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+(defstruct syntoken
+    regex		;; A compiled regexp.
+    property		;; NIL for default, or a synprop structure.
+    contained		;; Only used when switch/begin is not NIL. Values:
+			;;	NIL	  -> just switch to or begin new
+			;;		     syntax table.
+			;;	(not NIL) -> apply syntoken property
+			;;		     (or default one) to matched
+			;;		     text *after* switching to or
+			;;		     beginning a new syntax table.
+    switch		;; Values for switch are:
+			;;	NIL	  -> do nothing
+			;;	A keyword -> switch to the syntax table
+			;;		     identified by the keyword.
+			;;	A negative integer -> Pop the stack
+			;;			      -<swich-value> times.
+			;;			      A common value is -1,
+			;;			     to switch to the previous
+			;;			     state, but some times
+			;;			     it is desired to return
+			;;			     two or more times in
+			;;			     in the stack.
+			;;  NOTE: This is actually a jump, the stack is
+			;; popped until the named syntax table is found,
+			;; if the stack becomes empty, a new state is
+			;; implicitly created.
+    begin		;;  NIL or a keyword (like switch), but instead of
+			;; popping the stack, it pushes the current syntax
+			;; table to the stack and sets a new current one.
+)
+
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; Just a wrapper to make-syntoken.
+;;	TODO: Add support for structure constructors.
+;;	XXX: Note that the NOSUB only works with the xedit regex, it
+;; will still return the match offsets, but will ignore subexpressions,
+;; that is, parenthesis are used only for grouping.
+;;	TODO: Create a new version of the re-exec call that returns
+;; offsets in the format (<from> . <to>) and not
+;; ((<from0> . <to0>) ... (<fromN> . <toN>)). Only the global result
+;; is expected/used, so there is no reason to allocate more than one
+;; cons cell per call.
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+(defun syntoken (pattern
+		 &key icase nospec property contained switch begin (nosub t)
+		 &aux
+		 (regex
+		    (re-comp pattern :icase icase :nospec nospec :nosub nosub)
+		 )
+		 check)
+
+    ;;  Don't allow a regex that matches the null string enter the
+    ;; syntax table list.
+    (if (consp (setq check (re-exec regex "" :noteol t :notbol t)))
+#+xedit	(error "SYNTOKEN: regex matches empty string ~S" regex)
+#-xedit	()
+    )
+
+    (make-syntoken
+	:regex		regex
+	:property	property
+	:contained	contained
+	:switch		switch
+	:begin		begin
+    )
+)
+
+
+;;  This structure is defined only to do some type checking, it just
+;; holds a list of keywords.
+(defstruct synaugment
+    labels		;; List of keywords labeling syntax tables.
+)
+
+(defstruct syntable
+    label		;; A keyword naming this syntax table.
+    property		;; NIL or a default synprop structure.
+    indent		;; Indentation function for the syntax table.
+    tokens		;; A list of syntoken structures.
+    tables		;; A list of syntable structures.
+    augments		;;  A list of synaugment structures, used only
+			;; at "compile time", so that a table can be
+			;; used before it's definition.
+    bol			;;  One of the tokens match the empty string at
+			;; the start of a line (loop optimization hint).
+			;; Field filled at "link" time.
+    eol			;;  Same comments as bol, but in this case, for
+			;; the empty string at the end of a line.
+)
+
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;  Just call make-syntable, but sorts the elements by type, allowing
+;; a cleaner code when defining the syntax highlight rules.
+;; XXX Same comments as for syntoken about the use of a constructor for
+;; structures. TODO: when/if clos is implemented in the interpreter.
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+(defun syntable (label default-property indent &rest definitions)
+
+    ;; Check for possible errors in the arguments.
+    (unless (keywordp label)
+	(error "SYNTABLE: ~A is not a keyword" label)
+    )
+    (unless
+	(or
+	    (null default-property)
+	    (synprop-p default-property)
+	)
+	(error "SYNTABLE: ~A is an invalid text property"
+	    default-property
+	)
+    )
+
+    ;; Don't allow unknown data in the definition list.
+    ;; XXX typecase should be added to the interpreter, and since
+    ;;     the code is traversing the entire list, it could build
+    ;;     now the arguments to make-syntable.
+    (dolist (item definitions)
+	(unless
+	    (or
+
+		;;  Allow NIL in the definition list, so that one
+		;; can put conditionals in the syntax definition,
+		;; and if the conditional is false, fill the slot
+		;; with a NIL value.
+		(atom item)
+		(syntoken-p item)
+		(syntable-p item)
+		(synaugment-p item)
+	    )
+	    (error "SYNTABLE: invalid syntax table argument ~A" item)
+	)
+    )
+
+    ;; Build the syntax table.
+    (make-syntable
+	:label		label
+	:property	default-property
+	:indent		indent
+	:tokens		(remove-if-not #'syntoken-p definitions)
+	:tables		(remove-if-not #'syntable-p definitions)
+	:augments	(remove-if-not #'synaugment-p definitions)
+    )
+)
+
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;  Just to do a "preliminary" error checking, every element must be a
+;; a keyword, and also check for reserved names.
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+(defun synaugment (&rest keywords)
+    (dolist (keyword keywords)
+	(unless (keywordp keyword)
+	    (error "SYNAUGMENT: bad syntax table label ~A" keyword)
+	)
+    )
+    (make-synaugment :labels keywords)
+)
+
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; Recursive compile utility function.
+;; Returns a cons in the format:
+;;	car	=>	List of all syntoken structures
+;;			(including child tables).
+;;	cdr	=>	List of all child syntable structures.
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+(defun list-syntable-elements (table &aux result sub-result)
+    (setq
+	result
+	(cons
+	    (syntable-tokens table)
+	    (syntable-tables table))
+    )
+
+    ;; For every child syntax table.
+    (dolist (child (syntable-tables table))
+
+	;; Recursively call list-syntable-elements.
+	(setq sub-result (list-syntable-elements child))
+
+	(rplaca result (append (car result) (car sub-result)))
+	(rplacd result (append (cdr result) (cdr sub-result)))
+    )
+
+    ;; Return the pair of nested tokens and tables.
+    result
+)
+
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;  Append tokens of the augment list to the tokens of the specified
+;; syntax table.
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+(defun compile-syntax-augment-list (table table-list
+				    &aux labels augment tokens)
+
+    ;; Create a list of all augment tables.
+    (dolist (augment (syntable-augments table))
+	(setq labels (append labels (synaugment-labels augment)))
+    )
+
+    ;;  Remove duplicates and references to "itself",
+    ;; without warnings?
+    (setq
+	labels
+	(remove
+	    (syntable-label table)
+	    (remove-duplicates labels :from-end t)
+	)
+    )
+
+    ;; Check if the specified syntax tables exists!
+    (dolist (label labels)
+	(unless
+	    (setq
+		augment
+		(car (member label table-list :key #'syntable-label))
+	    )
+	    (error "COMPILE-SYNTAX-AUGMENT-LIST: Cannot augment ~A in ~A"
+		label
+		(syntable-label table)
+	    )
+	)
+
+	;; Increase list of tokens.
+	(setq tokens (append tokens (syntable-tokens augment)))
+    )
+
+    ;;  Store the tokens in the augment list. They will be added
+    ;; to the syntax table in the second pass.
+    (setf (syntable-augments table) tokens)
+
+    ;;  Recurse on every child table.
+    (dolist (child (syntable-tables table))
+	(compile-syntax-augment-list child table-list)
+    )
+)
+
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;  Just add the augmented tokens to the token list, recursing on
+;; every child syntax table.
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+(defun link-syntax-augment-table (table)
+    (setf
+	(syntable-tokens table)
+	;;  When augmenting a table, duplicated tokens or different tokens
+	;; that use the same regex pattern should be common.
+	(remove-duplicates
+	    (nconc (syntable-tokens table) (syntable-augments table))
+	    :key	#'syntoken-regex
+	    :test	#'equal
+	    :from-end	t
+	)
+
+	;;  Don't need to keep this list anymore.
+	(syntable-augments table)
+	()
+    )
+
+    ;;  Check if one of the tokens match the empty string at the
+    ;; start or end of a text line. XXX The fields bol and eol
+    ;; are expected to be initialized to NIL.
+    (dolist (token (syntable-tokens table))
+	(when (consp (re-exec (syntoken-regex token) "" :noteol t))
+	    (setf (syntable-bol table) t)
+	    (return)
+	)
+    )
+    (dolist (token (syntable-tokens table))
+	(when (consp (re-exec (syntoken-regex token) "" :notbol t))
+	    (setf (syntable-eol table) t)
+	    (return)
+	)
+    )
+
+    (dolist (child (syntable-tables table))
+	(link-syntax-augment-table child)
+    )
+)
+
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; "Compile" the main structure of the syntax highlight code.
+;; Variables "switches" and "begins" are used only for error checking.
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+(defun compile-syntax-table (name options main-table &aux syntax elements
+			     switches begins tables properties)
+    (unless (stringp name)
+	(error "COMPILE-SYNTAX-TABLE: ~A is not a string" name)
+    )
+
+    (setq
+	elements
+	(list-syntable-elements main-table)
+
+	switches
+	(remove-if
+	    #'null
+	    (car elements)
+	    :key #'syntoken-switch
+	)
+
+	begins
+	(remove-if-not
+	    #'keywordp
+	    (car elements)
+	    :key #'syntoken-begin
+	)
+
+	;;  The "main-table" isn't in the list, because
+	;; list-syntable-elements includes only the child tables;
+	;; this is done to avoid the need of removing duplicates here.
+	tables
+	(cons main-table (cdr elements))
+    )
+
+    ;; Check for typos in the keywords, or for not defined syntax tables.
+    (dolist (item (mapcar #'syntoken-switch switches))
+	(unless
+	    (or
+		(and
+		    (integerp item)
+		    (minusp item)
+		)
+		(member item tables :key #'syntable-label)
+	    )
+	    (error "COMPILE-SYNTAX-TABLE: SWITCH ~A cannot be matched"
+		item
+	    )
+	)
+    )
+    (dolist (item (mapcar #'syntoken-begin begins))
+	(unless (member item tables :key #'syntable-label)
+	    (error "COMPILE-SYNTAX-TABLE: BEGIN ~A cannot be matched"
+		item
+	    )
+	)
+    )
+
+    ;; Create a list of all properties used by the syntax.
+    (setq
+	properties
+	(delete-duplicates
+
+	    ;; Remove explicitly set to "default" properties.
+	    (remove nil
+
+		(append
+
+		    ;; List all properties in the syntoken list.
+		    (mapcar
+			#'syntoken-property
+			(car elements)
+		    )
+
+		    ;; List all properties in the syntable list.
+		    (mapcar
+			#'syntable-property
+			tables
+		    )
+		)
+	    )
+	    :test #'string=
+	    :key  #'synprop-name
+	)
+    )
+
+    ;;  Provide a default property if none specified.
+    (unless
+	(member
+	    "default"
+	    properties
+	    :test #'string=
+	    :key #'synprop-name
+	)
+	(setq properties (append (list *prop-default*) properties))
+    )
+
+
+    ;;  Now that a list of all nested syntax tables is known, compile the
+    ;; augment list. Note that even the main-table can be augmented to
+    ;; include tokens of one of it's children.
+
+    ;;  Adding the tokens of the augment tables must be done in
+    ;; two passes, or it may cause surprises due to "inherited"
+    ;; tokens, as the augment table was processed first, and
+    ;; increased it's token list.
+    (compile-syntax-augment-list main-table tables)
+
+    ;;  Now just append the augmented tokens to the table's token list.
+    (link-syntax-augment-table main-table)
+
+    ;;  Change all syntoken switch and begin fields to point to the
+    ;; syntable.
+    (dolist (item switches)
+	(if (keywordp (syntoken-switch item))
+	    ;;  A switch may be relative, check if a keyword
+	    ;; was specified.
+	    (setf
+		(syntoken-switch item)
+		(car
+		    (member
+			(syntoken-switch item)
+			tables
+			:key #'syntable-label
+		    )
+		)
+	    )
+	)
+    )
+    (dolist (item begins)
+	(setf
+	    (syntoken-begin item)
+	    (car
+		(member
+		    (syntoken-begin item)
+		    tables
+		    :key #'syntable-label
+		)
+	    )
+	)
+    )
+
+    ;;  Don't need to add a entity for default properties
+    (dolist (item (car elements))
+	(and
+	    (syntoken-property item)
+	    (string= (synprop-name (syntoken-property item)) "default")
+	    (setf (syntoken-property item) ())
+	)
+    )
+    (dolist (item tables)
+	(and
+	    (syntable-property item)
+	    (string= (synprop-name (syntable-property item)) "default")
+	    (setf (syntable-property item) ())
+	)
+    )
+
+    (setq syntax
+	(make-syntax
+	    :name	name
+	    :options	options
+	    :labels	tables
+	    :quark
+		(compile-syntax-property-list
+		    name
+		    properties
+		)
+	    :token-count
+		(length (car elements))
+	)
+    )
+
+    ;; Ready to run!
+)
+
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;  Loop applying the specifed syntax table to the text.
+;;  XXX This function needs a review. Should compile the regex patterns
+;; with newline sensitive match (and scan the entire file), and keep a
+;; cache of matched tokens (that may be at a very longer offset), and,
+;; when the match is removed from the cache, readd the token to the
+;; token-list; if the token does not match, it will not be in the cache,
+;; but should be removed from the token-list. If properly implemented, it
+;; should be somewhat like 4 times faster, but I would not be surprised
+;; if it becames even faster.
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+(defun syntax-highlight (*syntax*
+			 &optional
+			 (*from* (point-min))
+			 (*to* (point-max))
+			 interactive
+			 &aux
+#+debug			 (*line-number* 0)
+			 stream
+			 indent-table
+			)
+
+    ;;  Make sure the property list is in use.
+    ;;  The interactive flag is only set after loading the file.
+    (or interactive
+	(property-list (syntax-quark *syntax*))
+    )
+
+#+debug
+    (setq *from* 0 *to* 0)
+
+#-debug
+    (and (>= *from* *to*) (return-from syntax-highlight (values *from* nil)))
+
+    ;;  Remove any existing properties from the text.
+    (clear-entities *from* (1+ *to*))
+
+    (setq stream
+#-debug	(make-string-input-stream (read-text *from* (- *to* *from*)))
+#+debug	*standard-input*
+    )
+
+    (prog*
+	(
+	;;  Used to check if end of file found but syntax stack did
+	;; not finish.
+	(point-max (point-max))
+
+	;;  Used in interactive mode, to return the syntax table
+	;; where the cursor is located.
+	(point (point))
+
+	;;  The current stack of states.
+	stack
+
+	;;  The current syntable.
+	(syntax-table (car (syntax-labels *syntax*)))
+
+	;;  The current syntable's default property.
+	(default-property (syntable-property syntax-table))
+
+	;;  Add this property to newlines as a hint to the interactive
+	;; callback, so that it knows from where to restart parsing.
+	newline-property
+
+	;;  The tokens in the current syntax table that may match,
+	;; i.e. the items in this list are not in nomatch.
+	token-list
+
+	;;  A pointer to the syntable token list, if token-list is
+	;; eq to this value, cannot change it inplace.
+	current-token-list
+
+	;;  Help to avoid allocating too many new object cells, and
+	;; optmizes a bit time in [n]?set-difference.
+	;;  This optimizes only the processing of one line of text
+	;; as nomatch must be rebuilt when reading a new line of text.
+	token-list-stack
+
+	;;  Matches for the current list of tokens.
+	matches
+
+	;;  Line of text.
+	line
+
+	;;  Length of the text line.
+	length
+
+	;;  A inverse cache, don't call re-exec when the regex is
+	;; already known to not match.
+	nomatch
+
+	;;  Use cache as a list of matches to avoid repetitive
+	;; unnecessary calls to re-exec.
+	;;  cache is a list in which every element has the format:
+	;;	(token . (start . end))
+	;;  Line of text.
+	cache
+
+	;;  Used just to avoid a function call at every re-exec call.
+	notbol
+
+	match
+
+	start
+	left
+	right
+	result
+	property
+
+	;;  Beginig a new syntax table?
+	begin
+
+	;;  Switching to another syntax table?
+	switch
+
+	;;  Property flag when changing the current syntax table.
+	contained
+
+	;;  Flag to know if syntax table has changed.
+	change
+
+	;;  Variables used when removing invalid elements from the
+	;; the cache.
+	item
+	from
+	to
+	)
+
+;-----------------------------------------------------------------------
+:read
+#+debug-verbose
+	(format t "** Entering :READ stack length is ~D~%" (length stack))
+#+debug	(format t "~%[~D]> " (incf *line-number*))
+
+	;;  If input has finished, return.
+	(unless (setq line (read-line stream nil nil))
+	    (when
+		(and
+		    ;; If a nested syntax table wasn't finished
+		    (consp stack)
+		    (<
+			(setq *to* (scan *from* :eol :right))
+			point-max
+		    )
+		)
+		(setq line (read-text *from* (- *to* *from*)))
+		(clear-entities *from* (1+ *to*))
+		(go :again)
+	    )
+#-debug	    (close stream)
+	    (return)
+	)
+
+;------------------------------------------------------------------------
+:again
+	(setq
+	    start		0
+	    length		(length line)
+	    token-list		(syntable-tokens syntax-table)
+	    current-token-list	token-list
+	    token-list-stack	()
+	    nomatch		()
+	    cache		()
+	)
+
+
+	;;  If empty line, and current table does not have matches for
+	;; the empty string at start or end of a text line.
+	(when
+	    (and
+		(= length 0)
+		(not (syntable-eol syntax-table))
+		(not (syntable-bol syntax-table)))
+#+debug-verbose
+	    (format t "Empty line and table has no match to bol or eol~%")
+
+	    (and newline-property
+		(add-entity *from* 1 (synprop-quark newline-property)))
+	    (go :update)
+	)
+
+;------------------------------------------------------------------------
+:loop
+#+debug-verbose
+	(format t "** Entering :LOOP at offset ~D in table ~A, cache has ~D items~%"
+	    start
+	    (syntable-label syntax-table)
+	    (length cache))
+
+	(setq notbol (> start 0))
+
+	;;  For every token that may match.
+	(dolist
+	    (token
+		(setq
+		    token-list
+		    (if (eq token-list current-token-list)
+			(set-difference token-list nomatch :test #'eq)
+			(nset-difference token-list nomatch :test #'eq)
+		    )
+		)
+	    )
+
+	    ;;	Try to fetch match from cache.
+	    (if (setq match (member token cache :test #'eq :key #'car))
+		;;  Match is in the cache.
+
+		(progn
+		    ;;	Match must be moved to the beginning of the
+		    ;; matches list, as a match from another syntax
+		    ;; table may be also in the cache, but before
+		    ;; the match for the current token.
+#+debug-verbose	    (format t "cached: {~A:~S} ~A~%"
+			(cdar match)
+			(subseq line (cadar match) (cddar match))
+			(syntoken-regex token))
+
+		    ;;	Remove the match from the cache.
+		    (if (eq match cache)
+
+			;;  This could be changed to only set "matches"
+			;; if it is not the first element of cache,
+			;; but is unsafe, because other tokens may
+			;; be added to "matches", and will end up
+			;; before when joining "matches" and "cache".
+			(progn
+			    (setq cache (cdr cache))
+			    (rplacd match matches)
+			    (setq matches match))
+
+			(progn
+			    (if (= (length match) 1)
+				(progn
+				    (rplacd (last cache 2) nil)
+				    (rplacd match matches)
+				    (setq matches match))
+				(progn
+				    (setq matches (cons (car match) matches))
+				    (rplaca match (cadr match))
+				    (rplacd match (cddr match)))
+			    )
+			)
+		    )
+
+		    ;;	Exit loop if the all the remaining
+		    ;; input was matched.
+		    (when
+			(and
+			    (= start (cadar match))
+			    (= length (cddar match))
+			)
+#+debug-verbose 	(format t "Rest of line match~%")
+			(return)
+		    )
+		)
+
+		;;  Not in the cache, call re-exec.
+		(if
+		    (consp
+			(setq
+			    match
+			    (re-exec
+				(syntoken-regex token)
+				line
+				:start	start
+				:notbol	notbol)))
+
+		    ;;	Match found.
+		    (progn
+#+debug-verbose		(format t "Adding to cache: {~A:~S} ~A~%"
+			    (car match)
+			    (subseq line (caar match) (cdar match))
+			    (syntoken-regex token))
+
+			;; Only the first pair is used.
+			(setq match (car match))
+
+			(cond
+			    (
+				(or
+				    (null matches)
+				    ;;	No overlap and after most
+				    ;; recent match.
+				    (>= (car match) (cddar matches))
+				    ;; No overlap and before most
+				    ;; recent match.
+				    (<= (cdr match) (cadar matches))
+				)
+				(setq
+				    matches
+				    (cons (cons token match) matches)
+				)
+			    )
+			    (
+				(or
+				    ;;	Overlap, but start before most
+				    ;; recent match.
+				    (< (car match) (cadar matches))
+				    (and
+					;;  Same offset as most recent
+					;; match, but is longer.
+					(= (car match) (cadar matches))
+					(> (cdr match) (cddar matches))
+				    )
+				)
+				(rplaca (car matches) token)
+				(rplacd (car matches) match)
+#+debug-verbose 		(format t "Replaced most recent match~%")
+			    )
+			    (t
+#+debug-verbose 		(format t "Ignored~%")
+				;; XXX The interpreter does not yet implement
+				;; implicit tagbody in dolist, just comment
+				;; the go call in that case. (Will just do
+				;; an unecessary test...)
+				(go :ignored)
+			    )
+			)
+
+			;;  Exit loop if the all the remaining
+			;; input was matched.
+			(when
+			    (and
+				(= start (car match))
+				(= length (cdr match)))
+#+debug-verbose 	    (format t "Rest of line match~%")
+			    (return))
+		    )
+
+		    ;;	Match not found.
+		    (progn
+#+debug-verbose 	(format t "Adding to nomatch: ~A~%"
+			    (syntoken-regex token))
+			(setq nomatch (cons token nomatch)))
+		)
+	    )
+:ignored
+	)
+
+	;;  Add matches to the beginning of the cache list.
+	(setq
+	    ;;	Put matches with smaller offset first.
+	    cache
+	    (stable-sort (nconc (nreverse matches) cache) #'< :key #'cadr)
+
+	    ;;	Make sure that when the match loop is reentered, this
+	    ;; variable is NIL.
+	    matches
+	    ()
+	)
+
+	;;  While the first entry in the cache is not from the current table.
+	(until (or (null cache) (member (caar cache) token-list :test #'eq))
+
+#+debug-verbose
+	    (format t "Not in the current table, removing {~A:~S} ~A~%"
+		(cdar cache)
+		(subseq line (cadar cache) (cddar cache))
+		(syntoken-regex (caar cache)))
+
+	    (setq cache (cdr cache))
+	)
+
+
+	;;  If nothing was matched in the entire/remaining line.
+	(unless cache
+	    (when default-property
+		(if
+		    (or
+			(null result)
+			(> start (cadar result))
+			(not (eq (cddar result) default-property)))
+		    (setq
+			result
+			(cons
+			    (cons start (cons length default-property))
+			    result
+			)
+		    )
+		    (rplaca (cdar result) length)
+		)
+	    )
+
+#+debug-verbose
+	    (format t "No match until end of line~%")
+
+	    ;;  Result already known, and there is no syntax table
+	    ;; change, bypass :PARSE.
+	    (and interactive
+		(null indent-table)
+		(<= 0 (- point *from*) length)
+		(setq indent-table syntax-table))
+	    (go :process)
+	)
+
+#+debug-verbose
+	(format t "Removing first candidate from cache {~A:~S} ~A~%"
+	    (cdar cache)
+	    (subseq line (cadar cache) (cddar cache))
+	    (syntoken-regex (caar cache))
+	)
+
+	;;  Prepare to choose best match.
+	(setq
+	    match	(car cache)
+	    left	(cadr match)
+	    right	(cddr match)
+	    cache	(cdr cache)
+	)
+
+	;;  First element can be safely removed now.
+	;;  If there is only one, skip loop below.
+	(or cache (go :parse))
+
+	;;  Remove elements of cache that must be discarded.
+	(setq
+	    item   (car cache)
+	    from   (cadr item)
+	    to     (cddr item)
+	)
+
+	(loop
+	    (if
+		(or
+
+		    ;;	If everything removed from the cache.
+		    (null item)
+
+		    ;;	Or next item is at a longer offset than the
+		    ;; end of current match.
+		    (>= from right)
+		)
+		(return)
+	    )
+
+	    (and
+		;;  If another match at the same offset.
+		(= left from)
+
+		;;  And if this match is longer than the current one.
+		(> to right)
+
+		(member (car item) token-list :test #'eq)
+
+		(setq
+		    match   item
+		    right   to
+		)
+	    )
+
+#+debug-verbose
+	    (format t "Removing from cache {~A:~S} ~A~%"
+		(cdar cache)
+ 		(subseq line from to)
+		(syntoken-regex (caar cache)))
+
+	    (setq
+		cache	    (cdr cache)
+		item	    (car cache)
+		from	    (cadr item)
+		to	    (cddr item)
+	    )
+	)
+
+
+;-----------------------------------------------------------------------
+:parse
+#+debug-verbose
+	(format t "** Entering :PARSE~%")
+
+	(setq
+
+	    ;;  Change match value to the syntoken.
+	    match	(car match)
+
+	    begin	(syntoken-begin match)
+	    switch	(syntoken-switch match)
+	    contained	(syntoken-contained match)
+	    change	(or begin switch)
+	)
+
+	;;  Check for unmatched leading text.
+	(when (and default-property (> left start))
+#+debug-verbose (format t "No match in {(~D . ~D):~S}~%"
+		start
+		left
+		(subseq line start left)
+	    )
+	    (if
+		(or
+		    (null result)
+		    (> start (cadar result))
+		    (not (eq (cddar result) default-property)))
+		(setq
+		    result
+		    (cons
+			(cons start (cons left default-property))
+			result
+		    )
+		)
+		(rplaca (cdar result) left)
+	    )
+	)
+
+	;;  If the syntax table is not changed,
+	;; or if the new table requires that the
+	;; current default property be used.
+	(unless (and change contained)
+
+	    (and
+		(> right left)
+		(setq
+		    property
+		    (or
+			;;  If token specifies the property.
+			(syntoken-property match)
+			default-property
+		    )
+		)
+
+		;;  Add matched text.
+		(if
+		    (or
+			(null result)
+			(> left (cadar result))
+			(not (eq (cddar result) property))
+		    )
+		    (setq
+			result
+			(cons
+			    (cons left (cons right property))
+			    result
+			)
+		    )
+		    (rplaca (cdar result) right)
+		)
+	    )
+
+#+debug-verbose
+	    (format t "(0)Match found for {(~D . ~D):~S}~%"
+		left
+		right
+		(subseq line left right)
+	    )
+	)
+
+
+	;;  Update start offset in the input now!
+	(and interactive
+	    (null indent-table)
+	    (<= start (- point *from*) right)
+	    (setq indent-table syntax-table))
+	(setq start right)
+
+
+	;;  When changing the current syntax table.
+	(when change
+	    (when switch
+		(if (numberp switch)
+
+		    ;;	If returning to a previous state.
+		    ;;	Don't generate an error if the stack
+		    ;; becomes empty?
+		    (while
+			(< switch 0)
+
+			(setq
+			    syntax-table	(pop stack)
+			    token-list		(pop token-list-stack)
+			    switch		(1+ switch)
+			)
+		    )
+
+		    ;;	Else, not to a previous state, but
+		    ;; returning to a named syntax table,
+		    ;; search for it in the stack.
+		    (while
+			(and
+
+			    (setq
+				token-list	(pop token-list-stack)
+				syntax-table	(pop stack)
+			    )
+
+			    (not (eq switch syntax-table))
+			)
+			;;  Empty loop.
+		    )
+		)
+
+		;;  If no match found while popping
+		;; the stack.
+		(unless syntax-table
+
+		    ;;	Return to the topmost syntax table.
+		    (setq
+			syntax-table
+			(car (syntax-labels *syntax*))
+		    )
+		)
+
+#+debug-verbose	(format t "switching to ~A offset: ~D~%"
+		    (syntable-label syntax-table)
+		    start
+		)
+
+		(if (null token-list)
+		    (setq token-list (syntable-tokens syntax-table))
+		)
+	    )
+
+	    (when begin
+		;;  Save state for a possible
+		;; :SWITCH later.
+		(setq
+		    stack	     (cons syntax-table stack)
+		    token-list-stack (cons token-list token-list-stack)
+		    token-list	     (syntable-tokens begin)
+		    syntax-table     begin
+		)
+#+debug-verbose	(format t "begining ~A offset: ~D~%"
+		    (syntable-label syntax-table)
+		    start
+		)
+	    )
+
+	    ;;	Change current syntax table.
+	    (setq
+		default-property    (syntable-property syntax-table)
+		current-token-list  (syntable-tokens syntax-table)
+	    )
+
+	    ;;  Set newline property, to help interactive callback
+	    ;;  Only need to have a defined value, for now don't care
+	    ;; about wich value is being used, neither if there is
+	    ;; a value to be set.
+	    (if (null stack)
+		(setq newline-property nil)
+		(or newline-property
+		    (setq newline-property default-property)
+		    (setq newline-property (syntoken-property match))
+		)
+	    )
+
+	    ;; If processing of text was deferred.
+	    (when contained
+
+		(and
+		    (> right left)
+		    (setq
+			property
+			(or
+			    (syntoken-property match)
+			    default-property
+			)
+		    )
+		    ;;	Add matched text with the updated property.
+		    (if
+			(or
+			    (null result)
+			    (> left (cadar result))
+			    (not (eq (cddar result) property))
+			)
+			(setq
+			    result
+			    (cons
+				(cons left (cons right property))
+				result
+			    )
+			)
+			(rplaca (cdar result) right)
+		    )
+		)
+
+#+debug-verbose (format t "(1)Match found for {(~D . ~D):~S}~%"
+		    left
+		    right
+		    (subseq line left right)
+		)
+	    )
+
+	    (go :loop)
+	)
+
+
+;-----------------------------------------------------------------------
+	;;  Wait for the end of the line to process, so that
+	;; it is possible to join sequential matches with the
+	;; same text property.
+	(and (or cache (< start length)) (go :loop))
+:process
+
+#+debug-verbose
+	(format t "** Entering :PROCESS~%")
+
+	(if result
+	    (progn
+		;;  If the last property was at the end of the line,
+		;; there are nested syntax tables, and there is a
+		;; default property, include the newline in the property,
+		;; as a hint to the interactive callback.
+		(and
+		    newline-property
+		    (if
+			(and
+			    (eq (cddar result) newline-property)
+			    (= length (cadar result))
+			)
+			(rplaca (cdar result) (1+ length))
+			(setq
+			    result
+			    (cons
+				(cons length (cons (1+ length) newline-property))
+				result
+			    )
+			)
+		    )
+		)
+
+		;;  Result was created in reversed order.
+		(nreverse result)
+		(dolist (item result)
+		    (setq
+			left		(car item)
+			right		(cadr item)
+			property	(cddr item))
+
+		    ;; Use the information.
+		    (add-entity
+			(+ *from* left)
+			(- right left)
+			(synprop-quark property))
+		)
+	    )
+
+	    (and newline-property
+		(add-entity
+		    (+ *from* length)
+		    1
+		    (synprop-quark newline-property))
+	    )
+	)
+
+;------------------------------------------------------------------------
+:update
+	;; Prepare for new matches.
+	(setq
+	    result	nil
+
+	    ;;	Update offset to read text.
+	    ;;	Add 1 for the skipped newline.
+	    *from*	(+ *from* length 1)
+	)
+
+	(go :read)
+    )
+
+#+debug (terpri)
+    (values *to* indent-table)
+)
+
+(compile 'syntax-highlight)
diff --git a/lisp/modules/x11.c b/lisp/modules/x11.c
new file mode 100644
index 0000000..3cdb0bc
--- /dev/null
+++ b/lisp/modules/x11.c
@@ -0,0 +1,666 @@
+/*
+ * Copyright (c) 2001 by The XFree86 Project, Inc.
+ *
+ * Permission is hereby granted, free of charge, to any person obtaining a
+ * copy of this software and associated documentation files (the "Software"),
+ * to deal in the Software without restriction, including without limitation
+ * the rights to use, copy, modify, merge, publish, distribute, sublicense,
+ * and/or sell copies of the Software, and to permit persons to whom the
+ * Software is furnished to do so, subject to the following conditions:
+ *
+ * The above copyright notice and this permission notice shall be included in
+ * all copies or substantial portions of the Software.
+ *  
+ * THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
+ * IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
+ * FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT.  IN NO EVENT SHALL
+ * THE XFREE86 PROJECT BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY,
+ * WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF
+ * OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE
+ * SOFTWARE.
+ *
+ * Except as contained in this notice, the name of the XFree86 Project shall
+ * not be used in advertising or otherwise to promote the sale, use or other
+ * dealings in this Software without prior written authorization from the
+ * XFree86 Project.
+ *
+ * Author: Paulo César Pereira de Andrade
+ */
+
+/* $XFree86: xc/programs/xedit/lisp/modules/x11.c,v 1.10 2002/11/23 08:26:52 paulo Exp $ */
+
+#include <stdlib.h>
+#include <string.h>
+#include "internal.h"
+#include "private.h"
+#include <X11/Xlib.h>
+
+/*
+ * Prototypes
+ */
+int x11LoadModule(void);
+
+LispObj *Lisp_XOpenDisplay(LispBuiltin *builtin);
+LispObj *Lisp_XCloseDisplay(LispBuiltin *builtin);
+LispObj *Lisp_XDefaultRootWindow(LispBuiltin *builtin);
+LispObj *Lisp_XDefaultScreen(LispBuiltin *builtin);
+LispObj *Lisp_XDefaultScreenOfDisplay(LispBuiltin *builtin);
+LispObj *Lisp_XBlackPixel(LispBuiltin *builtin);
+LispObj *Lisp_XBlackPixelOfScreen(LispBuiltin *builtin);
+LispObj *Lisp_XWidthOfScreen(LispBuiltin *builtin);
+LispObj *Lisp_XHeightOfScreen(LispBuiltin *builtin);
+LispObj *Lisp_XWhitePixel(LispBuiltin *builtin);
+LispObj *Lisp_XWhitePixelOfScreen(LispBuiltin *builtin);
+LispObj *Lisp_XDefaultGC(LispBuiltin *builtin);
+LispObj *Lisp_XDefaultGCOfScreen(LispBuiltin *builtin);
+LispObj *Lisp_XCreateSimpleWindow(LispBuiltin *builtin);
+LispObj *Lisp_XMapWindow(LispBuiltin *builtin);
+LispObj *Lisp_XDestroyWindow(LispBuiltin *builtin);
+LispObj *Lisp_XFlush(LispBuiltin *builtin);
+LispObj *Lisp_XRaiseWindow(LispBuiltin *builtin);
+LispObj *Lisp_XBell(LispBuiltin *builtin);
+
+LispObj *Lisp_XDrawLine(LispBuiltin *builtin);
+
+/*
+ * Initialization
+ */
+static LispBuiltin lispbuiltins[] = {
+    {LispFunction, Lisp_XOpenDisplay, "x-open-display &optional display-name"},
+    {LispFunction, Lisp_XCloseDisplay, "x-close-display display"},
+    {LispFunction, Lisp_XDefaultRootWindow, "x-default-root-window display"},
+    {LispFunction, Lisp_XDefaultScreen, "x-default-screen display"},
+    {LispFunction, Lisp_XDefaultScreenOfDisplay, "x-default-screen-of-display display"},
+    {LispFunction, Lisp_XBlackPixel, "x-black-pixel display &optional screen"},
+    {LispFunction, Lisp_XBlackPixelOfScreen, "x-black-pixel-of-screen screen"},
+    {LispFunction, Lisp_XWhitePixel, "x-white-pixel display &optional screen"},
+    {LispFunction, Lisp_XWhitePixelOfScreen, "x-white-pixel-of-screen screen"},
+    {LispFunction, Lisp_XDefaultGC, "x-default-gc display &optional screen"},
+    {LispFunction, Lisp_XDefaultGCOfScreen, "x-default-gc-of-screen screen"},
+    {LispFunction, Lisp_XCreateSimpleWindow, "x-create-simple-window display parent x y width height &optional border-width border background"},
+    {LispFunction, Lisp_XMapWindow, "x-map-window display window"},
+    {LispFunction, Lisp_XDestroyWindow, "X-DESTROY-WINDOW"},
+    {LispFunction, Lisp_XFlush, "x-flush display"},
+    {LispFunction, Lisp_XDrawLine, "x-draw-line display drawable gc x1 y1 x2 y2"},
+    {LispFunction, Lisp_XBell, "x-bell display &optional percent"},
+    {LispFunction, Lisp_XRaiseWindow, "x-raise-window display window"},
+    {LispFunction, Lisp_XWidthOfScreen, "x-width-of-screen screen"},
+    {LispFunction, Lisp_XHeightOfScreen, "x-height-of-screen screen"},
+};
+
+LispModuleData x11LispModuleData = {
+    LISP_MODULE_VERSION,
+    x11LoadModule
+};
+
+static int x11Display_t, x11Screen_t, x11Window_t, x11GC_t;
+
+/*
+ * Implementation
+ */
+int
+x11LoadModule(void)
+{
+    int i;
+
+    x11Display_t = LispRegisterOpaqueType("Display*");
+    x11Screen_t = LispRegisterOpaqueType("Screen*");
+    x11Window_t = LispRegisterOpaqueType("Window");
+    x11GC_t = LispRegisterOpaqueType("GC");
+
+    for (i = 0; i < sizeof(lispbuiltins) / sizeof(lispbuiltins[0]); i++)
+	LispAddBuiltinFunction(&lispbuiltins[i]);
+
+    return (1);
+}
+
+LispObj *
+Lisp_XOpenDisplay(LispBuiltin *builtin)
+/*
+x-open-display &optional display-name
+ */
+{
+    LispObj *display_name;
+    char *dname;
+
+    display_name = ARGUMENT(0);
+
+    if (display_name == UNSPEC)
+	dname = NULL;
+    else {
+	CHECK_STRING(display_name);
+	dname = THESTR(display_name);
+    }
+
+    return (OPAQUE(XOpenDisplay(dname), x11Display_t));
+}
+
+LispObj *
+Lisp_XCloseDisplay(LispBuiltin *builtin)
+/*
+ x-close-display display
+ */
+{
+    LispObj *display;
+
+    display = ARGUMENT(0);
+
+    if (!CHECKO(display, x11Display_t))
+	LispDestroy("%s: cannot convert %s to Display*",
+		    STRFUN(builtin), STROBJ(display));
+
+    XCloseDisplay((Display*)(display->data.opaque.data));
+
+    return (NIL);
+}
+
+LispObj *
+Lisp_XDefaultRootWindow(LispBuiltin *builtin)
+/*
+ x-default-root-window display
+ */
+{
+    LispObj *display;
+
+    display = ARGUMENT(0);
+
+    if (!CHECKO(display, x11Display_t))
+	LispDestroy("%s: cannot convert %s to Display*",
+		    STRFUN(builtin), STROBJ(display));
+
+    return (OPAQUE(DefaultRootWindow((Display*)(display->data.opaque.data)),
+		   x11Window_t));
+}
+
+LispObj *
+Lisp_XDefaultScreen(LispBuiltin *builtin)
+/*
+ x-default-screen display
+ */
+{
+    LispObj *display;
+
+    display = ARGUMENT(0);
+
+    if (!CHECKO(display, x11Display_t))
+	LispDestroy("%s: cannot convert %s to Display*",
+		    STRFUN(builtin), STROBJ(display));
+
+    return (INTEGER(DefaultScreen((Display*)(display->data.opaque.data))));
+}
+
+LispObj *
+Lisp_XDefaultScreenOfDisplay(LispBuiltin *builtin)
+/*
+ x-default-screen-of-display display
+ */
+{
+    LispObj *display;
+
+    display = ARGUMENT(0);
+
+    if (!CHECKO(display, x11Display_t))
+	LispDestroy("%s: cannot convert %s to Display*",
+		    STRFUN(builtin), STROBJ(display));
+
+    return (OPAQUE(DefaultScreenOfDisplay((Display*)(display->data.opaque.data)),
+		   x11Screen_t));
+}
+
+LispObj *
+Lisp_XBlackPixel(LispBuiltin *builtin)
+/*
+ x-black-pixel display &optional screen
+ */
+{
+    Display *display;
+    int screen;
+
+    LispObj *odisplay, *oscreen;
+
+    oscreen = ARGUMENT(1);
+    odisplay = ARGUMENT(0);
+
+    if (!CHECKO(odisplay, x11Display_t))
+	LispDestroy("%s: cannot convert %s to Display*",
+		    STRFUN(builtin), STROBJ(odisplay));
+    display = (Display*)(odisplay->data.opaque.data);
+
+    if (oscreen == UNSPEC)
+	screen = DefaultScreen(display);
+    else
+	CHECK_INDEX(oscreen);
+    else
+	screen = FIXNUM_VALUE(oscreen);
+
+    if (screen >= ScreenCount(display))
+	LispDestroy("%s: screen index %d too large, %d screens available",
+		    STRFUN(builtin), screen, ScreenCount(display));
+
+    return (INTEGER(BlackPixel(display, screen)));
+}
+
+LispObj *
+Lisp_XBlackPixelOfScreen(LispBuiltin *builtin)
+/*
+ x-black-pixel-of-screen screen
+ */
+{
+    LispObj *screen;
+
+    screen = ARGUMENT(0);
+
+    if (!CHECKO(screen, x11Screen_t))
+	LispDestroy("%s: cannot convert %s to Screen*",
+		    STRFUN(builtin), STROBJ(screen));
+
+    return (INTEGER(XBlackPixelOfScreen((Screen*)(screen->data.opaque.data))));
+}
+
+LispObj *
+Lisp_XWhitePixel(LispBuiltin *builtin)
+/*
+ x-white-pixel display &optional screen
+ */
+{
+    Display *display;
+    int screen;
+
+    LispObj *odisplay, *oscreen;
+
+    oscreen = ARGUMENT(1);
+    odisplay = ARGUMENT(0);
+
+    if (!CHECKO(odisplay, x11Display_t))
+	LispDestroy("%s: cannot convert %s to Display*",
+		    STRFUN(builtin), STROBJ(odisplay));
+    display = (Display*)(odisplay->data.opaque.data);
+
+    if (oscreen == UNSPEC)
+	screen = DefaultScreen(display);
+    else
+	CHECK_FIXNUM(oscreen);
+    else
+	screen = FIXNUM_VALUE(oscreen);
+
+    if (screen >= ScreenCount(display))
+	LispDestroy("%s: screen index %d too large, %d screens available",
+		    STRFUN(builtin), screen, ScreenCount(display));
+
+    return (INTEGER(WhitePixel(display, screen)));
+}
+
+LispObj *
+Lisp_XWhitePixelOfScreen(LispBuiltin *builtin)
+/*
+ x-white-pixel-of-screen screen
+ */
+{
+    LispObj *screen;
+
+    screen = ARGUMENT(0);
+
+    if (!CHECKO(screen, x11Screen_t))
+	LispDestroy("%s: cannot convert %s to Screen*",
+		    STRFUN(builtin), STROBJ(screen));
+
+    return (INTEGER(WhitePixelOfScreen((Screen*)(screen->data.opaque.data))));
+}
+
+LispObj *
+Lisp_XDefaultGC(LispBuiltin *builtin)
+/*
+ x-default-gc display &optional screen
+ */
+{
+    Display *display;
+    int screen;
+
+    LispObj *odisplay, *oscreen;
+
+    oscreen = ARGUMENT(1);
+    odisplay = ARGUMENT(0);
+
+    if (!CHECKO(odisplay, x11Display_t))
+	LispDestroy("%s: cannot convert %s to Display*",
+		    STRFUN(builtin), STROBJ(odisplay));
+    display = (Display*)(odisplay->data.opaque.data);
+
+    if (oscreen == UNSPEC)
+	screen = DefaultScreen(display);
+    else
+	CHECK_FIXNUM(oscreen);
+    else
+	screen = FIXNUM_VALUE(oscreen);
+
+    if (screen >= ScreenCount(display))
+	LispDestroy("%s: screen index %d too large, %d screens available",
+		    STRFUN(builtin), screen, ScreenCount(display));
+
+    return (OPAQUE(DefaultGC(display, screen), x11GC_t));
+}
+
+LispObj *
+Lisp_XDefaultGCOfScreen(LispBuiltin *builtin)
+/*
+ x-default-gc-of-screen screen
+ */
+{
+    LispObj *screen;
+
+    screen = ARGUMENT(0);
+
+    if (!CHECKO(screen, x11Screen_t))
+	LispDestroy("%s: cannot convert %s to Screen*",
+		    STRFUN(builtin), STROBJ(screen));
+
+    return (OPAQUE(DefaultGCOfScreen((Screen*)(screen->data.opaque.data)),
+		   x11GC_t));
+}
+
+LispObj *
+Lisp_XCreateSimpleWindow(LispBuiltin *builtin)
+/*
+ x-create-simple-window display parent x y width height &optional border-width border background
+ */
+{
+    Display *display;
+    Window parent;
+    int x, y;
+    unsigned int width, height, border_width;
+    unsigned long border, background;
+
+    LispObj *odisplay, *oparent, *ox, *oy, *owidth, *oheight,
+	    *oborder_width, *oborder, *obackground;
+
+    obackground = ARGUMENT(8);
+    oborder = ARGUMENT(7);
+    oborder_width = ARGUMENT(6);
+    oheight = ARGUMENT(5);
+    owidth = ARGUMENT(4);
+    oy = ARGUMENT(3);
+    ox = ARGUMENT(2);
+    oparent = ARGUMENT(1);
+    odisplay = ARGUMENT(0);
+
+    if (!CHECKO(odisplay, x11Display_t))
+	LispDestroy("%s: cannot convert %s to Display*",
+		    STRFUN(builtin), STROBJ(odisplay));
+    display = (Display*)(odisplay->data.opaque.data);
+
+    if (!CHECKO(oparent, x11Window_t))
+	LispDestroy("%s: cannot convert %s to Window",
+		    STRFUN(builtin), STROBJ(oparent));
+    parent = (Window)(oparent->data.opaque.data);
+
+    CHECK_FIXNUM(ox);
+    x = FIXNUM_VALUE(ox);
+
+    CHECK_FIXNUM(oy);
+    y = FIXNUM_VALUE(oy);
+
+    CHECK_INDEX(owidth);
+    width = FIXNUM_VALUE(owidth);
+
+    CHECK_INDEX(oheight);
+    height = FIXNUM_VALUE(oheight);
+
+    /* check &OPTIONAL parameters */
+    if (oborder_width == UNSPEC)
+	border_width = 1;
+    else
+	CHECK_INDEX(oborder_width);
+    else
+	border_width = FIXNUM_VALUE(oborder_width);
+
+    if (oborder == UNSPEC)
+	border = BlackPixel(display, DefaultScreen(display));
+    else
+	CHECK_LONGINT(oborder);
+    else
+	border = LONGINT_VALUE(oborder);
+
+    if (obackground == UNSPEC)
+	background = WhitePixel(display, DefaultScreen(display));
+    else
+	CHECK_LONGINT(obackground);
+    else
+	background = LONGINT_VALUE(obackground);
+
+    return (OPAQUE(
+	    XCreateSimpleWindow(display, parent, x, y, width, height,
+				border_width, border, background),
+	    x11Window_t));
+}
+
+LispObj *
+Lisp_XMapWindow(LispBuiltin *builtin)
+/*
+ x-map-window display window
+ */
+{
+    Display *display;
+    Window window;
+
+    LispObj *odisplay, *owindow;
+
+    owindow = ARGUMENT(1);
+    odisplay = ARGUMENT(0);
+
+    if (!CHECKO(odisplay, x11Display_t))
+	LispDestroy("%s: cannot convert %s to Display*",
+		    STRFUN(builtin), STROBJ(odisplay));
+    display = (Display*)(odisplay->data.opaque.data);
+
+    if (!CHECKO(owindow, x11Window_t))
+	LispDestroy("%s: cannot convert %s to Window",
+		    STRFUN(builtin), STROBJ(owindow));
+    window = (Window)(owindow->data.opaque.data);
+
+    XMapWindow(display, window);
+
+    return (owindow);
+}
+
+LispObj *
+Lisp_XDestroyWindow(LispBuiltin *builtin)
+/*
+ x-destroy-window display window
+ */
+{
+    Display *display;
+    Window window;
+
+    LispObj *odisplay, *owindow;
+
+    owindow = ARGUMENT(1);
+    odisplay = ARGUMENT(0);
+
+    if (!CHECKO(odisplay, x11Display_t))
+	LispDestroy("%s: cannot convert %s to Display*",
+		    STRFUN(builtin), STROBJ(odisplay));
+    display = (Display*)(odisplay->data.opaque.data);
+
+    if (!CHECKO(owindow, x11Window_t))
+	LispDestroy("%s: cannot convert %s to Window",
+		    STRFUN(builtin), STROBJ(owindow));
+    window = (Window)(owindow->data.opaque.data);
+
+    XDestroyWindow(display, window);
+
+    return (NIL);
+}
+
+LispObj *
+Lisp_XFlush(LispBuiltin *builtin)
+/*
+ x-flush display
+ */
+{
+    Display *display;
+
+    LispObj *odisplay;
+
+    odisplay = ARGUMENT(0);
+
+    if (!CHECKO(odisplay, x11Display_t))
+	LispDestroy("%s: cannot convert %s to Display*",
+		    STRFUN(builtin), STROBJ(odisplay));
+    display = (Display*)(odisplay->data.opaque.data);
+
+    XFlush(display);
+
+    return (odisplay);
+}
+
+LispObj *
+Lisp_XDrawLine(LispBuiltin *builtin)
+/*
+ x-draw-line display drawable gc x1 y1 x2 y2
+ */
+{
+    Display *display;
+    Drawable drawable;
+    GC gc;
+    int x1, y1, x2, y2;
+
+    LispObj *odisplay, *odrawable, *ogc, *ox1, *oy1, *ox2, *oy2;
+
+    oy2 = ARGUMENT(6);
+    ox2 = ARGUMENT(5);
+    oy1 = ARGUMENT(4);
+    ox1 = ARGUMENT(3);
+    ogc = ARGUMENT(2);
+    odrawable = ARGUMENT(1);
+    odisplay = ARGUMENT(0);
+
+    if (!CHECKO(odisplay, x11Display_t))
+	LispDestroy("%s: cannot convert %s to Display*",
+		    STRFUN(builtin), STROBJ(odisplay));
+    display = (Display*)(odisplay->data.opaque.data);
+
+    /* XXX correct check when drawing to pixmaps implemented */
+    if (!CHECKO(odrawable, x11Window_t))
+	LispDestroy("%s: cannot convert %s to Drawable",
+		    STRFUN(builtin), STROBJ(odrawable));
+    drawable = (Drawable)(odrawable->data.opaque.data);
+
+    if (!CHECKO(ogc, x11GC_t))
+	LispDestroy("%s: cannot convert %s to Display*",
+		    STRFUN(builtin), STROBJ(ogc));
+    gc = (GC)(ogc->data.opaque.data);
+
+    CHECK_FIXNUM(ox1);
+    x1 = FIXNUM_VALUE(ox1);
+
+    CHECK_FIXNUM(oy1);
+    y1 = FIXNUM_VALUE(oy1);
+
+    CHECK_FIXNUM(ox2);
+    x2 = FIXNUM_VALUE(ox2);
+
+    CHECK_FIXNUM(oy2);
+    y2 = FIXNUM_VALUE(oy2);
+
+    XDrawLine(display, drawable, gc, x1, y1, x2, y2);
+
+    return (odrawable);
+}
+
+LispObj *
+Lisp_XBell(LispBuiltin *builtin)
+/*
+ x-bell &optional percent
+ */
+{
+    Display *display;
+    int percent;
+
+    LispObj *odisplay, *opercent;
+
+    opercent = ARGUMENT(1);
+    odisplay = ARGUMENT(0);
+
+    if (!CHECKO(odisplay, x11Display_t))
+	LispDestroy("%s: cannot convert %s to Display*",
+		    STRFUN(builtin), STROBJ(odisplay));
+    display = (Display*)(odisplay->data.opaque.data);
+
+    if (opercent == UNSPEC)
+	percent = 0;
+    else
+	CHECK_FIXNUM(opercent);
+    else
+	percent = FIXNUM_VALUE(opercent);
+
+    if (percent < -100 || percent > 100)
+	LispDestroy("%s: percent value %d out of range -100 to 100",
+		    STRFUN(builtin), percent);
+
+    XBell(display, percent);
+
+    return (odisplay);
+}
+
+LispObj *
+Lisp_XRaiseWindow(LispBuiltin *builtin)
+/*
+ x-raise-window display window
+ */
+{
+    Display *display;
+    Window window;
+
+    LispObj *odisplay, *owindow;
+
+    owindow = ARGUMENT(1);
+    odisplay = ARGUMENT(0);
+
+    if (!CHECKO(odisplay, x11Display_t))
+	LispDestroy("%s: cannot convert %s to Display*",
+		    STRFUN(builtin), STROBJ(odisplay));
+    display = (Display*)(odisplay->data.opaque.data);
+
+    if (!CHECKO(owindow, x11Window_t))
+	LispDestroy("%s: cannot convert %s to Window",
+		    STRFUN(builtin), STROBJ(owindow));
+    window = (Window)(owindow->data.opaque.data);
+
+    XRaiseWindow(display, window);
+
+    return (owindow);
+}
+
+LispObj *
+Lisp_XWidthOfScreen(LispBuiltin *builtin)
+/*
+ x-width-of-screen screen
+ */
+{
+    LispObj *screen;
+
+    screen = ARGUMENT(0);
+
+    if (!CHECKO(screen, x11Screen_t))
+	LispDestroy("%s: cannot convert %s to Screen*",
+		    STRFUN(builtin), STROBJ(screen));
+
+    return (FIXNUM(WidthOfScreen((Screen*)(screen->data.opaque.data))));
+}
+
+LispObj *
+Lisp_XHeightOfScreen(LispBuiltin *builtin)
+/*
+ x-height-of-screen screen
+ */
+{
+    LispObj *screen;
+
+    screen = ARGUMENT(0);
+
+    if (!CHECKO(screen, x11Screen_t))
+	LispDestroy("%s: cannot convert %s to Screen*",
+		    STRFUN(builtin), STROBJ(screen));
+
+    return (FIXNUM(HeightOfScreen((Screen*)(screen->data.opaque.data))));
+}
diff --git a/lisp/modules/xaw.c b/lisp/modules/xaw.c
new file mode 100644
index 0000000..c2b372b
--- /dev/null
+++ b/lisp/modules/xaw.c
@@ -0,0 +1,665 @@
+/*
+ * Copyright (c) 2001 by The XFree86 Project, Inc.
+ *
+ * Permission is hereby granted, free of charge, to any person obtaining a
+ * copy of this software and associated documentation files (the "Software"),
+ * to deal in the Software without restriction, including without limitation
+ * the rights to use, copy, modify, merge, publish, distribute, sublicense,
+ * and/or sell copies of the Software, and to permit persons to whom the
+ * Software is furnished to do so, subject to the following conditions:
+ *
+ * The above copyright notice and this permission notice shall be included in
+ * all copies or substantial portions of the Software.
+ *  
+ * THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
+ * IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
+ * FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT.  IN NO EVENT SHALL
+ * THE XFREE86 PROJECT BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY,
+ * WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF
+ * OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE
+ * SOFTWARE.
+ *
+ * Except as contained in this notice, the name of the XFree86 Project shall
+ * not be used in advertising or otherwise to promote the sale, use or other
+ * dealings in this Software without prior written authorization from the
+ * XFree86 Project.
+ *
+ * Author: Paulo César Pereira de Andrade
+ */
+
+/* $XFree86: xc/programs/xedit/lisp/modules/xaw.c,v 1.14 2002/11/23 08:26:52 paulo Exp $ */
+
+#include <stdlib.h>
+#include <X11/Intrinsic.h>
+#include <X11/StringDefs.h>
+#include <X11/Xaw/AsciiSink.h>
+#include <X11/Xaw/AsciiSrc.h>
+#include <X11/Xaw/AsciiText.h>
+#include <X11/Xaw/Box.h>
+#include <X11/Xaw/Command.h>
+#include <X11/Xaw/Dialog.h>
+#include <X11/Xaw/Form.h>
+#include <X11/Xaw/Grip.h>
+#include <X11/Xaw/Label.h>
+#include <X11/Xaw/List.h>
+#include <X11/Xaw/MenuButton.h>
+#include <X11/Xaw/MultiSink.h>
+#include <X11/Xaw/MultiSrc.h>
+#include <X11/Xaw/Paned.h>
+#include <X11/Xaw/Panner.h>
+#include <X11/Xaw/Porthole.h>
+#include <X11/Xaw/Repeater.h>
+#include <X11/Xaw/Scrollbar.h>
+#include <X11/Xaw/Simple.h>
+#include <X11/Xaw/SimpleMenu.h>
+#include <X11/Xaw/SmeBSB.h>
+#include <X11/Xaw/Sme.h>
+#include <X11/Xaw/SmeLine.h>
+#include <X11/Xaw/StripChart.h>
+#include <X11/Xaw/Text.h>
+#include <X11/Xaw/TextSink.h>
+#include <X11/Xaw/TextSrc.h>
+#include <X11/Xaw/Tip.h>
+#include <X11/Xaw/Toggle.h>
+#include <X11/Xaw/Tree.h>
+#include <X11/Xaw/Viewport.h>
+#include <X11/Vendor.h>
+#include "internal.h"
+#include "private.h"
+
+/*
+ * Types
+ */
+typedef struct {
+    LispObj *object;
+    void *data;
+} WidgetData;
+
+/*
+ * Prototypes
+ */
+int xawLoadModule(void);
+void LispXawCleanupCallback(Widget, XtPointer, XtPointer);
+
+/* until a better/smarter interface be written... */
+LispObj *Lisp_XawCoerceToListReturnStruct(LispBuiltin*);
+LispObj *Lisp_XawScrollbarCoerceToReal(LispBuiltin*);
+
+LispObj *Lisp_XawFormDoLayout(LispBuiltin*);
+LispObj *Lisp_XawListChange(LispBuiltin*);
+LispObj *Lisp_XawListHighlight(LispBuiltin*);
+LispObj *Lisp_XawListUnhighlight(LispBuiltin*);
+LispObj *Lisp_XawTextGetSource(LispBuiltin*);
+LispObj *Lisp_XawTextLastPosition(LispBuiltin*);
+LispObj *Lisp_XawTextReplace(LispBuiltin*);
+LispObj *Lisp_XawTextSearch(LispBuiltin*);
+LispObj *Lisp_XawTextGetInsertionPoint(LispBuiltin*);
+LispObj *Lisp_XawTextSetInsertionPoint(LispBuiltin*);
+LispObj *Lisp_XawScrollbarSetThumb(LispBuiltin*);
+
+/*
+ * Initialization
+ */
+
+static LispBuiltin lispbuiltins[] = {
+    {LispFunction, Lisp_XawCoerceToListReturnStruct, "xaw-coerce-to-list-return-struct opaque"},
+    {LispFunction, Lisp_XawScrollbarCoerceToReal, "xaw-scrollbar-coerce-to-real opaque"},
+
+    {LispFunction, Lisp_XawScrollbarSetThumb, "xaw-scrollbar-set-thumb widget top &optional shown"},
+    {LispFunction, Lisp_XawFormDoLayout, "xaw-form-do-layout widget force"},
+    {LispFunction, Lisp_XawListChange, "xaw-list-change widget list &optional longest resize"},
+    {LispFunction, Lisp_XawListHighlight, "xaw-list-highlight widget index"},
+    {LispFunction, Lisp_XawListUnhighlight, "xaw-list-unhighlight widget"},
+    {LispFunction, Lisp_XawTextGetSource, "xaw-text-get-source widget"},
+    {LispFunction, Lisp_XawTextLastPosition, "xaw-text-last-position widget"},
+    {LispFunction, Lisp_XawTextReplace, "xaw-text-replace widget left right text"},
+    {LispFunction, Lisp_XawTextSearch, "xaw-text-search widget direction text"},
+    {LispFunction, Lisp_XawTextGetInsertionPoint, "xaw-text-get-insertion-point widget"},
+    {LispFunction, Lisp_XawTextSetInsertionPoint, "xaw-text-set-insertion-point widget position"},
+};
+
+LispModuleData xawLispModuleData = {
+    LISP_MODULE_VERSION,
+    xawLoadModule
+};
+
+static int xawWidget_t, xawWidgetClass_t, xawListReturnStruct_t, xawFloatp_t;
+static WidgetData **list_data;
+static int num_list_data;
+
+/*
+ * Implementation
+ */
+int
+xawLoadModule(void)
+{
+    int i;
+    char *fname = "XAW-LOAD-MODULE";
+
+    xawWidget_t = LispRegisterOpaqueType("Widget");
+    xawWidgetClass_t = LispRegisterOpaqueType("WidgetClass");
+    xawListReturnStruct_t = LispRegisterOpaqueType("XawListReturnStruct");
+    xawFloatp_t = LispRegisterOpaqueType("float*");
+
+    LispExecute("(DEFSTRUCT XAW-LIST-RETURN-STRUCT STRING INDEX)\n");
+
+    GCDisable();
+    (void)LispSetVariable(ATOM2("ASCII-SINK-OBJECT-CLASS"),
+			  OPAQUE(asciiSinkObjectClass, xawWidgetClass_t),
+			  fname, 0);
+    (void)LispSetVariable(ATOM2("ASCII-SRC-OBJECT-CLASS"),
+			  OPAQUE(asciiSinkObjectClass, xawWidgetClass_t),
+			  fname, 0);
+    (void)LispSetVariable(ATOM2("ASCII-TEXT-WIDGET-CLASS"),
+			  OPAQUE(asciiTextWidgetClass, xawWidgetClass_t),
+			  fname, 0);
+    (void)LispSetVariable(ATOM2("BOX-WIDGET-CLASS"),
+			  OPAQUE(boxWidgetClass, xawWidgetClass_t),
+			  fname, 0);
+    (void)LispSetVariable(ATOM2("COMMAND-WIDGET-CLASS"),
+			  OPAQUE(commandWidgetClass, xawWidgetClass_t),
+			  fname, 0);
+    (void)LispSetVariable(ATOM2("DIALOG-WIDGET-CLASS"),
+			  OPAQUE(dialogWidgetClass, xawWidgetClass_t),
+			  fname, 0);
+    (void)LispSetVariable(ATOM2("FORM-WIDGET-CLASS"),
+			  OPAQUE(formWidgetClass, xawWidgetClass_t),
+			  fname, 0);
+    (void)LispSetVariable(ATOM2("GRIP-WIDGET-CLASS"),
+			  OPAQUE(gripWidgetClass, xawWidgetClass_t),
+			  fname, 0);
+    (void)LispSetVariable(ATOM2("LABEL-WIDGET-CLASS"),
+			  OPAQUE(labelWidgetClass, xawWidgetClass_t),
+			  fname, 0);
+    (void)LispSetVariable(ATOM2("LIST-WIDGET-CLASS"),
+			  OPAQUE(listWidgetClass, xawWidgetClass_t),
+			  fname, 0);
+    (void)LispSetVariable(ATOM2("MENU-BUTTON-WIDGET-CLASS"),
+			  OPAQUE(menuButtonWidgetClass, xawWidgetClass_t),
+			  fname, 0);
+    (void)LispSetVariable(ATOM2("MULTI-SINK-OBJEC-TCLASS"),
+			  OPAQUE(multiSinkObjectClass, xawWidgetClass_t),
+			  fname, 0);
+    (void)LispSetVariable(ATOM2("MULTI-SRC-OBJECT-CLASS"),
+			  OPAQUE(multiSrcObjectClass, xawWidgetClass_t),
+			  fname, 0);
+    (void)LispSetVariable(ATOM2("PANED-WIDGET-CLASS"),
+			  OPAQUE(panedWidgetClass, xawWidgetClass_t),
+			  fname, 0);
+    (void)LispSetVariable(ATOM2("PANNER-WIDGET-CLASS"),
+			  OPAQUE(pannerWidgetClass, xawWidgetClass_t),
+			  fname, 0);
+    (void)LispSetVariable(ATOM2("PORTHOLE-WIDGET-CLASS"),
+			  OPAQUE(portholeWidgetClass, xawWidgetClass_t),
+			  fname, 0);
+    (void)LispSetVariable(ATOM2("REPEATER-WIDGET-CLASS"),
+			  OPAQUE(repeaterWidgetClass, xawWidgetClass_t),
+			  fname, 0);
+    (void)LispSetVariable(ATOM2("SCROLLBAR-WIDGET-CLASS"),
+			  OPAQUE(scrollbarWidgetClass, xawWidgetClass_t),
+			  fname, 0);
+    (void)LispSetVariable(ATOM2("SIMPLE-MENU-WIDGET-CLASS"),
+			  OPAQUE(simpleMenuWidgetClass, xawWidgetClass_t),
+			  fname, 0);
+    (void)LispSetVariable(ATOM2("SIMPLE-WIDGET-CLASS"),
+			  OPAQUE(simpleWidgetClass, xawWidgetClass_t),
+			  fname, 0);
+    (void)LispSetVariable(ATOM2("SME-BSB-OBJECT-CLASS"),
+			  OPAQUE(smeBSBObjectClass, xawWidgetClass_t),
+			  fname, 0);
+    (void)LispSetVariable(ATOM2("SME-LINE-OBJECT-CLASS"),
+			  OPAQUE(smeLineObjectClass, xawWidgetClass_t),
+			  fname, 0);
+    (void)LispSetVariable(ATOM2("SME-OBJECT-CLASS"),
+			  OPAQUE(smeObjectClass, xawWidgetClass_t),
+			  fname, 0);
+    (void)LispSetVariable(ATOM2("STRIP-CHART-WIDGET-CLASS"),
+			  OPAQUE(stripChartWidgetClass, xawWidgetClass_t),
+			  fname, 0);
+    (void)LispSetVariable(ATOM2("TEXT-WIDGET-CLASS"),
+			  OPAQUE(textWidgetClass, xawWidgetClass_t),
+			  fname, 0);
+    (void)LispSetVariable(ATOM2("TEXT-SINKOBJECT-CLASS"),
+			  OPAQUE(textSinkObjectClass, xawWidgetClass_t),
+			  fname, 0);
+    (void)LispSetVariable(ATOM2("TEXT-SRC-OBJECT-CLASS"),
+			  OPAQUE(textSrcObjectClass, xawWidgetClass_t),
+			  fname, 0);
+    (void)LispSetVariable(ATOM2("TIP-WIDGET-CLASS"),
+			  OPAQUE(tipWidgetClass, xawWidgetClass_t),
+			  fname, 0);
+    (void)LispSetVariable(ATOM2("TOGGLE-WIDGET-CLASS"),
+			  OPAQUE(toggleWidgetClass, xawWidgetClass_t),
+			  fname, 0);
+    (void)LispSetVariable(ATOM2("TREE-WIDGET-CLASS"),
+			  OPAQUE(treeWidgetClass, xawWidgetClass_t),
+			  fname, 0);
+    (void)LispSetVariable(ATOM2("VIEWPORT-WIDGET-CLASS"),
+			  OPAQUE(viewportWidgetClass, xawWidgetClass_t),
+			  fname, 0);
+    (void)LispSetVariable(ATOM2("VENDOR-SHELL-WIDGET-CLASS"),
+			  OPAQUE(vendorShellWidgetClass, xawWidgetClass_t),
+			  fname, 0);
+
+    /* return codes of XawTextReplace */
+    (void)LispSetVariable(ATOM2("XAW-REPLACE-ERROR"),
+			  INTEGER(XawReplaceError), fname, 0);
+    (void)LispSetVariable(ATOM2("XAW-EDIT-DONE"),
+			  INTEGER(XawEditDone), fname, 0);
+    (void)LispSetVariable(ATOM2("XAW-EDIT-ERROR"),
+			  INTEGER(XawEditError), fname, 0);
+    (void)LispSetVariable(ATOM2("XAW-POSITION-ERROR"),
+			  INTEGER(XawPositionError), fname, 0);
+
+    /* return code of XawTextSearch */
+    (void)LispSetVariable(ATOM2("XAW-TEXT-SEARCH-ERROR"),
+			  INTEGER(XawTextSearchError), fname, 0);
+
+    /* enum XawTextScanDirection */
+    (void)LispSetVariable(ATOM2("XAWSD-LEFT"),
+			  INTEGER(XawsdLeft), fname, 0);
+    (void)LispSetVariable(ATOM2("XAWSD-RIGHT"),
+			  INTEGER(XawsdRight), fname, 0);
+    GCEnable();
+
+    for (i = 0; i < sizeof(lispbuiltins) / sizeof(lispbuiltins[0]); i++)
+	LispAddBuiltinFunction(&lispbuiltins[i]);
+
+    return (1);
+}
+
+void
+LispXawCleanupCallback(Widget w, XtPointer user_data, XtPointer call_data)
+{
+    WidgetData *data = (WidgetData*)user_data;
+
+    UPROTECT(CAR(data->object), data->object);
+    XtFree((XtPointer)data->data);
+    XtFree((XtPointer)data);
+}
+
+LispObj *
+Lisp_XawCoerceToListReturnStruct(LispBuiltin *builtin)
+/*
+ xaw-coerce-to-list-return-struct opaque
+ */
+{
+    LispObj *result, *code, *ocod = COD;
+    XawListReturnStruct *retlist;
+
+    LispObj *opaque;
+
+    opaque = ARGUMENT(0);
+
+    if (!CHECKO(opaque, xawListReturnStruct_t))
+	LispDestroy("%s: cannot convert %s to XawListReturnStruct",
+		    STRFUN(builtin), STROBJ(opaque));
+
+    retlist = (XawListReturnStruct*)(opaque->data.opaque.data);
+
+    GCDisable();
+    code = CONS(ATOM("MAKE-XAW-LIST-RETURN-STRUCT"),
+		CONS(KEYWORD("STRING"),
+		       CONS(STRING(retlist->string),
+			    CONS(KEYWORD("INDEX"),
+				 CONS(INTEGER(retlist->list_index), NIL)))));
+    COD = CONS(code, COD);
+    GCEnable();
+
+    result = EVAL(code);
+    COD = ocod;
+
+    return (result);
+}
+
+LispObj *
+Lisp_XawScrollbarCoerceToReal(LispBuiltin *builtin)
+/*
+ xaw-scrollbar-coerce-to-real opaque
+ */
+{
+    LispObj *result;
+    float *floatp;
+    double real;
+
+    LispObj *opaque;
+
+    opaque = ARGUMENT(0);
+
+    if (!CHECKO(opaque, xawFloatp_t))
+	LispDestroy("%s: cannot convert %s to float*",
+		    STRFUN(builtin), STROBJ(opaque));
+
+    floatp = (float*)(opaque->data.opaque.data);
+    real = *floatp;
+
+    return (DFLOAT(real));
+}
+
+LispObj *
+Lisp_XawFormDoLayout(LispBuiltin *builtin)
+/*
+ xaw-form-do-layout widget force
+ */
+{
+    int force;
+
+    LispObj *owidget, *oforce;
+
+    oforce = ARGUMENT(1);
+    owidget = ARGUMENT(0);
+
+    if (!CHECKO(owidget, xawWidget_t))
+	LispDestroy("%s: cannot convert %s to Widget",
+		    STRFUN(builtin), STROBJ(owidget));
+
+    force = oforce != NIL;
+    XawFormDoLayout((Widget)(owidget->data.opaque.data), force);
+
+    return (oforce);
+}
+
+LispObj *
+Lisp_XawTextGetSource(LispBuiltin *builtin)
+/*
+ xaw-text-get-source widget
+ */
+{
+    LispObj *owidget;
+
+    owidget = ARGUMENT(0);
+
+    if (!CHECKO(owidget, xawWidget_t))
+	LispDestroy("%s: cannot convert %s to Widget",
+		    STRFUN(builtin), STROBJ(owidget));
+
+    return (OPAQUE(XawTextGetSource((Widget)(owidget->data.opaque.data)),
+		   xawWidget_t));
+}
+
+LispObj *
+Lisp_XawTextLastPosition(LispBuiltin *builtin)
+/*
+ xaw-text-last-position widget
+ */
+{
+    LispObj *owidget;
+
+    owidget = ARGUMENT(0);
+
+    if (!CHECKO(owidget, xawWidget_t))
+	LispDestroy("%s: cannot convert %s to Widget",
+		    STRFUN(builtin), STROBJ(owidget));
+
+    return (FIXNUM(XawTextLastPosition((Widget)(owidget->data.opaque.data))));
+}
+
+LispObj *
+Lisp_XawTextGetInsertionPoint(LispBuiltin *builtin)
+/*
+ xaw-text-get-insertion-point widget
+ */
+{
+    LispObj *owidget;
+
+    owidget = ARGUMENT(0);
+
+    if (!CHECKO(owidget, xawWidget_t))
+	LispDestroy("%s: cannot convert %s to Widget",
+		    STRFUN(builtin), STROBJ(owidget));
+
+    return (FIXNUM(XawTextGetInsertionPoint((Widget)(owidget->data.opaque.data))));
+}
+
+LispObj *
+Lisp_XawTextSetInsertionPoint(LispBuiltin *builtin)
+/*
+ xaw-text-set-insertion-point widget position
+ */
+{
+    Widget widget;
+    XawTextPosition position;
+
+    LispObj *owidget, *oposition;
+
+    oposition = ARGUMENT(1);
+    owidget = ARGUMENT(0);
+
+    if (!CHECKO(owidget, xawWidget_t))
+	LispDestroy("%s: cannot convert %s to Widget",
+		    STRFUN(builtin), STROBJ(owidget));
+    widget = (Widget)(owidget->data.opaque.data);
+
+    CHECK_INDEX(oposition);
+    position = (XawTextPosition)FIXNUM_VALUE(oposition);
+
+    XawTextSetInsertionPoint(widget, position);
+
+    return (oposition);
+}
+
+LispObj *
+Lisp_XawTextReplace(LispBuiltin *builtin)
+/*
+ xaw-text-replace widget left right text
+ */
+{
+    Widget widget;
+    XawTextPosition left, right;
+    XawTextBlock block;
+
+    LispObj *owidget, *oleft, *oright, *otext;
+
+    otext = ARGUMENT(3);
+    oright = ARGUMENT(2);
+    oleft = ARGUMENT(1);
+    owidget = ARGUMENT(0);
+
+    if (!CHECKO(owidget, xawWidget_t))
+	LispDestroy("%s: cannot convert %s to Widget",
+		    STRFUN(builtin), STROBJ(owidget));
+    widget = (Widget)(owidget->data.opaque.data);
+
+    CHECK_INDEX(oleft);
+    left = (XawTextPosition)FIXNUM_VALUE(oleft);
+
+    CHECK_INDEX(oright);
+    right = (XawTextPosition)FIXNUM_VALUE(oright);
+
+    CHECK_STRING(otext);
+    block.firstPos = 0;
+    block.ptr = THESTR(otext);
+    block.length = strlen(block.ptr);
+    block.format = FMT8BIT;
+
+    return (FIXNUM(XawTextReplace(widget, left, right, &block)));
+}
+
+LispObj *
+Lisp_XawTextSearch(LispBuiltin *builtin)
+/*
+ xaw-text-search widget direction text
+ */
+{
+    Widget widget;
+    XawTextScanDirection direction;
+    XawTextBlock block;
+
+    LispObj *owidget, *odirection, *otext;
+
+    otext = ARGUMENT(2);
+    odirection = ARGUMENT(1);
+    owidget = ARGUMENT(0);
+
+    if (!CHECKO(owidget, xawWidget_t))
+	LispDestroy("%s: cannot convert %s to Widget",
+		    STRFUN(builtin), STROBJ(owidget));
+    widget = (Widget)(owidget->data.opaque.data);
+
+    CHECK_INDEX(odirection);
+    direction = (XawTextPosition)FIXNUM_VALUE(odirection);
+    if (direction != XawsdLeft && direction != XawsdRight)
+	LispDestroy("%s: %d does not fit in XawTextScanDirection",
+		    STRFUN(builtin), direction);
+
+    CHECK_STRING(otext);
+    block.firstPos = 0;
+    block.ptr = THESTR(otext);
+    block.length = strlen(block.ptr);
+    block.format = FMT8BIT;
+
+    return (FIXNUM(XawTextSearch(widget, direction, &block)));
+}
+
+LispObj *
+Lisp_XawListChange(LispBuiltin *builtin)
+/*
+ xaw-list-change widget list &optional longest resize
+ */
+{
+    Widget widget;
+    String *list;
+    int i, nitems;
+    int longest;
+    Boolean resize;
+    LispObj *object;
+    WidgetData *data;
+
+    LispObj *owidget, *olist, *olongest, *oresize;
+
+    oresize = ARGUMENT(3);
+    olongest = ARGUMENT(2);
+    olist = ARGUMENT(1);
+    owidget = ARGUMENT(0);
+
+    if (!CHECKO(owidget, xawWidget_t))
+	LispDestroy("%s: cannot convert %s to Widget",
+		    STRFUN(builtin), STROBJ(owidget));
+    widget = (Widget)(owidget->data.opaque.data);
+
+    CHECK_LIST(olist);
+    for (nitems = 0, object = olist; CONSP(object);
+	 ++nitems, object = CDR(object))
+	CHECK_STRING(CAR(object));
+
+    if (olongest != UNSPEC) {
+	CHECK_INDEX(olongest);
+	longest = FIXNUM_VALUE(olongest);
+    }
+    else
+	XtVaGetValues(widget, XtNlongest, &longest, NULL, 0);
+    resize = oresize != UNSPEC && oresize != NIL;
+
+    /* No errors in arguments, build string list */
+    list = (String*)XtMalloc(sizeof(String) * nitems);
+    for (i = 0, object = olist; CONSP(object); i++, object = CDR(object))
+	list[i] = THESTR(CAR(object));
+
+    /* Check if xaw-list-change was already called
+      * for this widget and free previous data */
+    for (i = 0; i < num_list_data; i++)
+	if ((Widget)CAR(list_data[i]->object)->data.opaque.data == widget) {
+	    XtRemoveCallback(widget, XtNdestroyCallback,
+			     LispXawCleanupCallback, list_data[i]);
+	    LispXawCleanupCallback(widget, list_data[i], NULL);
+	    break;
+	}
+
+    if (i >= num_list_data) {
+	++num_list_data;
+	list_data = (WidgetData**)XtRealloc((XtPointer)list_data,
+					    sizeof(WidgetData*) * num_list_data);
+    }
+
+    data = (WidgetData*)XtMalloc(sizeof(WidgetData));
+    data->data = list;
+    list_data[i] = data;
+    data->object = CONS(owidget, olist);
+    PROTECT(owidget, data->object);
+    XtAddCallback(widget, XtNdestroyCallback, LispXawCleanupCallback, data);
+
+    XawListChange(widget, list, nitems, longest, resize);
+
+    return (olist);
+}
+
+LispObj *
+Lisp_XawListHighlight(LispBuiltin *builtin)
+/*
+ xaw-list-highlight widget index
+ */
+{
+    Widget widget;
+    int position;
+
+    LispObj *owidget, *oindex;
+
+    oindex = ARGUMENT(1);
+    owidget = ARGUMENT(0);
+
+    if (!CHECKO(owidget, xawWidget_t))
+	LispDestroy("%s: cannot convert %s to Widget",
+		    STRFUN(builtin), STROBJ(owidget));
+    widget = (Widget)(owidget->data.opaque.data);
+
+    CHECK_INDEX(oindex);
+    position = FIXNUM_VALUE(oindex);
+
+    XawListHighlight(widget, position);
+
+    return (oindex);
+}
+
+LispObj *
+Lisp_XawListUnhighlight(LispBuiltin *builtin)
+/*
+ xaw-list-unhighlight widget
+ */
+{
+    LispObj *owidget;
+
+    owidget = ARGUMENT(0);
+
+    if (!CHECKO(owidget, xawWidget_t))
+	LispDestroy("%s: cannot convert %s to Widget",
+		    STRFUN(builtin), STROBJ(owidget));
+
+    XawListUnhighlight((Widget)(owidget->data.opaque.data));
+
+    return (NIL);
+}
+
+LispObj *
+Lisp_XawScrollbarSetThumb(LispBuiltin *builtin)
+/*
+ xaw-scrollbar-set-thumb widget top &optional shown
+ */
+{
+    Widget widget;
+    double top, shown;
+
+    LispObj *owidget, *otop, *oshown;
+
+    oshown = ARGUMENT(2);
+    otop = ARGUMENT(1);
+    owidget = ARGUMENT(0);
+
+    if (!CHECKO(owidget, xawWidget_t))
+	LispDestroy("%s: cannot convert %s to Widget",
+		    STRFUN(builtin), STROBJ(owidget));
+    widget = (Widget)(owidget->data.opaque.data);
+
+    CHECK_DFLOAT(otop);
+    top = DFLOAT_VALUE(otop);
+
+    if (oshown == UNSPEC)
+	shown = 1.0;
+    else {
+	CHECK_DFLOAT(oshown);
+	shown = DFLOAT_VALUE(oshown);
+    }
+
+    XawScrollbarSetThumb(widget, top, shown);
+
+    return (oshown == UNSPEC ? DFLOAT(shown) : oshown);
+}
diff --git a/lisp/modules/xedit.lsp b/lisp/modules/xedit.lsp
new file mode 100644
index 0000000..87a85c7
--- /dev/null
+++ b/lisp/modules/xedit.lsp
@@ -0,0 +1,560 @@
+;;
+;; Copyright (c) 2002 by The XFree86 Project, Inc.
+;;
+;; Permission is hereby granted, free of charge, to any person obtaining a
+;; copy of this software and associated documentation files (the "Software"),
+;; to deal in the Software without restriction, including without limitation
+;; the rights to use, copy, modify, merge, publish, distribute, sublicense,
+;; and/or sell copies of the Software, and to permit persons to whom the
+;; Software is furnished to do so, subject to the following conditions:
+;;
+;; The above copyright notice and this permission notice shall be included in
+;; all copies or substantial portions of the Software.
+;;
+;; THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
+;; IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
+;; FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT.  IN NO EVENT SHALL
+;; THE XFREE86 PROJECT BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY,
+;; WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF
+;; OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE
+;; SOFTWARE.
+;;
+;; Except as contained in this notice, the name of the XFree86 Project shall
+;; not be used in advertising or otherwise to promote the sale, use or other
+;; dealings in this Software without prior written authorization from the
+;; XFree86 Project.
+;;
+;; Author: Paulo César Pereira de Andrade
+;;
+;;
+;; $XFree86: xc/programs/xedit/lisp/modules/xedit.lsp,v 1.10 2003/01/16 06:25:50 paulo Exp $
+;;
+
+(provide "xedit")
+
+#+debug	(make-package "XEDIT" :use '("LISP" "EXT"))
+(in-package "XEDIT")
+
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;  TODO The user should be able to define *auto-modes* prior to the
+;; initialization here in a configuration file, since defvar only binds
+;; the variable if it is unbound or doesn't have a value defined.
+;;  *auto-modes* is a list of conses where every car is compiled
+;; to a regexp to match the name of the file being loaded. The caddr is
+;; either a string, a pathname, or a syntax-p.
+;;  When loading a file, if the regexp in the car matches, it will check
+;; the caddr value, and if it is a:
+;;	string:		executes (load "progmodes/<the-string>.lsp")
+;;	pathname:	executes (load <the-pathhame>)
+;;	syntax-p:	does nothing, already loaded
+;;
+;;  If it fails to load the file, or the returned value is not a
+;; syntax-p, the entry is removed.
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+(defvar *auto-modes* '(
+    ("\\.(c|cc|C|cxx|h|bm|xbm|xpm|l|y)$"
+	"C/C++"		"c"	. *c-mode*)
+    ("\\.(li?sp|scm)$"
+	"Lisp/Scheme"	"lisp"	. *lisp-mode*)
+    ("Imakefile|(\\.(cf|rules|tmpl|def|cpp)$)"
+	"X imake"	"imake"	. *imake-mode*)
+    ("[Mm]akefile.*|\\.mk$"
+	"Makefile"	"make"	. *make-mode*)
+    ("\\.sh$"
+	"Unix shell"	"sh"	. *sh-mode*)
+    ("\\.sgml?$"
+	"SGML"		"sgml"	. *sgml-mode*)
+    ("\\.html?$"
+	"HTML"		"html"	. *html-mode*)
+    ("\\.(man|\\d)$"
+	"Man page"	"man"	. *man-mode*)
+    ("app-defaults/\\w+|\\u[A-Za-z0-9_-]+\\.ad"
+	"X resource"	"xrdb"	. *xrdb-mode*)
+    ("\\<XF86Config[^/]*"
+	"XF86Config"	"xconf"	. *xconf-mode*)
+    ("\\.spec$"
+	"RPM spec"	"rpm"	. *rpm-mode*)
+    ("\\<XFree86\\.\\d+\\.log$"
+	"XFree86 log"	"xlog"	. *xlog-mode*)
+))
+
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; Compile the regexps in the *auto-modes* list.
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+(dolist (mode *auto-modes*)
+    (rplaca mode (re-comp (car mode) :nosub t))
+)
+
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; Find the progmode associated with the given filename.
+;; Returns nil if nothing matches.
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+(defun auto-mode (filename &optional symbol &aux syntax)
+    (if (and symbol (symbolp symbol))
+	(if (boundp symbol)
+	    (return-from auto-mode (symbol-value symbol))
+	    (setq syntax (cddr (find symbol *auto-modes* :key #'cdddr)))
+	)
+	;; symbol optional argument is not a symbol
+	(do*
+	    (
+	    (mode   *auto-modes*    (cdr mode))
+	    (regex  (caar mode)     (caar mode))
+	    )
+	    ((endp mode))
+
+	    ;; only wants to know if the regex match.
+	    (when (listp (re-exec regex filename :count 0))
+		(setq syntax (cddar mode) symbol (cdr syntax))
+		(return)
+	    )
+	)
+    )
+
+    ;; if file was already loaded
+    (if (and symbol (boundp symbol))
+	(return-from auto-mode (symbol-value symbol))
+    )
+
+    (when (consp syntax)
+	;; point to the syntax file specification
+	(setq syntax (car syntax))
+
+	;; try to load the syntax definition file
+	(if (stringp syntax)
+	    (load
+		(string-concat
+		    (namestring *default-pathname-defaults*)
+		    "progmodes/"
+		    syntax
+		    ".lsp"
+		)
+	    )
+	    (load syntax)
+	)
+
+	(and symbol (boundp symbol) (symbol-value symbol))
+    )
+)
+
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; Data types.
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;  The main syntax structure, normally, only one should exist per
+;; syntax highlight module.
+;;  The structure is defined here so it is not required to load all
+;; the extra data associated with syntax-highlight at initialization
+;; time, and will never be loaded if no syntax-highlight mode is
+;; defined to the files being edited.
+(defstruct syntax
+    name		;;  A unique string to identify the syntax mode.
+			;; Should be the name of the language/file type.
+    options		;;  A hash table of options specified for the
+			;; language.
+
+    ;; Field(s) defined at "compile time"
+    labels		;;  Not exactly a list of labels, but all syntax
+			;; tables for the module.
+    quark		;;  A XrmQuark associated with the XawTextPropertyList
+			;; used by this syntax mode.
+    token-count		;;  Number of distinct syntoken structures in
+			;; the syntax table.
+)
+
+;;  Xlfd description, used when combining properties.
+;;  Field names are self descriptive.
+;;	XXX Fields should be initialized as strings, but fields
+;;	    that have an integer value should be allowed to
+;;	    be initialized as such.
+;;  Combining properties in supported in Xaw, but not yet in the
+;; syntax highlight code interface. Combining properties allow easier
+;; implementation for markup languages, for example:
+;;	<b>bold<i>italic</i></b>
+;;	would render "bold" using a bold version of the default font,
+;;	and "italic" using a bold and italic version of the default font
+(defstruct xlfd
+    foundry
+    family
+    weight
+    slant
+    setwidth
+    addstyle
+    pixel-size
+    point-size
+    res-x
+    res-y
+    spacing
+    avgwidth
+    registry
+    encoding
+)
+
+
+;;   At some time this structure should also hold information for at least:
+;;	o fontset
+;;	o foreground pixmap
+;;	o background pixmap
+;;   XXX This is also a TODO in Xaw.
+(defstruct synprop
+    quark	;;   XrmQuark identifier of the XawTextProperty
+		;; structure. This field is filled when "compiling"
+		;; the syntax-table.
+
+    name	;;   String name of property, must be unique per
+		;; property list.
+    font	;; Optional font string name of property.
+    foreground	;; Optional string representation of foreground color.
+    background	;; Optional string representation of background color.
+    xlfd	;;   Optional xlfd structure, when combining properties.
+		;; Currently combining properties logic not implemented,
+		;; but fonts may be specified using the xlfd definition.
+
+    ;; Boolean properties.
+    underline	;; Draw a line below the text.
+    overstrike	;; Draw a line over the text.
+
+    ;; XXX Are these working in Xaw?
+    subscript	;; Align text to the bottom of the line.
+    superscript	;; Align text to the top of the line.
+    ;;  Note: subscript and superscript only have effect when the text
+    ;; line has different height fonts displayed.
+)
+
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;  Utility macro, to create a "special" variable holding
+;; a synprop structure.
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+(defmacro defsynprop (variable name
+		      &key font foreground background xlfd underline
+			   overstrike subscript superscript)
+    `(progn
+	(proclaim '(special ,variable))
+	(setq ,variable
+	    (make-synprop
+		:name		,name
+		:font		,font
+		:foreground	,foreground
+		:background	,background
+		:xlfd		,xlfd
+		:underline	,underline
+		:overstrike	,overstrike
+		:subscript	,subscript
+		:superscript	,superscript
+	    )
+	)
+    )
+)
+
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;  Convert a synprop structure  to a string in the format
+;; expected by Xaw.
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+(defun synprop-to-string (synprop &aux values booleans xlfd)
+    (if (setq xlfd (synprop-xlfd synprop))
+	(dolist
+	    (element
+	       `(
+		("foundry"	    ,(xlfd-foundry xlfd))
+		("family"	    ,(xlfd-family xlfd))
+		("weight"	    ,(xlfd-weight xlfd))
+		("slant"	    ,(xlfd-slant xlfd))
+		("setwidth"	    ,(xlfd-setwidth xlfd))
+		("addstyle"	    ,(xlfd-addstyle xlfd))
+		("pixelsize"	    ,(xlfd-pixel-size xlfd))
+		("pointsize"	    ,(xlfd-point-size xlfd))
+		("resx" 	    ,(xlfd-res-x xlfd))
+		("resy" 	    ,(xlfd-res-y xlfd))
+		("spacing"	    ,(xlfd-spacing xlfd))
+		("avgwidth"	    ,(xlfd-avgwidth xlfd))
+		("registry"	    ,(xlfd-registry xlfd))
+		("encoding"	    ,(xlfd-encoding xlfd))
+		)
+	    )
+	    (if (cadr element)
+		(setq values (append values element))
+	    )
+	)
+    )
+    (dolist
+	(element
+	   `(
+	    ("font"		,(synprop-font synprop))
+	    ("foreground"	,(synprop-foreground synprop))
+	    ("background"	,(synprop-background synprop))
+	    )
+	)
+	(if (cadr element)
+	    (setq values (append values element))
+	)
+    )
+
+    ;;  Boolean attributes. These can be specified in the format
+    ;; <name>=<anything>, but do a nicer output as the format
+    ;; <name> is accepted.
+    (dolist
+	(element
+	    `(
+	    ("underline"	,(synprop-underline synprop))
+	    ("overstrike"	,(synprop-overstrike synprop))
+	    ("subscript"	,(synprop-subscript synprop))
+	    ("superscript"	,(synprop-superscript synprop))
+	    )
+	)
+	(if (cadr element)
+	    (setq booleans (append booleans element))
+	)
+    )
+
+    ;;  Play with format conditionals, list iteration, and goto, to
+    ;; make resulting string.
+    (format
+	nil
+	"~A~:[~;?~]~:[~3*~;~A=~A~{&~A=~A~}~]~:[~;&~]~:[~2*~;~A~{&~A~*~}~]"
+
+	(synprop-name synprop)				;; ~A
+	(or values booleans)				;; ~:[~;?~]
+	values						;; ~:[
+	    (car values) (cadr values) (cddr values)	;; ~A=~A~{&~A=~A~}
+	(and values booleans)				;; ~:[~;&~]
+	booleans					;; ~:[
+	    (car booleans) (cddr booleans)		;; ~A~{&~A~*~}
+    )
+)
+
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;  Use xedit protocol to create a XawTextPropertyList with the
+;; given arguments.
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+(defun compile-syntax-property-list (name properties
+				     &aux string-properties quark)
+
+    ;; Create a string representation of the properties.
+    (dolist (property properties)
+	(setq
+	    string-properties
+	    (append
+		string-properties
+		(list (synprop-to-string property))
+	    )
+	)
+    )
+
+    (setq
+	string-properties
+	(case (length string-properties)
+	    (0	"")
+	    (1	(car string-properties))
+	    (t	(format nil "~A~{,~A~}"
+		    (car string-properties)
+		    (cdr string-properties)
+		)
+	    )
+	)
+    )
+
+#+debug
+    (format *output* "~Cconvert-property-list ~S ~S~%"
+	*escape*
+	name
+	string-properties
+    )
+    (setq quark #-debug (convert-property-list name string-properties)
+		#+debug 0)
+
+    ;; Store the quark for properties not yet "initialized".
+    ;; XXX This is just a call to Xrm{Perm,}StringToQuark, and should
+    ;;     be made available if there were a wrapper/interface to
+    ;;     that Xlib function.
+    (dolist (property properties)
+	(unless (integerp (synprop-quark property))
+#+debug
+	    (format *output* "~Cxrm-string-to-quark ~S~%"
+		*escape*
+		(synprop-name property)
+	    )
+	    (setf
+		(synprop-quark property)
+#-debug		(xrm-string-to-quark (synprop-name property))
+#+debug		0
+	    )
+	)
+    )
+
+    quark
+)
+
+
+
+
+#+debug
+(progn
+    (defconstant *escape* #\$)
+
+    (defconstant *output* *standard-output*)
+
+    ;; Recognized identifiers for wrap mode.
+    (defconstant *wrap-modes* '(:never :line :word))
+
+    ;; Recognized identifiers for justification.
+    (defconstant *justifications* '(:left :right :center :full))
+
+    ;; XawTextScanType
+    (defconstant *scan-type*
+	'(:positions :white-space :eol :paragraph :all :alpha-numeric))
+
+    ;; XawTextScanDirection
+    (defconstant *scan-direction* '(:left :right))
+
+    ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+    ;; Debugging version of xedit functions.
+    ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+    (defun clear-entities (left right)
+	(format *output* "~Cclear-entities ~D ~D~%"
+	    *escape* left right))
+
+    (defun add-entity (offset length identifier)
+	(format *output* "~Cadd-entity ~D ~D ~D~%"
+	    *escape* offset length identifier))
+
+    (defun background (&optional (value nil specified))
+	(if specified
+	    (format *output* "~Cset-background ~S~%" *escape* value)
+	    (format *output* "~Cget-background~%" *escape*)))
+
+    (defun foreground (&optional (value nil specified))
+	(if specified
+	    (format *output* "~Cset-foreground ~S~%" *escape* value)
+	    (format *output* "~Cget-foreground~%" *escape*)))
+
+    (defun font (&optional (value nil specified))
+	(if specified
+	    (format *output* "~Cset-font ~S~%" *escape* value)
+	    (format *output* "~Cget-font~%" *escape*)))
+
+    (defun point (&optional (value nil specified))
+	(if specified
+	    (format *output* "~Cset-point ~D~%" *escape* value)
+	    (format *output* "~Cget-point~%" *escape*)))
+
+    (defun point-min ()
+	(format *output* "~Cpoint-min~%" *escape*))
+
+    (defun point-max ()
+	(format *output* "~Cpoint-max~%" *escape*))
+
+    (defun property-list (&optional (quark nil specified))
+	(format *output* "~property-list ~D~%" *escape* quark))
+
+    (defun insert (string)
+	(format *output* "~Cinsert ~S~%" *escape* string))
+
+    (defun read-text (offset length)
+	(format *output* "~Cread-text ~D ~D~%"
+	    *escape* offset length))
+
+    (defun replace-text (left right string)
+	(format *output* "~Creplace-text ~D ~D ~S~%"
+	    *escape* left right string))
+
+    (defun scan (offset type direction &key (count 1) include)
+	(unless (setq type (position type *scan-type*))
+	    (error "SCAN: type must be one of ~A, not ~A"
+		*scan-type* type))
+	(unless (setq direction (position direction *scan-direction*))
+	    (error "SCAN: direction must be one of ~A, not ~A"
+		*scan-direction* direction))
+	(format *output* "~Cscan ~D ~D ~D ~D ~D~%"
+	    *escape* offset type direction count (if include 1 0)))
+
+    (defun search-forward (string &optional case-sensitive)
+	(format *output* "~Csearch-forward ~S ~D~%"
+	    *escape* string (if case-sensitive 1 0)))
+
+    (defun search-backward (string &optional case-sensitive)
+	(format *output* "~Csearch-backward ~S ~D~%"
+	    *escape* string (if case-sensitive 1 0)))
+
+    (defun wrap-mode (&optional (value nil specified))
+	(if specified
+	    (progn
+		(unless (member value *wrap-modes*)
+		    (error "WRAP-MODE: argument must be one of ~A, not ~A"
+			*wrap-modes* value))
+		(format *output* "~Cset-wrap-mode ~S~%"
+		    *escape* (string value)))
+	    (format *output* "~Cget-wrap-mode~%" *escape*)))
+
+    (defun auto-fill (&optional (value nil specified))
+	(if specified
+	    (format *output* "~Cset-auto-fill ~S~%"
+		*escape* (if value "true" "false"))
+	    (format *output* "~Cget-auto-fill~%" *escape*)))
+
+    (defun justification (&optional (value nil specified))
+	(if specified
+	    (progn
+		(unless (member value *justifications*)
+		    (error "JUSTIFICATION: argument must be one of ~A, not ~A"
+			*justifications* value))
+		(format *output* "~Cset-justification ~S~%"
+		    *escape* (string value)))
+	    (format *output* "~Cget-justification~%" *escape*)))
+
+    (defun left-column (&optional (value nil specified))
+	(if specified
+	    (format *output* "~Cset-left-column ~D~%" *escape* value)
+	    (format *output* "~Cget-left-column~%" *escape*)))
+
+    (defun right-column (&optional (value nil specified))
+	(if specified
+	    (format *output* "~Cset-right-column ~D~%" *escape* value)
+	    (format *output* "~Cget-right-column~%" *escape*)))
+
+    (defun vertical-scrollbar (&optional (value nil specified))
+	(if specified
+	    (format *output* "~Cset-vert-scrollbar ~S~%"
+		*escape* (if value "always" "never"))
+	    (format *output* "~Cget-vert-scrollbar~%" *escape*)))
+
+    (defun horizontal-scrollbar (&optional (value nil specified))
+	(if specified
+	    (format *output* "~Cset-horiz-scrollbar ~S~%"
+		*escape* (if value "always" "never"))
+	    (format *output* "~Cget-horiz-scrollbar~%" *escape*)))
+
+    #|||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||
+    (defun create-buffer (name)
+	(format *output* "~Ccreate-buffer ~S~%" *escape* name))
+
+    (defun remove-buffer (name)
+	(format *output* "~Cremove-buffer ~S~%" *escape* name))
+
+    (defun buffer-name (&optional (value nil specified))
+	(if specified
+	    (format *output* "~Cset-buffer-name ~S~%" *escape* value)
+	    (format *output* "~Cget-buffer-name~%" *escape*)))
+
+    (defun buffer-filename (&optional (value nil specified))
+	(if specified
+	    (format *output* "~Cset-buffer-filename ~S~%"
+		*escape* (namestring value))
+	    (format *output* "~Cget-buffer-filename~%" *escape*)))
+
+    (defun current-buffer (&optional (value nil specified))
+	(if specified
+	    (format *output* "~Cset-current-buffer ~S~%" *escape* value)
+	    (format *output* "~Cget-current-buffer~%" *escape*)))
+
+    (defun other-buffer (&optional (value nil specified))
+	(if specified
+	    (format *output* "~Cset-other-buffer ~S~%" *escape* value)
+	    (format *output* "~Cget-other-buffer~%" *escape*)))
+    |||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||#
+)
diff --git a/lisp/modules/xt.c b/lisp/modules/xt.c
new file mode 100644
index 0000000..13c7ae7
--- /dev/null
+++ b/lisp/modules/xt.c
@@ -0,0 +1,1797 @@
+/*
+ * Copyright (c) 2001 by The XFree86 Project, Inc.
+ *
+ * Permission is hereby granted, free of charge, to any person obtaining a
+ * copy of this software and associated documentation files (the "Software"),
+ * to deal in the Software without restriction, including without limitation
+ * the rights to use, copy, modify, merge, publish, distribute, sublicense,
+ * and/or sell copies of the Software, and to permit persons to whom the
+ * Software is furnished to do so, subject to the following conditions:
+ *
+ * The above copyright notice and this permission notice shall be included in
+ * all copies or substantial portions of the Software.
+ *  
+ * THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
+ * IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
+ * FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT.  IN NO EVENT SHALL
+ * THE XFREE86 PROJECT BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY,
+ * WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF
+ * OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE
+ * SOFTWARE.
+ *
+ * Except as contained in this notice, the name of the XFree86 Project shall
+ * not be used in advertising or otherwise to promote the sale, use or other
+ * dealings in this Software without prior written authorization from the
+ * XFree86 Project.
+ *
+ * Author: Paulo César Pereira de Andrade
+ */
+
+/* $XFree86: xc/programs/xedit/lisp/modules/xt.c,v 1.19 2002/11/23 08:26:52 paulo Exp $ */
+
+#include <stdlib.h>
+#include <stdio.h>
+#include <string.h>
+#include <X11/Intrinsic.h>
+#include <X11/StringDefs.h>
+#include <X11/Shell.h>
+#include "internal.h"
+#include "private.h"
+
+/*
+ * Types
+ */
+typedef struct {
+    XrmQuark qname;
+    XrmQuark qtype;
+    Cardinal size;
+} ResourceInfo;
+
+typedef struct {
+    WidgetClass widget_class;
+    ResourceInfo **resources;
+    Cardinal num_resources;
+    Cardinal num_cons_resources;
+} ResourceList;
+
+typedef struct {
+    Arg *args;
+    Cardinal num_args;
+} Resources;
+
+typedef struct {
+    LispObj *data;
+    /* data is => (list* widget callback argument) */
+} CallbackArgs;
+
+/*
+ * Prototypes
+ */
+int xtLoadModule(LispMac*);
+void LispXtCleanupCallback(Widget, XtPointer, XtPointer);
+
+void LispXtCallback(Widget, XtPointer, XtPointer);
+void LispXtInputCallback(XtPointer, int*, XtInputId*);
+
+/* a hack... */
+LispObj *Lisp_XtCoerceToWidgetList(LispBuiltin*);
+
+LispObj *Lisp_XtAddCallback(LispBuiltin*);
+LispObj *Lisp_XtAppInitialize(LispBuiltin*);
+LispObj *Lisp_XtAppMainLoop(LispBuiltin*);
+LispObj *Lisp_XtAppAddInput(LispBuiltin*);
+LispObj *Lisp_XtAppPending(LispBuiltin*);
+LispObj *Lisp_XtAppProcessEvent(LispBuiltin*);
+LispObj *Lisp_XtCreateWidget(LispBuiltin*);
+LispObj *Lisp_XtCreateManagedWidget(LispBuiltin*);
+LispObj *Lisp_XtCreatePopupShell(LispBuiltin*);
+LispObj *Lisp_XtDestroyWidget(LispBuiltin*);
+LispObj *Lisp_XtGetKeyboardFocusWidget(LispBuiltin*);
+LispObj *Lisp_XtGetValues(LispBuiltin*);
+LispObj *Lisp_XtManageChild(LispBuiltin*);
+LispObj *Lisp_XtUnmanageChild(LispBuiltin*);
+LispObj *Lisp_XtSetMappedWhenManaged(LispBuiltin*);
+LispObj *Lisp_XtMapWidget(LispBuiltin*);
+LispObj *Lisp_XtName(LispBuiltin*);
+LispObj *Lisp_XtParent(LispBuiltin*);
+LispObj *Lisp_XtUnmapWidget(LispBuiltin*);
+LispObj *Lisp_XtPopup(LispBuiltin*);
+LispObj *Lisp_XtPopdown(LispBuiltin*);
+LispObj *Lisp_XtIsRealized(LispBuiltin*);
+LispObj *Lisp_XtRealizeWidget(LispBuiltin*);
+LispObj *Lisp_XtUnrealizeWidget(LispBuiltin*);
+LispObj *Lisp_XtRemoveInput(LispBuiltin*);
+LispObj *Lisp_XtSetSensitive(LispBuiltin*);
+LispObj *Lisp_XtSetValues(LispBuiltin*);
+LispObj *Lisp_XtWidgetToApplicationContext(LispBuiltin*);
+LispObj *Lisp_XtDisplay(LispBuiltin*);
+LispObj *Lisp_XtDisplayOfObject(LispBuiltin*);
+LispObj *Lisp_XtScreen(LispBuiltin*);
+LispObj *Lisp_XtScreenOfObject(LispBuiltin*);
+LispObj *Lisp_XtSetKeyboardFocus(LispBuiltin*);
+LispObj *Lisp_XtWindow(LispBuiltin*);
+LispObj *Lisp_XtWindowOfObject(LispBuiltin*);
+LispObj *Lisp_XtAddGrab(LispBuiltin*);
+LispObj *Lisp_XtRemoveGrab(LispBuiltin*);
+LispObj *Lisp_XtAppGetExitFlag(LispBuiltin*);
+LispObj *Lisp_XtAppSetExitFlag(LispBuiltin*);
+
+LispObj *LispXtCreateWidget(LispBuiltin*, int);
+
+static Resources *LispConvertResources(LispObj*, Widget,
+				       ResourceList*, ResourceList*);
+static void LispFreeResources(Resources*);
+
+static int bcmp_action_resource(_Xconst void*, _Xconst void*);
+static ResourceInfo *GetResourceInfo(char*, ResourceList*, ResourceList*);
+static ResourceList *GetResourceList(WidgetClass);
+static int bcmp_action_resource_list(_Xconst void*, _Xconst void*);
+static ResourceList *FindResourceList(WidgetClass);
+static int qcmp_action_resource_list(_Xconst void*, _Xconst void*);
+static ResourceList *CreateResourceList(WidgetClass);
+static int qcmp_action_resource(_Xconst void*, _Xconst void*);
+static void BindResourceList(ResourceList*);
+
+static void PopdownAction(Widget, XEvent*, String*, Cardinal*);
+static void QuitAction(Widget, XEvent*, String*, Cardinal*);
+
+/*
+ * Initialization
+ */
+static LispBuiltin lispbuiltins[] = {
+    {LispFunction, Lisp_XtCoerceToWidgetList, "xt-coerce-to-widget-list number opaque"},
+
+    {LispFunction, Lisp_XtAddGrab, "xt-add-grab widget exclusive spring-loaded"},
+    {LispFunction, Lisp_XtAddCallback, "xt-add-callback widget callback-name callback &optional client-data"},
+    {LispFunction, Lisp_XtAppAddInput, "xt-app-add-input app-context fileno condition function &optional client-data"},
+    {LispFunction, Lisp_XtAppInitialize, "xt-app-initialize app-context-return application-class &optional options fallback-resources"},
+    {LispFunction, Lisp_XtAppPending, "xt-app-pending app-context"},
+    {LispFunction, Lisp_XtAppMainLoop, "xt-app-main-loop app-context"},
+    {LispFunction, Lisp_XtAppProcessEvent, "xt-app-process-event app-context &optional mask"},
+    {LispFunction, Lisp_XtAppGetExitFlag, "xt-app-get-exit-flag app-context"},
+    {LispFunction, Lisp_XtAppSetExitFlag, "xt-app-set-exit-flag app-context"},
+    {LispFunction, Lisp_XtCreateManagedWidget, "xt-create-managed-widget name widget-class parent &optional arguments"},
+    {LispFunction, Lisp_XtCreateWidget, "xt-create-widget name widget-class parent &optional arguments"},
+    {LispFunction, Lisp_XtCreatePopupShell, "xt-create-popup-shell name widget-class parent &optional arguments"},
+    {LispFunction, Lisp_XtDestroyWidget, "xt-destroy-widget widget"},
+    {LispFunction, Lisp_XtGetKeyboardFocusWidget, "xt-get-keyboard-focus-widget widget"},
+    {LispFunction, Lisp_XtGetValues, "xt-get-values widget arguments"},
+    {LispFunction, Lisp_XtManageChild, "xt-manage-child widget"},
+    {LispFunction, Lisp_XtName, "xt-name widget"},
+    {LispFunction, Lisp_XtUnmanageChild, "xt-unmanage-child widget"},
+    {LispFunction, Lisp_XtMapWidget, "xt-map-widget widget"},
+    {LispFunction, Lisp_XtUnmapWidget, "xt-unmap-widget widget"},
+    {LispFunction, Lisp_XtSetMappedWhenManaged, "xt-set-mapped-when-managed widget map-when-managed"},
+    {LispFunction, Lisp_XtParent, "xt-parent widget"},
+    {LispFunction, Lisp_XtPopup, "xt-popup widget grab-kind"},
+    {LispFunction, Lisp_XtPopdown, "xt-popdown widget"},
+    {LispFunction, Lisp_XtIsRealized, "xt-is-realized widget"},
+    {LispFunction, Lisp_XtRealizeWidget, "xt-realize-widget widget"},
+    {LispFunction, Lisp_XtUnrealizeWidget, "xt-unrealize-widget widget"},
+    {LispFunction, Lisp_XtRemoveInput, "xt-remove-input input"},
+    {LispFunction, Lisp_XtRemoveGrab, "xt-remove-grab widget"},
+    {LispFunction, Lisp_XtSetKeyboardFocus, "xt-set-keyboard-focus widget descendant"},
+    {LispFunction, Lisp_XtSetSensitive, "xt-set-sensitive widget sensitive"},
+    {LispFunction, Lisp_XtSetValues, "xt-set-values widget arguments"},
+    {LispFunction, Lisp_XtWidgetToApplicationContext, "xt-widget-to-application-context widget"},
+    {LispFunction, Lisp_XtDisplay, "xt-display widget"},
+    {LispFunction, Lisp_XtDisplayOfObject, "xt-display-of-object object"},
+    {LispFunction, Lisp_XtScreen, "xt-screen widget"},
+    {LispFunction, Lisp_XtScreenOfObject, "xt-screen-of-object object"},
+    {LispFunction, Lisp_XtWindow, "xt-window widget"},
+    {LispFunction, Lisp_XtWindowOfObject, "xt-window-of-object object"},
+};
+
+LispModuleData xtLispModuleData = {
+    LISP_MODULE_VERSION,
+    xtLoadModule,
+};
+
+static ResourceList **resource_list;
+static Cardinal num_resource_list;
+
+static Atom delete_window;
+static int xtAppContext_t, xtWidget_t, xtWidgetClass_t, xtWidgetList_t,
+	   xtInputId_t, xtDisplay_t, xtScreen_t, xtWindow_t;
+
+static XtActionsRec actions[] = {
+    {"xt-popdown",	PopdownAction},
+    {"xt-quit",		QuitAction},
+};
+
+static XrmQuark qCardinal, qInt, qString, qWidget, qFloat;
+
+static CallbackArgs **input_list;
+static Cardinal num_input_list, size_input_list;
+
+/*
+ * Implementation
+ */
+int
+xtLoadModule(void)
+{
+    int i;
+    char *fname = "XT-LOAD-MODULE";
+
+    xtAppContext_t = LispRegisterOpaqueType("XtAppContext");
+    xtWidget_t = LispRegisterOpaqueType("Widget");
+    xtWidgetClass_t = LispRegisterOpaqueType("WidgetClass");
+    xtWidgetList_t = LispRegisterOpaqueType("WidgetList");
+    xtInputId_t = LispRegisterOpaqueType("XtInputId");
+    xtDisplay_t = LispRegisterOpaqueType("Display*");
+    xtScreen_t = LispRegisterOpaqueType("Screen*");
+    xtWindow_t = LispRegisterOpaqueType("Window");
+
+    LispExecute("(DEFSTRUCT XT-WIDGET-LIST NUM-CHILDREN CHILDREN)\n");
+
+    GCDisable();
+    (void)LispSetVariable(ATOM2("CORE-WIDGET-CLASS"),
+			  OPAQUE(coreWidgetClass, xtWidgetClass_t),
+			  fname, 0);
+    (void)LispSetVariable(ATOM2("COMPOSITE-WIDGET-CLASS"),
+			  OPAQUE(compositeWidgetClass, xtWidgetClass_t),
+			  fname, 0);
+    (void)LispSetVariable(ATOM2("CONSTRAINT-WIDGET-CLASS"),
+			  OPAQUE(constraintWidgetClass, xtWidgetClass_t),
+			  fname, 0);
+    (void)LispSetVariable(ATOM2("TRANSIENT-SHELL-WIDGET-CLASS"),
+			  OPAQUE(transientShellWidgetClass, xtWidgetClass_t),
+			  fname, 0);
+
+    /* parameters for XtPopup */
+    (void)LispSetVariable(ATOM2("XT-GRAB-EXCLUSIVE"),
+			  INTEGER(XtGrabExclusive), fname, 0);
+    (void)LispSetVariable(ATOM2("XT-GRAB-NONE"),
+			  INTEGER(XtGrabNone), fname, 0);
+    (void)LispSetVariable(ATOM2("XT-GRAB-NONE-EXCLUSIVE"),
+			  INTEGER(XtGrabNonexclusive), fname, 0);
+
+    /* parameters for XtAppProcessEvent */
+    (void)LispSetVariable(ATOM2("XT-IM-XEVENT"),
+			  INTEGER(XtIMXEvent), fname, 0);
+    (void)LispSetVariable(ATOM2("XT-IM-TIMER"),
+			  INTEGER(XtIMTimer), fname, 0);
+    (void)LispSetVariable(ATOM2("XT-IM-ALTERNATE-INPUT"),
+			  INTEGER(XtIMAlternateInput), fname, 0);
+    (void)LispSetVariable(ATOM2("XT-IM-SIGNAL"),
+			  INTEGER(XtIMSignal), fname, 0);
+    (void)LispSetVariable(ATOM2("XT-IM-ALL"),
+			  INTEGER(XtIMAll), fname, 0);
+
+    /* parameters for XtAppAddInput */
+    (void)LispSetVariable(ATOM2("XT-INPUT-READ-MASK"),
+			  INTEGER(XtInputReadMask), fname, 0);
+    (void)LispSetVariable(ATOM2("XT-INPUT-WRITE-MASK"),
+			  INTEGER(XtInputWriteMask), fname, 0);
+    (void)LispSetVariable(ATOM2("XT-INPUT-EXCEPT-MASK"),
+			  INTEGER(XtInputExceptMask), fname, 0);
+    GCEnable();
+
+    qCardinal = XrmPermStringToQuark(XtRCardinal);
+    qInt = XrmPermStringToQuark(XtRInt);
+    qString = XrmPermStringToQuark(XtRString);
+    qWidget = XrmPermStringToQuark(XtRWidget);
+    qFloat = XrmPermStringToQuark(XtRFloat);
+
+    for (i = 0; i < sizeof(lispbuiltins) / sizeof(lispbuiltins[0]); i++)
+	LispAddBuiltinFunction(&lispbuiltins[i]);
+
+    return (1);
+}
+
+void
+LispXtCallback(Widget w, XtPointer user_data, XtPointer call_data)
+{
+    CallbackArgs *args = (CallbackArgs*)user_data;
+    LispObj *code, *ocod = COD;
+
+    GCDisable();
+		/* callback name */	   /* reall caller */
+    code = CONS(CDR(CDR(args->data)), CONS(OPAQUE(w, xtWidget_t),
+		CONS(CAR(CDR(args->data)), CONS(OPAQUE(call_data, 0), NIL))));
+		     /* user arguments */
+    COD = CONS(code, COD);
+    GCEnable();
+
+    (void)EVAL(code);
+    COD = ocod;
+}
+
+
+void
+LispXtCleanupCallback(Widget w, XtPointer user_data, XtPointer call_data)
+{
+    CallbackArgs *args = (CallbackArgs*)user_data;
+
+    UPROTECT(CAR(args->data), args->data);
+    XtFree((XtPointer)args);
+}
+
+void
+LispXtInputCallback(XtPointer closure, int *source, XtInputId *id)
+{
+    CallbackArgs *args = (CallbackArgs*)closure;
+    LispObj *code, *ocod = COD;
+
+    GCDisable();
+		/* callback name */	  /* user arguments */
+    code = CONS(CDR(CDR(args->data)), CONS(CAR(CDR(args->data)),
+		CONS(INTEGER(*source), CONS(CAR(args->data), NIL))));
+		     /* input source */	   /* input id */
+    COD = CONS(code, COD);
+    GCEnable();
+
+    (void)EVAL(code);
+    COD = ocod;
+}
+
+LispObj *
+Lisp_XtCoerceToWidgetList(LispBuiltin *builtin)
+/*
+ xt-coerce-to-widget-list number opaque
+ */
+{
+    int i;
+    WidgetList children;
+    Cardinal num_children;
+    LispObj *cons, *widget_list, *result;
+
+    LispObj *onumber, *opaque;
+
+    opaque = ARGUMENT(1);
+    onumber = ARGUMENT(0);
+
+    CHECK_INDEX(onumber);
+    num_children = FIXNUM_VALUE(onumber);
+
+    if (!CHECKO(opaque, xtWidgetList_t))
+	LispDestroy("%s: cannot convert %s to WidgetList",
+		    STRFUN(builtin), STROBJ(opaque));
+    children = (WidgetList)(opaque->data.opaque.data);
+
+    GCDisable();
+    widget_list = cons = NIL;
+    for (i = 0; i < num_children; i++) {
+	result = CONS(OPAQUE(children[i], xtWidget_t), NIL);
+	if (widget_list == NIL)
+	    widget_list = cons = result;
+	else {
+	    RPLACD(cons, result);
+	    cons = CDR(cons);
+	}
+    }
+
+    result = APPLY(ATOM("MAKE-XT-WIDGET-LIST"),
+		   CONS(KEYWORD("NUM-CHILDREN"),
+			CONS(INTEGER(num_children),
+			     CONS(KEYWORD("CHILDREN"),
+				  CONS(widget_list, NIL)))));
+    GCEnable();
+
+    return (result);
+}
+
+LispObj *
+Lisp_XtAddCallback(LispBuiltin *builtin)
+/*
+ xt-add-callback widget callback-name callback &optional client-data
+ */
+{
+    CallbackArgs *arguments;
+    LispObj *data;
+
+    LispObj *widget, *callback_name, *callback, *client_data;
+
+    client_data = ARGUMENT(3);
+    callback = ARGUMENT(2);
+    callback_name = ARGUMENT(1);
+    widget = ARGUMENT(0);
+
+    if (!CHECKO(widget, xtWidget_t))
+	LispDestroy("%s: cannot convert %s to Widget",
+		    STRFUN(builtin), STROBJ(widget));
+
+    CHECK_STRING(callback_name);
+    if (!SYMBOLP(callback) && callback->type != LispLambda_t)
+	LispDestroy("%s: %s cannot be used as a callback",
+		    STRFUN(builtin), STROBJ(callback));
+
+    if (client_data == UNSPEC)
+	client_data = NIL;
+
+    data = CONS(widget, CONS(client_data, callback));
+    PROTECT(widget, data);
+
+    arguments = XtNew(CallbackArgs);
+    arguments->data = data;
+
+    XtAddCallback((Widget)(widget->data.opaque.data), THESTR(callback_name),
+		  LispXtCallback, (XtPointer)arguments);
+    XtAddCallback((Widget)(widget->data.opaque.data), XtNdestroyCallback,
+		  LispXtCleanupCallback, (XtPointer)arguments);
+
+    return (client_data);
+}
+
+LispObj *
+Lisp_XtAppAddInput(LispBuiltin *builtin)
+/*
+  xt-app-add-input app-context fileno condition function &optional client-data
+ */
+{
+    LispObj *data, *input;
+    XtAppContext appcon;
+    int source, condition;
+    CallbackArgs *arguments;
+    XtInputId id;
+
+    LispObj *app_context, *fileno, *ocondition, *function, *client_data;
+
+    client_data = ARGUMENT(4);
+    function = ARGUMENT(3);
+    ocondition = ARGUMENT(2);
+    fileno = ARGUMENT(1);
+    app_context = ARGUMENT(0);
+
+    if (!CHECKO(app_context, xtAppContext_t))
+	LispDestroy("%s: cannot convert %s to XtAppContext",
+		    STRFUN(builtin), STROBJ(app_context));
+    appcon = (XtAppContext)(app_context->data.opaque.data);
+
+    CHECK_LONGINT(fileno);
+    source = LONGINT_VALUE(fileno);
+
+    CHECK_FIXNUM(ocondition);
+    condition = FIXNUM_VALUE(ocondition);
+
+    if (!SYMBOLP(function) && function->type != LispLambda_t)
+	LispDestroy("%s: %s cannot be used as a callback",
+		    STRFUN(builtin), STROBJ(function));
+
+    /* client data optional */
+    if (client_data == UNSPEC)
+	client_data = NIL;
+
+    data = CONS(NIL, CONS(client_data, function));
+
+    arguments = XtNew(CallbackArgs);
+    arguments->data = data;
+
+    id = XtAppAddInput(appcon, source, (XtPointer)condition,
+		       LispXtInputCallback, (XtPointer)arguments);
+    GCDisable();
+    input = OPAQUE(id, xtInputId_t);
+    GCEnable();
+    RPLACA(data, input);
+    PROTECT(input, data);
+
+    if (num_input_list + 1 >= size_input_list) {
+	++size_input_list;
+	input_list = (CallbackArgs**)
+	    XtRealloc((XtPointer)input_list,
+		      sizeof(CallbackArgs*) * size_input_list);
+    }
+    input_list[num_input_list++] = arguments;
+
+    return (input);
+}
+
+LispObj *
+Lisp_XtRemoveInput(LispBuiltin *builtin)
+/*
+ xt-remove-input input
+ */
+{
+    int i;
+    XtInputId id;
+    CallbackArgs *args;
+
+    LispObj *input;
+
+    input = ARGUMENT(0);
+
+    if (!CHECKO(input, xtInputId_t))
+	LispDestroy("%s: cannot convert %s to XtInputId",
+		    STRFUN(builtin), STROBJ(input));
+
+    id = (XtInputId)(input->data.opaque.data);
+    for (i = 0; i < num_input_list; i++) {
+	args = input_list[i];
+	if (id == (XtInputId)(CAR(args->data)->data.opaque.data)) {
+	    UPROTECT(CAR(args->data), args->data);
+	    XtFree((XtPointer)args);
+
+	    if (i + 1 < num_input_list)
+		memmove(input_list + i, input_list + i + 1,
+			sizeof(CallbackArgs*) * (num_input_list - i - 1));
+	    --num_input_list;
+
+	    XtRemoveInput(id);
+
+	    return (T);
+	}
+    }
+
+    return (NIL);
+}
+
+LispObj *
+Lisp_XtAppInitialize(LispBuiltin *builtin)
+/*
+ xt-app-initialize app-context-return application-class &optional options fallback-resources
+ */
+{
+    XtAppContext appcon;
+    Widget shell;
+    int zero = 0;
+    Resources *resources = NULL;
+    String *fallback = NULL;
+
+    LispObj *app_context_return, *application_class,
+	    *options, *fallback_resources;
+
+    fallback_resources = ARGUMENT(3);
+    options = ARGUMENT(2);
+    application_class = ARGUMENT(1);
+    app_context_return = ARGUMENT(0);
+
+    CHECK_SYMBOL(app_context_return);
+    CHECK_STRING(application_class);
+    CHECK_LIST(options);
+
+    /* check fallback resources, if given */
+    if (fallback_resources != UNSPEC) {
+	LispObj *string;
+	int count;
+
+	CHECK_CONS(fallback_resources);
+	for (string = fallback_resources, count = 0; CONS_P(string);
+	     string = CDR(string), count++)
+	    CHECK_STRING(CAR(string));
+
+	/* fallback resources was correctly specified */
+	fallback = LispMalloc(sizeof(String) * (count + 1));
+	for (string = fallback_resources, count = 0; CONS_P(string);
+	     string = CDR(string), count++)
+	    fallback[count] = THESTR(CAR(string));
+	fallback[count] = NULL;
+    }
+
+    shell = XtAppInitialize(&appcon, THESTR(application_class), NULL,
+			    0, &zero, NULL, fallback, NULL, 0);
+    if (fallback)
+	LispFree(fallback);
+    (void)LispSetVariable(app_context_return,
+			  OPAQUE(appcon, xtAppContext_t),
+			  STRFUN(builtin), 0);
+
+    XtAppAddActions(appcon, actions, XtNumber(actions));
+
+    if (options != UNSPEC) {
+	resources = LispConvertResources(options, shell,
+					 GetResourceList(XtClass(shell)),
+					 NULL);
+	if (resources) {
+	    XtSetValues(shell, resources->args, resources->num_args);
+	    LispFreeResources(resources);
+	}
+    }
+
+    return (OPAQUE(shell, xtWidget_t));
+}
+
+LispObj *
+Lisp_XtAppMainLoop(LispBuiltin *builtin)
+/*
+ xt-app-main-loop app-context
+ */
+{
+    LispObj *app_context;
+
+    app_context = ARGUMENT(0);
+
+    if (!CHECKO(app_context, xtAppContext_t))
+	LispDestroy("%s: cannot convert %s to XtAppContext",
+		    STRFUN(builtin), STROBJ(app_context));
+
+    XtAppMainLoop((XtAppContext)(app_context->data.opaque.data));
+
+    return (NIL);
+}
+
+LispObj *
+Lisp_XtAppPending(LispBuiltin *builtin)
+/*
+ xt-app-pending app-context
+ */
+{
+    LispObj *app_context;
+
+    app_context = ARGUMENT(0);
+
+    if (!CHECKO(app_context, xtAppContext_t))
+	LispDestroy("%s: cannot convert %s to XtAppContext",
+		    STRFUN(builtin), STROBJ(app_context));
+
+    return (INTEGER(
+	    XtAppPending((XtAppContext)(app_context->data.opaque.data))));
+}
+
+LispObj *
+Lisp_XtAppProcessEvent(LispBuiltin *builtin)
+/*
+ xt-app-process-event app-context &optional mask
+ */
+{
+    XtInputMask mask;
+    XtAppContext appcon;
+
+    LispObj *app_context, *omask;
+
+    omask = ARGUMENT(1);
+    app_context = ARGUMENT(0);
+
+    if (!CHECKO(app_context, xtAppContext_t))
+	LispDestroy("%s: cannot convert %s to XtAppContext",
+		    STRFUN(builtin), STROBJ(app_context));
+
+    appcon = (XtAppContext)(app_context->data.opaque.data);
+    if (omask == UNSPEC)
+	mask = XtIMAll;
+    else {
+	CHECK_FIXNUM(omask);
+	mask = FIXNUM_VALUE(omask);
+    }
+
+    if (mask != (mask & XtIMAll))
+	LispDestroy("%s: %d does not fit in XtInputMask %d",
+		    STRFUN(builtin), mask);
+
+    if (mask)
+	XtAppProcessEvent(appcon, mask);
+
+    return (omask == NIL ? FIXNUM(mask) : omask);
+}
+
+LispObj *
+Lisp_XtRealizeWidget(LispBuiltin *builtin)
+/*
+ xt-realize-widget widget
+ */
+{
+    Widget widget;
+
+    LispObj *owidget;
+
+    owidget = ARGUMENT(0);
+
+    if (!CHECKO(owidget, xtWidget_t))
+	LispDestroy("%s: cannot convert %s to Widget",
+		    STRFUN(builtin), STROBJ(owidget));
+    widget = (Widget)(owidget->data.opaque.data);
+    XtRealizeWidget(widget);
+
+    if (XtIsSubclass(widget, shellWidgetClass)) {
+	if (!delete_window)
+	    delete_window = XInternAtom(XtDisplay(widget),
+					"WM_DELETE_WINDOW", False);
+	(void)XSetWMProtocols(XtDisplay(widget), XtWindow(widget),
+			      &delete_window, 1);
+    }
+
+    return (owidget);
+}
+
+LispObj *
+Lisp_XtUnrealizeWidget(LispBuiltin *builtin)
+/*
+ xt-unrealize-widget widget
+ */
+{
+    LispObj *widget;
+
+    widget = ARGUMENT(0);
+
+    if (!CHECKO(widget, xtWidget_t))
+	LispDestroy("%s: cannot convert %s to Widget",
+		    STRFUN(builtin), STROBJ(widget));
+
+    XtUnrealizeWidget((Widget)(widget->data.opaque.data));
+
+    return (widget);
+}
+
+LispObj *
+Lisp_XtIsRealized(LispBuiltin *builtin)
+/*
+ xt-is-realized widget
+ */
+{
+    LispObj *widget;
+
+    widget = ARGUMENT(0);
+
+    if (!CHECKO(widget, xtWidget_t))
+	LispDestroy("%s: cannot convert %s to Widget",
+		    STRFUN(builtin), STROBJ(widget));
+
+    return (XtIsRealized((Widget)(widget->data.opaque.data)) ? T : NIL);
+}
+
+LispObj *
+Lisp_XtDestroyWidget(LispBuiltin *builtin)
+/*
+ xt-destroy-widget widget
+ */
+{
+    LispObj *widget;
+
+    widget = ARGUMENT(0);
+
+    if (!CHECKO(widget, xtWidget_t))
+	LispDestroy("%s: cannot convert %s to Widget",
+		    STRFUN(builtin), STROBJ(widget));
+
+    XtDestroyWidget((Widget)(widget->data.opaque.data));
+
+    return (NIL);
+}
+
+#define UNMANAGED	0
+#define MANAGED		1
+#define SHELL		2
+LispObj *
+Lisp_XtCreateWidget(LispBuiltin *builtin)
+/*
+ xt-create-widget name widget-class parent &optional arguments
+ */
+{
+    return (LispXtCreateWidget(builtin, UNMANAGED));
+}
+
+LispObj *
+Lisp_XtCreateManagedWidget(LispBuiltin *builtin)
+/*
+ xt-create-managed-widget name widget-class parent &optional arguments
+ */
+{
+    return (LispXtCreateWidget(builtin, MANAGED));
+}
+
+LispObj *
+Lisp_XtCreatePopupShell(LispBuiltin *builtin)
+/*
+ xt-create-popup-shell name widget-class parent &optional arguments
+ */
+{
+    return (LispXtCreateWidget(builtin, SHELL));
+}
+
+LispObj *
+LispXtCreateWidget(LispBuiltin *builtin, int options)
+/*
+ xt-create-widget name widget-class parent &optional arguments
+ xt-create-managed-widget name widget-class parent &optional arguments
+ xt-create-popup-shell name widget-class parent &optional arguments
+ */
+{
+    char *name;
+    WidgetClass widget_class;
+    Widget widget, parent;
+    Resources *resources = NULL;
+
+    LispObj *oname, *owidget_class, *oparent, *arguments;
+
+    arguments = ARGUMENT(3);
+    oparent = ARGUMENT(2);
+    owidget_class = ARGUMENT(1);
+    oname = ARGUMENT(0);
+
+    CHECK_STRING(oname);
+    name = THESTR(oname);
+
+    if (!CHECKO(owidget_class, xtWidgetClass_t))
+	LispDestroy("%s: cannot convert %s to WidgetClass",
+		    STRFUN(builtin), STROBJ(owidget_class));
+    widget_class = (WidgetClass)(owidget_class->data.opaque.data);
+
+    if (!CHECKO(oparent, xtWidget_t))
+	LispDestroy("%s: cannot convert %s to Widget",
+		    STRFUN(builtin), STROBJ(oparent));
+    parent = (Widget)(oparent->data.opaque.data);
+
+    CHECK_LIST(arguments);
+
+    if (options == SHELL)
+	widget = XtCreatePopupShell(name, widget_class, parent, NULL, 0);
+    else
+	widget = XtCreateWidget(name, widget_class, parent, NULL, 0);
+
+    if (arguments == UNSPEC || arguments == NIL)
+	resources = NULL;
+    else {
+	resources = LispConvertResources(arguments, widget,
+					 GetResourceList(widget_class),
+					 GetResourceList(XtClass(parent)));
+	XtSetValues(widget, resources->args, resources->num_args);
+    }
+    if (options == MANAGED)
+	XtManageChild(widget);
+    if (resources)
+	LispFreeResources(resources);
+
+    return (OPAQUE(widget, xtWidget_t));
+}
+
+LispObj *
+Lisp_XtGetKeyboardFocusWidget(LispBuiltin *builtin)
+/*
+ xt-get-keyboard-focus-widget widget
+ */
+{
+    LispObj *widget;
+
+    widget = ARGUMENT(0);
+
+    if (!CHECKO(widget, xtWidget_t))
+	LispDestroy("%s: cannot convert %s to Widget",
+		    STRFUN(builtin), STROBJ(widget));
+    return (OPAQUE(XtGetKeyboardFocusWidget((Widget)(widget->data.opaque.data)),
+		   xtWidget_t));
+}
+
+LispObj *
+Lisp_XtGetValues(LispBuiltin *builtin)
+/*
+ xt-get-values widget arguments
+ */
+{
+    Arg args[1];
+    Widget widget;
+    ResourceList *rlist, *plist;
+    ResourceInfo *resource;
+    LispObj *list, *object = NIL, *result, *cons = NIL;
+    char c1;
+    short c2;
+    int c4;
+#ifdef LONG64
+    long c8;
+#endif
+
+    LispObj *owidget, *arguments;
+
+    arguments = ARGUMENT(1);
+    owidget = ARGUMENT(0);
+
+    if (arguments == NIL)
+	return (NIL);
+
+    if (!CHECKO(owidget, xtWidget_t))
+	LispDestroy("%s: cannot convert %s to Widget",
+		    STRFUN(builtin), STROBJ(owidget));
+    widget = (Widget)(owidget->data.opaque.data);
+    CHECK_CONS(arguments);
+
+    rlist = GetResourceList(XtClass(widget));
+    plist =  XtParent(widget) ?
+	     GetResourceList(XtClass(XtParent(widget))) : NULL;
+
+    GCDisable();
+    result = NIL;
+    for (list = arguments; CONS_P(list); list = CDR(list)) {
+	CHECK_STRING(CAR(list));
+	if ((resource = GetResourceInfo(THESTR(CAR(list)), rlist, plist))
+	     == NULL) {
+	    int i;
+	    Widget child;
+
+	    for (i = 0; i < rlist->num_resources; i++) {
+		if (rlist->resources[i]->qtype == qWidget) {
+		    XtSetArg(args[0],
+			     XrmQuarkToString(rlist->resources[i]->qname),
+			     &child);
+		    XtGetValues(widget, args, 1);
+		    if (child && XtParent(child) == widget) {
+			resource =
+			    GetResourceInfo(THESTR(CAR(list)),
+					    GetResourceList(XtClass(child)),
+					    NULL);
+			if (resource)
+			    break;
+		    }
+		}
+	    }
+	    if (resource == NULL) {
+		LispMessage("%s: resource %s not available",
+			    STRFUN(builtin), THESTR(CAR(list)));
+		continue;
+	    }
+	}
+	switch (resource->size) {
+	    case 1:
+		XtSetArg(args[0], THESTR(CAR(list)), &c1);
+		break;
+	    case 2:
+		XtSetArg(args[0], THESTR(CAR(list)), &c2);
+		break;
+	    case 4:
+		XtSetArg(args[0], THESTR(CAR(list)), &c4);
+		break;
+#ifdef LONG64
+	    case 1:
+		XtSetArg(args[0], THESTR(CAR(list)), &c8);
+		break;
+#endif
+	}
+	XtGetValues(widget, args, 1);
+
+	/* special resources */
+	if (resource->qtype == qString) {
+#ifdef LONG64
+	    object = CONS(CAR(list), STRING(c8));
+#else
+	    object = CONS(CAR(list), STRING(c4));
+#endif
+	}
+	else if (resource->qtype == qCardinal || resource->qtype == qInt) {
+#ifdef LONG64
+	    if (sizeof(int) == 8)
+		object = CONS(CAR(list), INTEGER(c8));
+	    else
+#endif
+	    object = CONS(CAR(list), INTEGER(c4));
+	}
+	else {
+	    switch (resource->size) {
+		case 1:
+		    object = CONS(CAR(list), OPAQUE(c1, 0));
+		    break;
+		case 2:
+		    object = CONS(CAR(list), OPAQUE(c2, 0));
+		    break;
+		case 4:
+		    object = CONS(CAR(list), OPAQUE(c4, 0));
+		    break;
+#ifdef LONG64
+		case 8:
+		    object = CONS(CAR(list), OPAQUE(c8, 0));
+		    break;
+#endif
+	    }
+	}
+
+	if (result == NIL)
+	    result = cons = CONS(object, NIL);
+	else {
+	    RPLACD(cons, CONS(object, NIL));
+	    cons = CDR(cons);
+	}
+    }
+    GCEnable();
+
+    return (result);
+}
+
+LispObj *
+Lisp_XtManageChild(LispBuiltin *builtin)
+/*
+ xt-manage-child widget
+ */
+{
+    LispObj *widget;
+
+    widget = ARGUMENT(0);
+
+    if (!CHECKO(widget, xtWidget_t))
+	LispDestroy("%s: cannot convert %s to Widget",
+		    STRFUN(builtin), STROBJ(widget));
+    XtManageChild((Widget)(widget->data.opaque.data));
+
+    return (widget);
+}
+
+LispObj *
+Lisp_XtUnmanageChild(LispBuiltin *builtin)
+/*
+ xt-unmanage-child widget
+ */
+{
+    LispObj *widget;
+
+    widget = ARGUMENT(0);
+
+    if (!CHECKO(widget, xtWidget_t))
+	LispDestroy("%s: cannot convert %s to Widget",
+		    STRFUN(builtin), STROBJ(widget));
+    XtUnmanageChild((Widget)(widget->data.opaque.data));
+
+    return (widget);
+}
+
+LispObj *
+Lisp_XtMapWidget(LispBuiltin *builtin)
+/*
+ xt-map-widget widget
+ */
+{
+    LispObj *widget;
+
+    widget = ARGUMENT(0);
+
+    if (!CHECKO(widget, xtWidget_t))
+	LispDestroy("%s: cannot convert %s to Widget",
+		    STRFUN(builtin), STROBJ(widget));
+    XtMapWidget((Widget)(widget->data.opaque.data));
+
+    return (widget);
+}
+
+LispObj *
+Lisp_XtUnmapWidget(LispBuiltin *builtin)
+/*
+ xt-unmap-widget widget
+ */
+{
+    LispObj *widget;
+
+    widget = ARGUMENT(0);
+
+    if (!CHECKO(widget, xtWidget_t))
+	LispDestroy("%s: cannot convert %s to Widget",
+		    STRFUN(builtin), STROBJ(widget));
+    XtUnmapWidget((Widget)(widget->data.opaque.data));
+
+    return (widget);
+}
+
+LispObj *
+Lisp_XtSetMappedWhenManaged(LispBuiltin *builtin)
+/*
+ xt-set-mapped-when-managed widget map-when-managed
+ */
+{
+    LispObj *widget, *map_when_managed;
+
+    map_when_managed = ARGUMENT(1);
+    widget = ARGUMENT(0);
+
+    if (!CHECKO(widget, xtWidget_t))
+	LispDestroy("%s: cannot convert %s to Widget",
+		    STRFUN(builtin), STROBJ(widget));
+
+    XtSetMappedWhenManaged((Widget)(widget->data.opaque.data),
+			   map_when_managed != NIL);
+
+    return (map_when_managed);
+}
+
+LispObj *
+Lisp_XtPopup(LispBuiltin *builtin)
+/*
+ xt-popup widget grab-kind
+ */
+{
+    XtGrabKind kind;
+
+    LispObj *widget, *grab_kind;
+
+    grab_kind = ARGUMENT(1);
+    widget = ARGUMENT(0);
+
+    if (!CHECKO(widget, xtWidget_t))
+	LispDestroy("%s: cannot convert %s to Widget",
+		    STRFUN(builtin), STROBJ(widget));
+    CHECK_INDEX(grab_kind);
+    kind = (XtGrabKind)FIXNUM_VALUE(grab_kind);
+    if (kind != XtGrabExclusive && kind != XtGrabNone &&
+	kind != XtGrabNonexclusive)
+	LispDestroy("%s: %d does not fit in XtGrabKind",
+		    STRFUN(builtin), kind);
+    XtPopup((Widget)(widget->data.opaque.data), kind);
+
+    return (grab_kind);
+}
+
+LispObj *
+Lisp_XtPopdown(LispBuiltin *builtin)
+/*
+ xt-popdown widget
+ */
+{
+    LispObj *widget;
+
+    widget = ARGUMENT(0);
+
+    if (!CHECKO(widget, xtWidget_t))
+	LispDestroy("%s: cannot convert %s to Widget",
+		    STRFUN(builtin), STROBJ(widget));
+    XtPopdown((Widget)(widget->data.opaque.data));
+
+    return (widget);
+}
+
+LispObj *
+Lisp_XtSetKeyboardFocus(LispBuiltin *builtin)
+/*
+ xt-set-keyboard-focus widget descendant
+ */
+{
+    LispObj *widget, *descendant;
+
+    descendant = ARGUMENT(1);
+    widget = ARGUMENT(0);
+
+    if (!CHECKO(widget, xtWidget_t))
+	LispDestroy("%s: cannot convert %s to Widget",
+		    STRFUN(builtin), STROBJ(widget));
+    if (!CHECKO(descendant, xtWidget_t))
+	LispDestroy("%s: cannot convert %s to Widget",
+		    STRFUN(builtin), STROBJ(descendant));
+    XtSetKeyboardFocus((Widget)(widget->data.opaque.data),
+		       (Widget)(descendant->data.opaque.data));
+
+    return (widget);
+}
+
+LispObj *
+Lisp_XtSetSensitive(LispBuiltin *builtin)
+/*
+ xt-set-sensitive widget sensitive
+ */
+{
+    LispObj *widget, *sensitive;
+
+    sensitive = ARGUMENT(1);
+    widget = ARGUMENT(0);
+
+    if (!CHECKO(widget, xtWidget_t))
+	LispDestroy("%s: cannot convert %s to Widget",
+		    STRFUN(builtin), STROBJ(widget));
+    XtSetSensitive((Widget)(widget->data.opaque.data), sensitive != NIL);
+
+    return (sensitive);
+}
+
+LispObj *
+Lisp_XtSetValues(LispBuiltin *builtin)
+/*
+ xt-set-values widget arguments
+ */
+{
+    Widget widget;
+    Resources *resources;
+
+    LispObj *owidget, *arguments;
+
+    arguments = ARGUMENT(1);
+    owidget = ARGUMENT(0);
+
+    if (arguments == NIL)
+	return (owidget);
+
+    if (!CHECKO(owidget, xtWidget_t))
+	LispDestroy("%s: cannot convert %s to Widget",
+		    STRFUN(builtin), STROBJ(owidget));
+    widget = (Widget)(owidget->data.opaque.data);
+    CHECK_CONS(arguments);
+    resources = LispConvertResources(arguments, widget,
+				     GetResourceList(XtClass(widget)),
+				     XtParent(widget) ?
+					GetResourceList(XtClass(XtParent(widget))) :
+					NULL);
+    XtSetValues(widget, resources->args, resources->num_args);
+    LispFreeResources(resources);
+
+    return (owidget);
+}
+
+LispObj *
+Lisp_XtWidgetToApplicationContext(LispBuiltin *builtin)
+/*
+ xt-widget-to-application-context widget
+ */
+{
+    Widget widget;
+    XtAppContext appcon;
+
+    LispObj *owidget;
+
+    owidget = ARGUMENT(0);
+
+    if (!CHECKO(owidget, xtWidget_t))
+	LispDestroy("%s: cannot convert %s to Widget",
+		    STRFUN(builtin), STROBJ(owidget));
+    widget = (Widget)(owidget->data.opaque.data);
+    appcon = XtWidgetToApplicationContext(widget);
+
+    return (OPAQUE(appcon, xtAppContext_t));
+}
+
+LispObj *
+Lisp_XtDisplay(LispBuiltin *builtin)
+/*
+ xt-display widget
+ */
+{
+    Widget widget;
+    Display *display;
+
+    LispObj *owidget;
+
+    owidget = ARGUMENT(0);
+
+    if (!CHECKO(owidget, xtWidget_t))
+	LispDestroy("%s: cannot convert %s to Widget",
+		    STRFUN(builtin), STROBJ(owidget));
+    widget = (Widget)(owidget->data.opaque.data);
+    display = XtDisplay(widget);
+
+    return (OPAQUE(display, xtDisplay_t));
+}
+
+LispObj *
+Lisp_XtDisplayOfObject(LispBuiltin *builtin)
+/*
+ xt-display-of-object object
+ */
+{
+    Widget widget;
+    Display *display;
+
+    LispObj *object;
+
+    object = ARGUMENT(0);
+
+    if (!CHECKO(object, xtWidget_t))
+	LispDestroy("%s: cannot convert %s to Widget",
+		    STRFUN(builtin), STROBJ(object));
+    widget = (Widget)(object->data.opaque.data);
+    display = XtDisplayOfObject(widget);
+
+    return (OPAQUE(display, xtDisplay_t));
+}
+
+LispObj *
+Lisp_XtScreen(LispBuiltin *builtin)
+/*
+ xt-screen widget
+ */
+{
+    Widget widget;
+    Screen *screen;
+
+    LispObj *owidget;
+
+    owidget = ARGUMENT(0);
+
+    if (!CHECKO(owidget, xtWidget_t))
+	LispDestroy("%s: cannot convert %s to Widget",
+		    STRFUN(builtin), STROBJ(owidget));
+    widget = (Widget)(owidget->data.opaque.data);
+    screen = XtScreen(widget);
+
+    return (OPAQUE(screen, xtScreen_t));
+}
+
+LispObj *
+Lisp_XtScreenOfObject(LispBuiltin *builtin)
+/*
+ xt-screen-of-object object
+ */
+{
+    Widget widget;
+    Screen *screen;
+
+    LispObj *object;
+
+    object = ARGUMENT(0);
+
+    if (!CHECKO(object, xtWidget_t))
+	LispDestroy("%s: cannot convert %s to Widget",
+		    STRFUN(builtin), STROBJ(object));
+    widget = (Widget)(object->data.opaque.data);
+    screen = XtScreenOfObject(widget);
+
+    return (OPAQUE(screen, xtScreen_t));
+}
+
+LispObj *
+Lisp_XtWindow(LispBuiltin *builtin)
+/*
+ xt-window widget
+ */
+{
+    Widget widget;
+    Window window;
+
+    LispObj *owidget;
+
+    owidget = ARGUMENT(0);
+
+    if (!CHECKO(owidget, xtWidget_t))
+	LispDestroy("%s: cannot convert %s to Widget",
+		    STRFUN(builtin), STROBJ(owidget));
+    widget = (Widget)(owidget->data.opaque.data);
+    window = XtWindow(widget);
+
+    return (OPAQUE(window, xtWindow_t));
+}
+
+LispObj *
+Lisp_XtWindowOfObject(LispBuiltin *builtin)
+/*
+ xt-window-of-object widget
+ */
+{
+    Widget widget;
+    Window window;
+
+    LispObj *object;
+
+    object = ARGUMENT(0);
+
+    if (!CHECKO(object, xtWidget_t))
+	LispDestroy("%s: cannot convert %s to Widget",
+		    STRFUN(builtin), STROBJ(object));
+    widget = (Widget)(object->data.opaque.data);
+    window = XtWindowOfObject(widget);
+
+    return (OPAQUE(window, xtWindow_t));
+}
+
+LispObj *
+Lisp_XtAddGrab(LispBuiltin *builtin)
+/*
+ xt-add-grab widget exclusive spring-loaded
+ */
+{
+    Widget widget;
+    Bool exclusive, spring_loaded;
+
+    LispObj *owidget, *oexclusive, *ospring_loaded;
+
+    ospring_loaded = ARGUMENT(2);
+    oexclusive = ARGUMENT(1);
+    owidget = ARGUMENT(0);
+
+    if (!CHECKO(owidget, xtWidget_t))
+	LispDestroy("%s: cannot convert %s to Widget",
+		    STRFUN(builtin), STROBJ(owidget));
+    widget = (Widget)(owidget->data.opaque.data);
+    exclusive = oexclusive != NIL;
+    spring_loaded = ospring_loaded != NIL;
+
+    XtAddGrab(widget, exclusive, spring_loaded);
+
+    return (T);
+}
+
+LispObj *
+Lisp_XtRemoveGrab(LispBuiltin *builtin)
+/*
+ xt-remove-grab widget
+ */
+{
+    LispObj *widget;
+
+    widget = ARGUMENT(0);
+
+    if (!CHECKO(widget, xtWidget_t))
+	LispDestroy("%s: cannot convert %s to Widget",
+		    STRFUN(builtin), STROBJ(widget));
+
+    XtRemoveGrab((Widget)(widget->data.opaque.data));
+
+    return (NIL);
+}
+
+LispObj *
+Lisp_XtName(LispBuiltin *builtin)
+/*
+ xt-name widget
+ */
+{
+    LispObj *widget;
+
+    widget = ARGUMENT(0);
+
+    if (!CHECKO(widget, xtWidget_t))
+	LispDestroy("%s: cannot convert %s to Widget",
+		    STRFUN(builtin), STROBJ(widget));
+
+    return (STRING(XtName((Widget)(widget->data.opaque.data))));
+}
+
+LispObj *
+Lisp_XtParent(LispBuiltin *builtin)
+/*
+ xt-parent widget
+ */
+{
+    LispObj *widget;
+
+    widget = ARGUMENT(0);
+
+    if (!CHECKO(widget, xtWidget_t))
+	LispDestroy("%s: cannot convert %s to Widget",
+		    STRFUN(builtin), STROBJ(widget));
+
+    return (OPAQUE(XtParent((Widget)widget->data.opaque.data), xtWidget_t));
+}
+
+LispObj *
+Lisp_XtAppGetExitFlag(LispBuiltin *builtin)
+/*
+ xt-app-get-exit-flag app-context
+ */
+{
+    LispObj *app_context;
+
+    app_context = ARGUMENT(0);
+
+    if (!CHECKO(app_context, xtAppContext_t))
+	LispDestroy("%s: cannot convert %s to XtAppContext",
+		    STRFUN(builtin), STROBJ(app_context));
+
+    return (XtAppGetExitFlag((XtAppContext)(app_context->data.opaque.data)) ?
+	    T : NIL);
+}
+
+LispObj *
+Lisp_XtAppSetExitFlag(LispBuiltin *builtin)
+/*
+ xt-app-get-exit-flag app-context
+ */
+{
+    LispObj *app_context;
+
+    app_context = ARGUMENT(0);
+
+    if (!CHECKO(app_context, xtAppContext_t))
+	LispDestroy("%s: cannot convert %s to XtAppContext",
+		    STRFUN(builtin), STROBJ(app_context));
+
+    XtAppSetExitFlag((XtAppContext)(app_context->data.opaque.data));
+
+    return (T);
+}
+
+static Resources *
+LispConvertResources(LispObj *list, Widget widget,
+		     ResourceList *rlist, ResourceList *plist)
+{
+    char c1;
+    short c2;
+    int c4;   
+#ifdef LONG64
+    long c8;
+#endif
+    XrmValue from, to;
+    LispObj *arg, *val;
+    ResourceInfo *resource;
+    char *fname = "XT-CONVERT-RESOURCES";
+    Resources *resources = (Resources*)XtCalloc(1, sizeof(Resources));
+
+    for (; CONSP(list); list = CDR(list)) {
+	if (!CONSP(CAR(list))) {
+	    XtFree((XtPointer)resources);
+	    LispDestroy("%s: %s is not a cons", fname, STROBJ(CAR(list)));
+	}
+	arg = CAR(CAR(list));
+	val = CDR(CAR(list));
+
+	if (!STRINGP(arg)) {
+	    XtFree((XtPointer)resources);
+	    LispDestroy("%s: %s is not a string", fname, STROBJ(arg));
+	}
+
+	if ((resource = GetResourceInfo(THESTR(arg), rlist, plist)) == NULL) {
+	    int i;
+	    Arg args[1];
+	    Widget child;
+
+	    for (i = 0; i < rlist->num_resources; i++) {
+		if (rlist->resources[i]->qtype == qWidget) {
+		    XtSetArg(args[0],
+			     XrmQuarkToString(rlist->resources[i]->qname),
+			     &child);
+		    XtGetValues(widget, args, 1);
+		    if (child && XtParent(child) == widget) {
+			resource =
+			    GetResourceInfo(THESTR(arg),
+					    GetResourceList(XtClass(child)),
+					    NULL);
+			if (resource)
+			    break;
+		    }
+		}
+	    }
+	    if (resource == NULL) {
+		LispMessage("%s: resource %s not available",
+			    fname, THESTR(arg));
+		continue;
+	    }
+	}
+
+	if (LONGINTP(val) || DFLOATP(val) || OPAQUEP(val)) {
+	    resources->args = (Arg*)
+		XtRealloc((XtPointer)resources->args,
+			  sizeof(Arg) * (resources->num_args + 1));
+	    if (!OPAQUEP(val)) {
+		float fvalue;
+
+		if (DFLOATP(val))
+		    fvalue = DFLOAT_VALUE(val);
+		else
+		    fvalue = LONGINT_VALUE(val);
+		if (resource->qtype == qFloat) {
+		    XtSetArg(resources->args[resources->num_args],
+			     XrmQuarkToString(resource->qname), fvalue);
+		}
+		else
+		    XtSetArg(resources->args[resources->num_args],
+			     XrmQuarkToString(resource->qname),
+			     (int)fvalue);
+	    }
+	    else
+		XtSetArg(resources->args[resources->num_args],
+			 XrmQuarkToString(resource->qname), val->data.opaque.data);
+	    ++resources->num_args;
+	    continue;
+	}
+	else if (val == NIL) {
+	    /* XXX assume it is a pointer or a boolean */
+#ifdef DEBUG
+	    LispWarning("%s: assuming %s is a pointer or boolean",
+			fname, XrmQuarkToString(resource->qname));
+#endif
+	    resources->args = (Arg*)
+		XtRealloc((XtPointer)resources->args,
+			  sizeof(Arg) * (resources->num_args + 1));
+	    XtSetArg(resources->args[resources->num_args],
+		     XrmQuarkToString(resource->qname), NULL);
+	    ++resources->num_args;
+	    continue;
+	}
+	else if (val == T) {
+	    /* XXX assume it is a boolean */
+#ifdef DEBUG
+	    LispWarning("%s: assuming %s is a boolean",
+			fname, XrmQuarkToString(resource->qname));
+#endif
+	    resources->args = (Arg*)
+		XtRealloc((XtPointer)resources->args,
+			  sizeof(Arg) * (resources->num_args + 1));
+	    XtSetArg(resources->args[resources->num_args],
+		     XrmQuarkToString(resource->qname), True);
+	    ++resources->num_args;
+	    continue;
+	}
+	else if (!STRINGP(val)) {
+	    XtFree((XtPointer)resources);
+	    LispDestroy("%s: resource value must be string, number or opaque, not %s",
+			fname, STROBJ(val));
+	}
+
+	from.size = val == NIL ? 1 : strlen(THESTR(val)) + 1;
+	from.addr = val == NIL ? "" : THESTR(val);
+	switch (to.size = resource->size) {
+	    case 1:
+		to.addr = (XtPointer)&c1;
+		break;
+	    case 2:
+		to.addr = (XtPointer)&c2;
+		break;
+	    case 4:
+		to.addr = (XtPointer)&c4;
+		break;
+#ifdef LONG64
+	    case 8:
+		to.addr = (XtPointer)&c8;
+		break;
+#endif
+	    default:
+		LispWarning("%s: bad resource size %d for %s",
+			    fname, to.size, THESTR(arg));
+		continue;
+	}
+
+	if (qString == resource->qtype)
+#ifdef LONG64
+	    c8 = (long)from.addr;
+#else
+	    c4 = (long)from.addr;
+#endif
+	else if (!XtConvertAndStore(widget, XtRString, &from,
+				    XrmQuarkToString(resource->qtype), &to))
+	    /* The type converter already have printed an error message */
+	    continue;
+
+	resources->args = (Arg*)
+	    XtRealloc((XtPointer)resources->args,
+		      sizeof(Arg) * (resources->num_args + 1));
+	switch (to.size) {
+	    case 1:
+		XtSetArg(resources->args[resources->num_args],
+			 XrmQuarkToString(resource->qname), c1);
+		break;
+	    case 2:
+		XtSetArg(resources->args[resources->num_args],
+			 XrmQuarkToString(resource->qname), c2);
+		break;
+	    case 4:
+		XtSetArg(resources->args[resources->num_args],
+			 XrmQuarkToString(resource->qname), c4);
+		break;
+#ifdef LONG64
+	    case 8:
+		XtSetArg(resources->args[resources->num_args],
+			 XrmQuarkToString(resource->qname), c8);
+		break;
+#endif
+	}
+	++resources->num_args;
+    }
+
+    return (resources);
+}
+
+static void
+LispFreeResources(Resources *resources)
+{
+    if (resources) {
+	XtFree((XtPointer)resources->args);
+	XtFree((XtPointer)resources);
+    }
+}
+
+static int
+bcmp_action_resource(_Xconst void *string, _Xconst void *resource)
+{
+    return (strcmp((String)string,
+		   XrmQuarkToString((*(ResourceInfo**)resource)->qname)));
+}   
+
+static ResourceInfo *
+GetResourceInfo(char *name, ResourceList *rlist, ResourceList *plist)
+{
+    ResourceInfo **resource = NULL;
+
+    if (rlist->resources)
+	resource = (ResourceInfo**)
+	    bsearch(name, rlist->resources, rlist->num_resources,
+		    sizeof(ResourceInfo*), bcmp_action_resource);
+
+    if (resource == NULL && plist) {
+	resource = (ResourceInfo**)
+	  bsearch(name, &plist->resources[plist->num_resources],
+		  plist->num_cons_resources, sizeof(ResourceInfo*),
+		  bcmp_action_resource);
+    }
+
+    return (resource ? *resource : NULL);
+}
+
+static ResourceList *
+GetResourceList(WidgetClass wc)
+{
+    ResourceList *list;
+
+    if ((list = FindResourceList(wc)) == NULL)
+	list = CreateResourceList(wc);
+
+    return (list);
+}
+
+static int
+bcmp_action_resource_list(_Xconst void *wc, _Xconst void *list)
+{
+    return ((char*)wc - (char*)((*(ResourceList**)list)->widget_class));
+}
+
+static ResourceList *
+FindResourceList(WidgetClass wc)
+{  
+    ResourceList **list;
+
+    if (!resource_list)
+	return (NULL);
+
+    list = (ResourceList**)
+	bsearch(wc, resource_list, num_resource_list,
+		sizeof(ResourceList*),  bcmp_action_resource_list);
+
+    return (list ? *list : NULL);
+}
+
+static int
+qcmp_action_resource_list(_Xconst void *left, _Xconst void *right)
+{
+    return ((char*)((*(ResourceList**)left)->widget_class) -
+	    (char*)((*(ResourceList**)right)->widget_class));
+}
+
+static ResourceList *
+CreateResourceList(WidgetClass wc)
+{
+    ResourceList *list;
+
+    list = (ResourceList*)XtMalloc(sizeof(ResourceList));
+    list->widget_class = wc;
+    list->num_resources = list->num_cons_resources = 0;
+    list->resources = NULL;
+
+    resource_list = (ResourceList**)
+	XtRealloc((XtPointer)resource_list, sizeof(ResourceList*) *
+		  (num_resource_list + 1));
+    resource_list[num_resource_list++] = list;
+    qsort(resource_list, num_resource_list, sizeof(ResourceList*),
+	  qcmp_action_resource_list);
+    BindResourceList(list);
+
+    return (list);
+}
+
+static int
+qcmp_action_resource(_Xconst void *left, _Xconst void *right)
+{
+    return (strcmp(XrmQuarkToString((*(ResourceInfo**)left)->qname),
+		   XrmQuarkToString((*(ResourceInfo**)right)->qname)));
+}
+
+static void
+BindResourceList(ResourceList *list)
+{
+    XtResourceList xt_list, cons_list;
+    Cardinal i, num_xt, num_cons;
+
+    XtGetResourceList(list->widget_class, &xt_list, &num_xt);
+    XtGetConstraintResourceList(list->widget_class, &cons_list, &num_cons);
+    list->num_resources = num_xt;
+    list->num_cons_resources = num_cons;
+
+    list->resources = (ResourceInfo**)
+	XtMalloc(sizeof(ResourceInfo*) * (num_xt + num_cons));
+
+    for (i = 0; i < num_xt; i++) {
+	list->resources[i] = (ResourceInfo*)XtMalloc(sizeof(ResourceInfo));
+	list->resources[i]->qname =
+	    XrmPermStringToQuark(xt_list[i].resource_name);
+	list->resources[i]->qtype =
+	    XrmPermStringToQuark(xt_list[i].resource_type);
+	list->resources[i]->size = xt_list[i].resource_size;
+    }
+
+    for (; i < num_xt + num_cons; i++) {
+	list->resources[i] = (ResourceInfo*)XtMalloc(sizeof(ResourceInfo));
+	list->resources[i]->qname =
+	    XrmPermStringToQuark(cons_list[i - num_xt].resource_name);
+	list->resources[i]->qtype =
+	    XrmPermStringToQuark(cons_list[i - num_xt].resource_type);
+	list->resources[i]->size = cons_list[i - num_xt].resource_size;
+    }
+
+    XtFree((XtPointer)xt_list);
+    if (cons_list)
+	XtFree((XtPointer)cons_list);
+
+    qsort(list->resources, list->num_resources, sizeof(ResourceInfo*),
+	  qcmp_action_resource);
+    if (num_cons)
+	qsort(&list->resources[num_xt], list->num_cons_resources,
+	      sizeof(ResourceInfo*), qcmp_action_resource);
+}
+
+/*ARGSUSED*/
+static void
+PopdownAction(Widget w, XEvent *event, String *params, Cardinal *num_params)
+{
+    XtPopdown(w);
+}
+
+/*ARGSUSED*/
+static void
+QuitAction(Widget w, XEvent *event, String *params, Cardinal *num_params)
+{
+    XtAppSetExitFlag(XtWidgetToApplicationContext(w));
+}