;;;; oml-mode-font.el --- o:XML font lock keywords

;; oml-mode is a copy of xslide modified by Martin Klang to do o:XML 

;; Copyright (C) 1998, 1999, 2000 Tony Graham

;; Author: Tony Graham <tgraham@mulberrytech.com>

;;; This file is not part of GNU Emacs.

;; This program is free software; you can redistribute it and/or
;; modify it under the terms of the GNU General Public License
;; as published by the Free Software Foundation; either version 2
;; of the License, or (at your option) any later version.
;; 
;; This program is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
;; GNU General Public License for more details.
;; 
;; You should have received a copy of the GNU General Public License
;; along with this program; if not, write to the Free Software
;; Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.


;;;; Commentary:

;; Font lock mode keywords for use when editing o:XML programs


;;;; Variables

;; Define mode-specific faces
(defface oml-omlt-main-face
  '((((background light))
     (:foreground "Midnight Blue"))
    (((background dark))
     (:foreground "Wheat")))
  "Used for local name portion of o:XML elements and attributes"
  :group 'oml-faces)
(defvar oml-omlt-main-face 'oml-omlt-main-face
  "Used for local name portion of o:XML elements and attributes")

(defface oml-omlt-alternate-face
  '((((background light))
     (:foreground "DimGray"))
    (((background dark))
     (:foreground "LightGray")))
  "Used for prefix and colon portion of o:XML elements and attributes"
  :group 'oml-faces)
(defvar oml-omlt-alternate-face 'oml-omlt-alternate-face
  "Used for prefix and colon portion of o:XML elements and attributes")

(defface oml-fo-main-face
  '((((background light))
     (:foreground "PaleGreen"))
    (((background dark))
     (:foreground "PaleGreen")))
  "Used for local name portion of formatting object elements and attributes"
  :group 'oml-faces)
(defvar oml-fo-main-face 'oml-fo-main-face
  "Used for local name portion of formatting object elements and attributes")

(defface oml-fo-alternate-face
  '((((background light))
     (:foreground "YellowGreen"))
    (((background dark))
     (:foreground "YellowGreen")))
  "Used for prefix and colon portion of formatting object elements and attributes"
  :group 'oml-faces)
(defvar oml-fo-alternate-face 'oml-fo-alternate-face
  "Used for prefix and colon portion of formatting object elements and attributes")

(defface oml-other-element-face
  '((((background light))
     (:foreground "Blue"))
    (((background dark))
     (:foreground "Coral")))
  "Used for literal result element tags"
  :group 'oml-faces)
(defvar oml-other-element-face 'oml-other-element-face
  "Used for literal result element tags")

;;;; Constants

