cgit.sxemacs.org Git - packages/blob - xemacs-packages/xslide/xslide-font.el

   1 ;;;; xslide-font.el --- Tony's XSL font lock keywords
   2 ;; $Id: xslide-font.el,v 1.4 2003/07/02 19:28:06 tonygraham Exp $
   3
   4 ;; Copyright (C) 1998, 1999, 2000, 2001 Tony Graham
   5
   6 ;; Author: Tony Graham <tkg@menteith.com>
   7
   8 ;;; This file is not part of GNU Emacs.
   9
  10 ;; This program is free software; you can redistribute it and/or
  11 ;; modify it under the terms of the GNU General Public License
  12 ;; as published by the Free Software Foundation; either version 2
  13 ;; of the License, or (at your option) any later version.
  14 ;;
  15 ;; This program is distributed in the hope that it will be useful,
  16 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  17 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  18 ;; GNU General Public License for more details.
  19 ;;
  20 ;; You should have received a copy of the GNU General Public License
  21 ;; along with this program; if not, write to the Free Software
  22 ;; Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
  23
  24 \f
  25 ;;;; Commentary:
  26
  27 ;; Font lock mode keywords for use when editing XSL stylesheets
  28
  29 ;; Send bugs to xslide-bug@menteith.com
  30
  31 \f
  32 ;;;; Variables
  33
  34 ;; Define mode-specific faces
  35 (defface xsl-xslt-main-face
  36   '((((background light))
  37      (:foreground "SlateBlue4"))
  38     (((background dark))
  39      (:foreground "Wheat")))
  40   "Used for local name portion of XSLT elements and attributes"
  41   :group 'xsl-faces)
  42 (defvar xsl-xslt-main-face 'xsl-xslt-main-face
  43   "Used for local name portion of XSLT elements and attributes")
  44
  45 (defface xsl-xslt-alternate-face
  46   '((((background light))
  47      (:foreground "SlateBlue2"))
  48     (((background dark))
  49      (:foreground "LightGray")))
  50   "Used for prefix and colon portion of XSLT elements and attributes"
  51   :group 'xsl-faces)
  52 (defvar xsl-xslt-alternate-face 'xsl-xslt-alternate-face
  53   "Used for prefix and colon portion of XSLT elements and attributes")
  54
  55 (defface xsl-fo-main-face
  56   '((((background light))
  57      (:foreground "darkorchid4"))
  58     (((background dark))
  59      (:foreground "PaleGreen")))
  60   "Used for local name portion of formatting object elements and attributes"
  61   :group 'xsl-faces)
  62 (defvar xsl-fo-main-face 'xsl-fo-main-face
  63   "Used for local name portion of formatting object elements and attributes")
  64
  65 (defface xsl-fo-alternate-face
  66   '((((background light))
  67      (:foreground "darkorchid3"))
  68     (((background dark))
  69      (:foreground "Yellow")))
  70   "Used for prefix and colon portion of formatting object elements and attributes"
  71   :group 'xsl-faces)
  72 (defvar xsl-fo-alternate-face 'xsl-fo-alternate-face
  73   "Used for prefix and colon portion of formatting object elements and attributes")
  74
  75 (defface xsl-other-element-face
  76   '((((background light))
  77      (:foreground "Blue"))
  78     (((background dark))
  79      (:foreground "Coral")))
  80   "Used for literal result element tags"
  81   :group 'xsl-faces)
  82 (defvar xsl-other-element-face 'xsl-other-element-face
  83   "Used for literal result element tags")
  84
  85 ;;;; Constants
  86
  87 (eval-and-compile
  88   (defvar xsl-font-lock-keywords
  89     (list
  90      ;;
  91      ;; Reserved XML Processing instruction lookalikes
  92      ;;
  93      '(
  94        "\\(<\\?\\)\\(xml\\)\\(\\s-+version\\s-*=\\s-*\\('[^']+'\\|\"[^\"]+\"\\)\\)?\\(\\s-+encoding\\s-*=\\s-*\\('[^']+'\\|\"[^\"]+\"\\)\\)?\\(\\s-+standalone\\s-*=\\s-*\\('\\(yes\\|no\\)'\\|\"\\(yes\\|no\\)\"\\)\\)?\\s-*\\(\\?>\\)"
  95        (1 font-lock-keyword-face)
  96        (2 font-lock-type-face nil)
  97        (3 font-lock-type-face nil t)
  98        (5 font-lock-type-face nil t)
  99        (7 font-lock-type-face nil t)
 100        (11 font-lock-keyword-face))
 101      ;;
 102      ;; Non-reserved XML Processing instruction
 103      ;; Any XML PI that doesn't start with "<?xml"
 104      ;;
 105      '("\\(<\\?\\)\\([^ \t?>]+\\)[ \t]*\\([^?>]\\|\\?[^>]\\|>[^\n\r]\\)*\\(\\?>\\)"
 106        (1 font-lock-keyword-face)
 107        (2 font-lock-variable-name-face)
 108        (4 font-lock-keyword-face))
 109      ;;
 110      ;; Marked section start
 111      ;;
 112      '("\\(<!\\[\\)[^[]*\\(\\[\\)"
 113        (1 font-lock-keyword-face)
 114        (2 font-lock-keyword-face))
 115      ;;
 116      ;; XSL formatting objects
 117      ;;
 118      (list
 119       (concat "\\(</?\\)\\(" xsl-fo-ns-prefix ":\\)\\("
 120               (regexp-opt
 121                (mapcar 'car xsl-fo-symbol-alist))
 122               "\\)\\(\\s-+\\([^/>]\\|/[^>]\\)+\\)*\\(/?>\\|$\\)")
 123       '(1 xsl-fo-main-face)
 124       '(2 xsl-fo-alternate-face)
 125       '(3 xsl-fo-main-face))
 126      (list
 127       (concat "</?" xsl-fo-ns-prefix ":\\([^/>]\\|/[^>]\\)*\\(/?>\\)")
 128       '(2 xsl-fo-main-face))
 129      ;;
 130      ;; XSL elements
 131      ;;
 132      (list
 133       (concat "\\(</?\\)\\(" xsl-xslt-ns-prefix ":\\)\\("
 134               (regexp-opt
 135                (mapcar 'car xsl-element-symbol-alist))
 136               "\\)\\(\\s-+[^=   ]+[     ]*=[    ]*\\('[^']*'\\|\"[^\"]*\"\\)\\)*\\s-*\\(/?>\\)")
 137       '(1 xsl-xslt-main-face)
 138       '(2 xsl-xslt-alternate-face)
 139       '(3 xsl-xslt-main-face))
 140      (list
 141       (concat "</?" xsl-xslt-ns-prefix ":\\S-+\\(\\s-+[^=>      ]+[     ]*=[    ]*\\('[^']*'\\|\"[^\"]*\"\\)\\)*\\s-*\\(/?>\\)")
 142       '(3 xsl-xslt-main-face))
 143      ;;
 144      ;; XSL attributes
 145      ;;
 146      (let* ((xsl-attributes-alist-regexp
 147              (regexp-opt
 148               (mapcar 'car xsl-attributes-alist)
 149               t))
 150             (xsl-attributes-alist-regexp-depth
 151              (regexp-opt-depth xsl-attributes-alist-regexp)))
 152        (list
 153         (concat
 154          "\\b\\("
 155          xsl-attributes-alist-regexp
 156          "[ \t]*=[ \t]*\"\\)"
 157          "\\([^\"<]*\\)"
 158          "\\(\"\\)")
 159         (list 1 xsl-xslt-alternate-face)
 160         (list (+ 2 xsl-attributes-alist-regexp-depth)
 161               font-lock-variable-name-face)
 162         (list (+ 3 xsl-attributes-alist-regexp-depth)
 163               xsl-xslt-alternate-face)))
 164      ;; do again with single-quote delimiters
 165      (let* ((xsl-attributes-alist-regexp
 166              (regexp-opt
 167               (mapcar 'car xsl-attributes-alist)
 168               t))
 169             (xsl-attributes-alist-regexp-depth
 170              (regexp-opt-depth xsl-attributes-alist-regexp)))
 171        (list
 172         (concat
 173          "\\b\\("
 174          xsl-attributes-alist-regexp
 175          "[ \t]*=[ \t]*'\\)"
 176          "\\([^'<]*\\)"
 177          "\\('\\)")
 178         (list 1 xsl-xslt-alternate-face)
 179         (list (+ 2 xsl-attributes-alist-regexp-depth)
 180               font-lock-variable-name-face)
 181         (list (+ 3 xsl-attributes-alist-regexp-depth)
 182               xsl-xslt-alternate-face)))
 183      ;;
 184      ;; XSL formatting object properties
 185      ;;
 186      (let* ((xsl-fo-attribute-symbol-alist-regexp
 187              (regexp-opt
 188               (mapcar 'car xsl-fo-attribute-symbol-alist)
 189               t))
 190             (xsl-fo-attribute-symbol-alist-regexp-depth
 191              (regexp-opt-depth xsl-fo-attribute-symbol-alist-regexp)))
 192        (list
 193         (concat
 194          "\\b\\("
 195          xsl-fo-attribute-symbol-alist-regexp
 196          "[ \t]*=[ \t]*\"\\)"
 197          "\\([^\"<]*\\)"
 198          "\\(\"\\)")
 199         (list 1 xsl-fo-alternate-face 'append)
 200         (list (+ 2 xsl-fo-attribute-symbol-alist-regexp-depth)
 201               font-lock-variable-name-face)
 202         (list (+ 3 xsl-fo-attribute-symbol-alist-regexp-depth)
 203               xsl-fo-alternate-face)))
 204      ;; do again with single-quote delimiters
 205      (let* ((xsl-fo-attribute-symbol-alist-regexp
 206              (regexp-opt
 207               (mapcar 'car xsl-fo-attribute-symbol-alist)
 208               t))
 209             (xsl-fo-attribute-symbol-alist-regexp-depth
 210              (regexp-opt-depth xsl-fo-attribute-symbol-alist-regexp)))
 211        (list
 212         (concat
 213          "\\b\\("
 214          xsl-fo-attribute-symbol-alist-regexp
 215          "[ \t]*=[ \t]*'\\)"
 216          "\\([^'<]*\\)"
 217          "\\('\\)")
 218         (list 1 xsl-fo-alternate-face 'append)
 219         (list (+ 2 xsl-fo-attribute-symbol-alist-regexp-depth)
 220               font-lock-variable-name-face)
 221         (list (+ 3 xsl-fo-attribute-symbol-alist-regexp-depth)
 222               xsl-fo-alternate-face)))
 223      ;;
 224      ;; Mark the start and end of literals, but don't do anything to their
 225      ;; contents
 226      ;;
 227      '("\\('\\)[^']*\\('\\)"
 228        (1 font-lock-string-face)
 229        (2 font-lock-string-face))
 230      '("\\(\"\\)[^\"]*\\(\"\\)"
 231        (1 font-lock-string-face)
 232        (2 font-lock-string-face))
 233      ;;
 234      ;; { } in attribute values
 235      ;;
 236 ;;     '("\\('\\|\"\\)\\([^{\\1]\\|{{\\)*\\({[^\\1}]*}\\)\\([^{\\1]\\|{{\\)*\\(\\1\\)"
 237      '("'\\([^{'<]\\|{{\\)*\\({[^'}<]*}\\)\\([^{'<]\\|{{\\)*'"
 238        (2 font-lock-variable-name-face t))
 239      '("\"\\([^{\"<]\\|{{\\)*\\({[^\"}<]*}\\)\\([^{\"<]\\|{{\\)*\""
 240        (2 font-lock-variable-name-face t))
 241      ;;
 242      ;; Text inside <xsl:text>
 243      (list
 244       (concat "<" xsl-xslt-ns-prefix ":text>"
 245               "\\([^<]*\\)"
 246               "</" xsl-xslt-ns-prefix ":text>")
 247       '(1 font-lock-string-face append))
 248      ;;
 249      ;; "Other" tags
 250      ;;
 251      (list
 252       (concat "\\(</?\\([^xf/\?!]\\|x[^s]\\|xs[^l]\\|xsl[^:]\\|f[^o]\\|fo[^:]\\)\\([^</>]\\|/[^>]\\)*/?>\\)")
 253       '(1 xsl-other-element-face t))
 254      ;;
 255      ;; Content of tags
 256      ;;
 257      (list
 258       (concat ">\\([^<]+\\)<")
 259       '(1 font-lock-string-face keep))
 260      ;;
 261      ;; Entity references
 262      ;;
 263      '("\\([%&][^; \t]+;\\)"
 264        (1 font-lock-reference-face t))
 265      ;;
 266      ;; Put comment patterns last so they mask anything
 267      ;; that might be inside the comment
 268      ;;
 269      '("\\(<!--[^-]*\\(-[^-]+\\)*-->\\)"
 270        (1 font-lock-comment-face t))
 271      )
 272     "Additional expressions to highlight in XSL mode."))
 273
 274 ;;;; Code:
 275 (defun xsl-font-lock-mark-block-function ()
 276   "Function to mark the area of text to fontify.
 277
 278 Used with font-lock-fontify-block.  Set font-lock-mark-block-function
 279 to this function for this function to take effect.
 280
 281 This function marks the area beginning five \"<\" before point and five
 282 \">\" at ends of lines after point.  The default without a function like
 283 this is to fontify 16 lines before and after point, but then the region
 284 often starts or ends partway through a comment or declaration, turning
 285 that half white because the keywords didn't match, and it just looks so
 286 ugly."
 287   (let ((current-point (point)))
 288     (re-search-forward ">[ \t]*$" (point-max) 'limit 5)
 289     (set-mark (point))
 290     (goto-char current-point)
 291     (re-search-backward "^[ \t]*<" (point-min) 'limit 5)))
 292
 293 (defun xsl-font-lock-region-point-min ()
 294   "Return the start point of the region to fontify."
 295   (save-excursion
 296     (re-search-backward "^[ \t]*<" (point-min) 'limit 5)
 297     (point)))
 298
 299 (defun xsl-font-lock-region-point-max ()
 300   "Return the end point of the region to fontify."
 301   (save-excursion
 302     (re-search-forward ">[ \t]*$" (point-max) 'limit 5)
 303     (point)))
 304
 305 (provide 'xslide-font)
 306
 307 ;; end of xslide-font.el