diff options
Diffstat (limited to 'lisp/modules/progmodes/sgml.lsp')
| -rw-r--r-- | lisp/modules/progmodes/sgml.lsp | 428 |
1 files changed, 428 insertions, 0 deletions
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) + ) +) |