(eval-and-compile
  (defvar oml-font-lock-keywords
    (list
     ;;
     ;; Reserved XML Processing instruction lookalikes
     ;;
     '(
       "\\(<\\?\\)\\(xml\\)\\(\\s-+version\\s-*=\\s-*\\('[^']+'\\|\"[^\"]+\"\\)\\)?\\(\\s-+encoding\\s-*=\\s-*\\('[^']+'\\|\"[^\"]+\"\\)\\)?\\(\\s-+standalone\\s-*=\\s-*\\('\\(yes\\|no\\)'\\|\"\\(yes\\|no\\)\"\\)\\)?\\s-*\\(\\?>\\)"
       (1 font-lock-keyword-face)
       (2 font-lock-type-face nil)
       (3 font-lock-type-face nil t)
       (5 font-lock-type-face nil t)
       (7 font-lock-type-face nil t)
       (11 font-lock-keyword-face))
     ;;
     ;; Non-reserved XML Processing instruction
     ;; Any XML PI that doesn't start with "<?xml"
     ;;
     '("\\(<\\?\\)\\([^ \t?>]+\\)[ \t]*\\([^?>]\\|\\?[^>]\\|>[^\n\r]\\)*\\(\\?>\\)"
       (1 font-lock-keyword-face)
       (2 font-lock-variable-name-face)
       (4 font-lock-keyword-face))
     ;;
     ;; Marked section start
     ;;
     '("\\(<!\\[\\)[^[]*\\(\\[\\)"
       (1 font-lock-keyword-face)
       (2 font-lock-keyword-face))
     ;;
     ;; Text inside <oml:text>
     (list
      (concat "<" oml-omlt-ns-prefix ":text>"
	      "\\([^<]*\\)"
	      "</" oml-omlt-ns-prefix ":text>")
      '(1 font-lock-string-face append))
     ;;
     ;; "Other" tags
     ;;
     (list
      (concat "\\(</?\\([^xf/\?!]\\|x[^s]\\|xs[^l]\\|oml[^:]\\|f[^o]\\|fo[^:]\\)\\([^</>]\\|/[^>]\\)*/?>\\)")
      '(1 oml-other-element-face t))
     ;;
     ;; Content of tags
     ;;
     (list
      (concat ">\\([^<]+\\)<")
      '(1 font-lock-string-face keep))
     ;;
     ;; o:XML elements
     ;;
     (list
      (concat "\\(</?\\)\\(" oml-omlt-ns-prefix ":\\)\\("
	      (regexp-opt
	       (mapcar 'car oml-element-symbol-alist))
	      "\\)\\(\\s-+\\([^/>]\\|/[^>]\\)+\\)*\\(/?>\\)")
      '(1 oml-omlt-main-face)
      '(2 oml-omlt-alternate-face)
      '(3 oml-omlt-main-face))
     (list
      (concat "</?" oml-omlt-ns-prefix ":\\([^/>]\\|/[^>]\\)*\\(/?>\\)")
      '(2 oml-omlt-main-face))
     ;;
     ;; o:XML attributes
     ;;
     (let* ((oml-attributes-alist-regexp
	     (regexp-opt
	      (mapcar 'car oml-attributes-alist)
	      t))
	    (oml-attributes-alist-regexp-depth
	     (regexp-opt-depth
	      (regexp-opt
	       (mapcar 'car oml-attributes-alist)
	       t))))
       (list
	(concat
	 "\\b"
	 oml-attributes-alist-regexp
	 "[ \t]*"
	 "\\(=\\)[ \t]*\\([\"']\\)"
	 "\\([^\"<>]*\\)"
	 "\\(\\"
	 (number-to-string (+ 2 oml-attributes-alist-regexp-depth))
	 "\\)")
	(list 1 oml-omlt-alternate-face)
	(list (1+ oml-attributes-alist-regexp-depth)
	      oml-omlt-alternate-face)
	(list (+ 3 oml-attributes-alist-regexp-depth)
	      font-lock-variable-name-face)
	(list (+ 4 oml-attributes-alist-regexp-depth)
	      oml-omlt-alternate-face)))
     ;;
     ;; o:XML formatting objects
     ;;
     (list
      (concat "\\(</?\\)\\(" oml-fo-ns-prefix ":\\)\\("
	      (regexp-opt
	       (mapcar 'car oml-fo-symbol-alist))
	      "\\)\\(\\s-+\\([^/>]\\|/[^>]\\)+\\)*\\(/?>\\|$\\)")
      '(1 oml-fo-main-face)
      '(2 oml-fo-alternate-face)
      '(3 oml-fo-main-face))
     (list
      (concat "</?" oml-fo-ns-prefix ":\\([^/>]\\|/[^>]\\)*\\(/?>\\)")
      '(2 oml-fo-main-face))
     ;;
     ;; o:XML formatting object properties
     ;;
     (let* ((oml-fo-attribute-symbol-alist-regexp
	     (regexp-opt
	      (mapcar 'car oml-fo-attribute-symbol-alist)
	      t))
	    (oml-fo-attribute-symbol-alist-regexp-depth
	     (regexp-opt-depth
	      (regexp-opt
	       (mapcar 'car oml-fo-attribute-symbol-alist)
	       t))))
       (list
	(concat
	 "\\b"
	 oml-fo-attribute-symbol-alist-regexp
	 "[ \t]*"
	 "\\(=[ \t]*\"\\)"
;; The commented-out code doesn't work here, but similar code works
;; for the omlt attribute regexp.  I don't know why.
;;	 "\\(=[ \t]*\\([\"']\\)\\)"
	 "\\([^\"<>]*\\)"
;;	 "\\(\\"
;;	 (+ 2 oml-fo-attribute-symbol-alist-regexp-depth)
;;	 "\\)")
	 "\\(\"\\)")
	(list 1 oml-fo-alternate-face 'append)
	(list (1+ oml-fo-attribute-symbol-alist-regexp-depth)
	      oml-fo-alternate-face)
	(list (+ 2 oml-fo-attribute-symbol-alist-regexp-depth)
	      font-lock-variable-name-face)
	(list (+ 3 oml-fo-attribute-symbol-alist-regexp-depth)
	      oml-fo-alternate-face)))
     ;; do again with single-quote delimiters
     (let* ((oml-fo-attribute-symbol-alist-regexp
	     (regexp-opt
	      (mapcar 'car oml-fo-attribute-symbol-alist)
	      t))
	    (oml-fo-attribute-symbol-alist-regexp-depth
	     (regexp-opt-depth
	      (regexp-opt
	       (mapcar 'car oml-fo-attribute-symbol-alist)
	       t))))
       (list
	(concat
	 "\\b"
	 oml-fo-attribute-symbol-alist-regexp
	 "[ \t]*"
	 "\\(=[ \t]*'\\)"
	 ;;       "\\(=[ \t]*\\([\"']\\)\\)"
	 "\\([^'<>]*\\)"
	 ;;       "\\(\\"
	 ;;       (+ 2 oml-fo-attribute-symbol-alist-regexp-depth)
	 ;;       "\\)")
	 "\\('\\)")
	(list 1 oml-fo-alternate-face 'append)
	(list (1+ oml-fo-attribute-symbol-alist-regexp-depth)
	      oml-fo-alternate-face)
	(list (+ 2 oml-fo-attribute-symbol-alist-regexp-depth)
	      font-lock-variable-name-face)
	(list (+ 3 oml-fo-attribute-symbol-alist-regexp-depth)
	      oml-fo-alternate-face)))
     ;;
     ;; Mark the start and end of literals, but don't do anything to their
     ;; contents
     ;;
     '("\\('\\)[^']*\\('\\)"
       (1 font-lock-string-face)
       (2 font-lock-string-face))
     '("\\(\"\\)[^\"]*\\(\"\\)"
       (1 font-lock-string-face)
       (2 font-lock-string-face))
     ;;
     ;; { } in attribute values
     ;;
     '("\\('\\|\"\\)\\([^{\\1]\\|{{\\)*\\({[^\\1}]*}\\)\\([^{\\1]\\|{{\\)*\\(\\1\\)"
       (3 font-lock-variable-name-face t))
     ;;
     ;; Entity references
     ;;
     '("\\([%&][^; \t]+;\\)"
       (1 font-lock-reference-face t))
     ;;
     ;; Put comment patterns last so they mask anything
     ;; that might be inside the comment
     ;;
     '("\\(<!--[^-]*\\(-[^-]+\\)*-->\\)"
       (1 font-lock-comment-face t))
     )
    "Additional expressions to highlight in o:XML mode."))

;;;; Code:
(defun oml-font-lock-mark-block-function ()
  "Function to mark the area of text to fontify.

Used with font-lock-fontify-block.  Set font-lock-mark-block-function
to this function for this function to take effect.

This function marks the area beginning five \"<\" before point and five
\">\" at ends of lines after point.  The default without a function like
this is to fontify 16 lines before and after point, but then the region
often starts or ends partway through a comment or declaration, turning
that half white because the keywords didn't match, and it just looks so
ugly."
  (let ((current-point (point)))
    (re-search-forward ">$" (point-max) 'limit 5)
    (set-mark (point))
    (goto-char current-point)
    (re-search-backward "^<" (point-min) 'limit 5)))

(defun oml-font-lock-region-point-min ()
  "Return the start point of the region to fontify"
  (save-excursion
    (re-search-backward "^<" (point-min) 'limit 5)
    (point)))

(defun oml-font-lock-region-point-max ()
  "Return the start point of the region to fontify"
  (save-excursion
    (re-search-forward ">$" (point-max) 'limit 5)
    (point)))

(provide 'oml-mode-font)

;; end of oml-mode-font.el