429 lines
12 KiB
Common Lisp
429 lines
12 KiB
Common Lisp
;;
|
|
;; 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)
|
|
)
|
|
)
|