30 ;; $XFree86: xc/programs/xedit/lisp/modules/syntax.lsp,v 1.11 2003/01/16 03:50:46 paulo Exp $
33 (provide "syntax")
37 (defvar *syntax-symbols* '(
38     syntax-highlight defsyntax defsynprop synprop-p syntax-p
44 (export *syntax-symbols*)
46 (dolist (symbol xedit::*syntax-symbols*)
50 (makunbound '*syntax-symbols*)
56 	some-table
59 	match "<"	<- the table already eated this, so it won't be matched.
66   that start/switch to another table, and/or have the contained attribute set.
74   such syntax tables, due to the extra time building the environment to
76   complex syntax, for example, a man page source file.
82   way to handle this is to have a nested table that always returns once a
88   syntax-highlight, if the text property has a background attribute,
123 ;;  Initialize some default properties that may be shared in syntax
188 ;;  The "main" definition of the syntax highlight coding interface.
190 ;; it an already compiled syntax table.
198 		(compile-syntax-table
208 ;;  Just a wrapper to create a hash-table and bound it to a symbol.
210 ;;	(defsynoptions *my-syntax-options*
221 	    (setq ,variable (make-hash-table :initial-contents ',options))
234 			;;		     syntax table.
238 			;;		     beginning a new syntax table.
241 			;;	A keyword -> switch to the syntax table
252 			;; popped until the named syntax table is found,
256 			;; popping the stack, it pushes the current syntax
257 			;; table to the stack and sets a new current one.
282     ;; syntax table list.
301     labels		;; List of keywords labeling syntax tables.
305     label		;; A keyword naming this syntax table.
307     indent		;; Indentation function for the syntax table.
311 			;; at "compile time", so that a table can be
323 ;; a cleaner code when defining the syntax highlight rules.
352 		;; can put conditionals in the syntax definition,
360 	    (error "SYNTABLE: invalid syntax table argument ~A" item)
364     ;; Build the syntax table.
383 	    (error "SYNAUGMENT: bad syntax table label ~A" keyword)
397 (defun list-syntable-elements (table &aux result sub-result)
401 	    (syntable-tokens table)
402 	    (syntable-tables table))
405     ;; For every child syntax table.
406     (dolist (child (syntable-tables table))
422 ;; syntax table.
424 (defun compile-syntax-augment-list (table table-list
428     (dolist (augment (syntable-augments table))
437 	    (syntable-label table)
442     ;; Check if the specified syntax tables exists!
447 		(car (member label table-list :key #'syntable-label))
451 		(syntable-label table)
460     ;; to the syntax table in the second pass.
461     (setf (syntable-augments table) tokens)
463     ;;  Recurse on every child table.
464     (dolist (child (syntable-tables table))
465 	(compile-syntax-augment-list child table-list)
472 ;; every child syntax table.
474 (defun link-syntax-augment-table (table)
476 	(syntable-tokens table)
477 	;;  When augmenting a table, duplicated tokens or different tokens
480 	    (nconc (syntable-tokens table) (syntable-augments table))
487 	(syntable-augments table)
494     (dolist (token (syntable-tokens table))
496 	    (setf (syntable-bol table) t)
500     (dolist (token (syntable-tokens table))
502 	    (setf (syntable-eol table) t)
507     (dolist (child (syntable-tables table))
508 	(link-syntax-augment-table child)
514 ;; "Compile" the main structure of the syntax highlight code.
517 (defun compile-syntax-table (name options main-table &aux syntax elements
525 	(list-syntable-elements main-table)
541 	;;  The "main-table" isn't in the list, because
545 	(cons main-table (cdr elements))
548     ;; Check for typos in the keywords, or for not defined syntax tables.
571     ;; Create a list of all properties used by the syntax.
611     ;;  Now that a list of all nested syntax tables is known, compile the
612     ;; augment list. Note that even the main-table can be augmented to
617     ;; tokens, as the augment table was processed first, and
619     (compile-syntax-augment-list main-table tables)
621     ;;  Now just append the augmented tokens to the table's token list.
622     (link-syntax-augment-table main-table)
671     (setq syntax
672 	(make-syntax
677 		(compile-syntax-property-list
691 ;;  Loop applying the specifed syntax table to the text.
701 (defun syntax-highlight (*syntax*
709 			 indent-table
715 	(property-list (syntax-quark *syntax*))
722     (and (>= *from* *to*) (return-from syntax-highlight (values *from* nil)))
734 	;;  Used to check if end of file found but syntax stack did
738 	;;  Used in interactive mode, to return the syntax table
746 	(syntax-table (car (syntax-labels *syntax*)))
749 	(default-property (syntable-property syntax-table))
755 	;;  The tokens in the current syntax table that may match,
800 	;;  Beginig a new syntax table?
803 	;;  Switching to another syntax table?
806 	;;  Property flag when changing the current syntax table.
809 	;;  Flag to know if syntax table has changed.
829 		    ;; If a nested syntax table wasn't finished
849 	    token-list		(syntable-tokens syntax-table)
857 	;;  If empty line, and current table does not have matches for
862 		(not (syntable-eol syntax-table))
863 		(not (syntable-bol syntax-table)))
865 	    (format t "Empty line and table has no match to bol or eol~%")
875 	(format t "** Entering :LOOP at offset ~D in table ~A, cache has ~D items~%"
877 	    (syntable-label syntax-table)
900 		    ;; matches list, as a match from another syntax
901 		    ;; table may be also in the cache, but before
1042 	;;  While the first entry in the cache is not from the current table.
1046 	    (format t "Not in the current table, removing {~A:~S} ~A~%"
1077 	    ;;  Result already known, and there is no syntax table
1080 		(null indent-table)
1082 		(setq indent-table syntax-table))
1195 	;;  If the syntax table is not changed,
1196 	;; or if the new table requires that the
1240 	    (null indent-table)
1242 	    (setq indent-table syntax-table))
1246 	;;  When changing the current syntax table.
1258 			    syntax-table	(pop stack)
1265 		    ;; returning to a named syntax table,
1272 				syntax-table	(pop stack)
1275 			    (not (eq switch syntax-table))
1283 		(unless syntax-table
1285 		    ;;	Return to the topmost syntax table.
1287 			syntax-table
1288 			(car (syntax-labels *syntax*))
1293 		    (syntable-label syntax-table)
1298 		    (setq token-list (syntable-tokens syntax-table))
1306 		    stack	     (cons syntax-table stack)
1309 		    syntax-table     begin
1312 		    (syntable-label syntax-table)
1317 	    ;;	Change current syntax table.
1319 		default-property    (syntable-property syntax-table)
1320 		current-token-list  (syntable-tokens syntax-table)
1389 		;; there are nested syntax tables, and there is a
1449     (values *to* indent-table)
1452 (compile 'syntax-highlight)

Indexes created Wed Dec 03 03:09:37 GMT 2025