nxhtml/util/rnc-mode.el

   1 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
   2 ;;   A major mode for editing RELAX NG Compact syntax.
   3 ;;   Version: 1.0b3
   4 ;;   Date: 2002-12-05
   5 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
   6
   7 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
   8 ;;
   9 ;;   Copyright (c) 2002, Pantor Engineering AB
  10 ;;   All rights reserved.
  11 ;;
  12 ;;   Redistribution and use in source and binary forms, with or
  13 ;;   without modification, are permitted provided that the following
  14 ;;   conditions are met:
  15 ;;
  16 ;;   * Redistributions of source code must retain the above copyright
  17 ;;     notice, this list of conditions and the following disclaimer.
  18 ;;
  19 ;;   * Redistributions in binary form must reproduce the above
  20 ;;     copyright notice, this list of conditions and the following
  21 ;;     disclaimer in the documentation and/or other materials provided
  22 ;;     with the distribution.
  23 ;;
  24 ;;   * Neither the name of Pantor Engineering AB nor the names of its
  25 ;;     contributors may be used to endorse or promote products derived
  26 ;;     from this software without specific prior written permission.
  27 ;;
  28 ;;   THIS   SOFTWARE   IS PROVIDED BY    THE   COPYRIGHT  HOLDERS  AND
  29 ;;   CONTRIBUTORS "AS IS"   AND ANY  EXPRESS OR  IMPLIED   WARRANTIES,
  30 ;;   INCLUDING,  BUT  NOT LIMITED  TO,   THE  IMPLIED  WARRANTIES   OF
  31 ;;   MERCHANTABILITY    AND  FITNESS  FOR   A  PARTICULAR  PURPOSE ARE
  32 ;;   DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS
  33 ;;   BE  LIABLE   FOR ANY    DIRECT, INDIRECT,   INCIDENTAL,  SPECIAL,
  34 ;;   EXEMPLARY, OR CONSEQUENTIAL DAMAGES  (INCLUDING, BUT NOT  LIMITED
  35 ;;   TO, PROCUREMENT  OF  SUBSTITUTE GOODS OR  SERVICES;  LOSS OF USE,
  36 ;;   DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON
  37 ;;   ANY THEORY OF  LIABILITY, WHETHER IN CONTRACT,  STRICT LIABILITY,
  38 ;;   OR  TORT (INCLUDING NEGLIGENCE OR  OTHERWISE) ARISING  IN ANY WAY
  39 ;;   OUT OF  THE  USE OF   THIS  SOFTWARE,  EVEN IF ADVISED   OF   THE
  40 ;;   POSSIBILITY OF SUCH DAMAGE.
  41 ;;
  42 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  43
  44 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  45 ;;   Created by David.Rosenborg@pantor.com
  46 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  47
  48 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  49 ;;   Example setup for your ~/.emacs file:
  50 ;;
  51 ;;   (autoload 'rnc-mode "rnc-mode")
  52 ;;   (setq auto-mode-alist
  53 ;;         (cons '("\\.rnc\\'" . rnc-mode) auto-mode-alist))
  54 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  55
  56 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  57 ;;   Changes since 1.0b:
  58 ;;     Added a couple of defvars for faces to handle differences
  59 ;;     between GNU Emacs and XEmacs.
  60 ;;
  61 ;; 2008-12-28: Changed forward-char-command => forward-char
  62 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  63
  64 (require 'font-lock)
  65
  66 (defvar rnc-indent-level 3 "The RNC indentation level.")
  67
  68 (defvar rnc-keywords
  69   (mapcar (lambda (kw) (concat "\\b" kw "\\b"))
  70           '("attribute" "div" "element"
  71             "empty" "external" "grammar" "include" "inherit" "list"
  72             "mixed" "notAllowed" "parent" "start" "string"
  73             "text" "token"))
  74   "RNC keywords")
  75
  76 (defvar rnc-atoms
  77   (mapcar (lambda (kw) (concat "\\b" kw "\\b"))
  78           '("empty" "notAllowed" "string" "text" "token"))
  79   "RNC atomic pattern keywords")
  80
  81 (defun rnc-make-regexp-choice (operands)
  82   "(op1 op2 ...) -> \"\\(op1\\|op2\\|...\\)\""
  83   (let ((result "\\("))
  84     (mapc (lambda (op) (setq result (concat result op "\\|"))) operands)
  85     (concat (substring result 0 -2) "\\)")))
  86
  87 ;; Font lock treats face names differently in GNU Emacs and XEmacs
  88 ;; The following defvars is a workaround
  89
  90 (defvar italic 'italic)
  91 (defvar default 'default)
  92 (defvar font-lock-preprocessor-face 'font-lock-preprocessor-face)
  93
  94 (defvar rnc-font-lock-keywords
  95   (list
  96    '("\\b\\(attribute\\|element\\)\\b\\([^{]+\\){" 2
  97      font-lock-variable-name-face)
  98    '("[a-zA-Z][-a-zA-Z0-9._]*:[a-zA-Z][-a-zA-Z0-9._]*" . italic)
  99    '("\\b\\(default\\(\\s +namespace\\)?\\|namespace\\|datatypes\\)\\(\\s +[a-zA-Z][-a-zA-Z0-9._]*\\)?\\s *=" 1 font-lock-preprocessor-face)
 100    '("\\([a-zA-Z][-a-zA-Z0-9._]*\\)\\(\\s \\|\n\\)*[|&]?=" 1
 101      font-lock-function-name-face)
 102    '("[a-zA-Z][a-zA-Z0-9._]*\\(-[a-zA-Z][a-zA-Z0-9._]*\\)+" . default)
 103    (cons (rnc-make-regexp-choice rnc-atoms) 'italic)
 104    (cons (rnc-make-regexp-choice rnc-keywords) font-lock-keyword-face)
 105    )
 106   "RNC Highlighting")
 107
 108
 109 (defun rnc-find-column (first start)
 110   "Find which column to indent to."
 111
 112   ;; FIXME: backward-sexp doesn't work with unbalanced braces in comments
 113
 114   (let* (column
 115          pos
 116          ;; Find start of enclosing block or assignment
 117          (token
 118           (if (member first '("]" "}" ")"))
 119               (progn
 120                 (goto-char (+ start 1))
 121                 (backward-sexp)
 122                 (beginning-of-line)
 123                 (re-search-forward "\\S ")
 124                 (setq pos (point))
 125                 (setq column (- (current-column) 1))
 126                 'lpar)
 127             (catch 'done
 128               (while (setq pos (re-search-backward "[{}()=]\\|\\[\\|\\]"
 129                                                    (point-min) t))
 130                 (let ((c (match-string 0)))
 131                   (beginning-of-line)
 132                   (re-search-forward "\\S ")
 133                   (setq column (- (current-column) 1))
 134                   (beginning-of-line)
 135                   (cond
 136                    ;; Don't match inside comments
 137                    ;; FIXME: Should exclude matches inside string literals too
 138                    ((re-search-forward "#" pos t) (beginning-of-line))
 139                    ;; Skip block
 140                    ((member c '("]" "}" ")"))
 141                     (goto-char (+ pos 1))
 142                     (backward-sexp))
 143
 144                    ((string= c "=") (throw 'done 'eq))
 145                    (t (throw 'done 'lpar)))))))))
 146
 147     (cond
 148      ((not pos) 0)
 149      ((member first '("]" "}" ")")) column)
 150      ((member first '("{" "(")) (+ column rnc-indent-level))
 151
 152      ;; Give lines starting with an operator a small negative indent.
 153      ;; This allows for the following indentation style:
 154      ;;   foo =
 155      ;;      bar
 156      ;;    | baz
 157      ;;    | oof
 158      ((member first '("," "&" "|")) (+ column (- rnc-indent-level 2)))
 159
 160      ;; Check if first preceding non-whitespace character was an operator
 161      ;; If not, this is most likely a new assignment.
 162      ;; FIXME: This doesn't play well with name classes starting on a new
 163      ;; line
 164      ((eq token 'eq)
 165       (goto-char start)
 166       (if (and (re-search-backward "[^ \t\n]" (point-min) t)
 167                (member (match-string 0) '("&" "|" "," "=" "~")))
 168           (+ column rnc-indent-level)
 169         column))
 170
 171      (t (+ column rnc-indent-level)))))
 172
 173 (defun rnc-indent-line ()
 174   "Indents the current line."
 175   (interactive)
 176   (let ((orig-point (point)))
 177     (beginning-of-line)
 178     (let* ((beg-of-line (point))
 179            (pos (re-search-forward "\\(\\S \\|\n\\)" (point-max) t))
 180            (first (match-string 0))
 181            (start (match-beginning 0))
 182            (col (- (current-column) 1)))
 183
 184       (goto-char beg-of-line)
 185
 186       (let ((indent-column (rnc-find-column first start)))
 187         (goto-char beg-of-line)
 188
 189         (cond
 190          ;; Only modify buffer if the line must be reindented
 191          ((not (= col indent-column))
 192           (if (not (or (null pos)
 193                        (= beg-of-line start)))
 194               (kill-region beg-of-line start))
 195
 196           (goto-char beg-of-line)
 197
 198           (while (< 0 indent-column)
 199             (insert " ")
 200             (setq indent-column (- indent-column 1))))
 201
 202          ((< orig-point start) (goto-char start))
 203          (t (goto-char orig-point)))))))
 204
 205
 206 (defun rnc-electric-brace (arg)
 207   (interactive "*P")
 208   (self-insert-command (prefix-numeric-value arg))
 209   (rnc-indent-line)
 210   (let ((p (point)))
 211     (when (save-excursion
 212             (beginning-of-line)
 213             (let ((pos (re-search-forward "\\S " (point-max) t)))
 214               (and pos (= (- pos 1) p))))
 215       (forward-char))))
 216
 217 (defvar rnc-mode-map () "Keymap used in RNC mode.")
 218 (when (not rnc-mode-map)
 219   (setq rnc-mode-map (make-sparse-keymap))
 220   (define-key rnc-mode-map "\C-c\C-c" 'comment-region)
 221   (define-key rnc-mode-map "}" 'rnc-electric-brace)
 222   (define-key rnc-mode-map "{" 'rnc-electric-brace)
 223   (define-key rnc-mode-map "]" 'rnc-electric-brace)
 224   (define-key rnc-mode-map "[" 'rnc-electric-brace))
 225
 226 ;;;###autoload
 227 (defun rnc-mode ()
 228   "Major mode for editing RELAX NG Compact Syntax schemas.
 229 \\{rnc-mode-map}"
 230   (interactive)
 231
 232   (kill-all-local-variables)
 233
 234   (make-local-variable 'indent-line-function)
 235   (setq indent-line-function 'rnc-indent-line)
 236
 237   (make-local-variable 'font-lock-defaults)
 238   (setq font-lock-defaults '(rnc-font-lock-keywords nil t nil nil))
 239
 240   (use-local-map rnc-mode-map)
 241
 242   (make-local-variable 'comment-start)
 243   (make-local-variable 'comment-end)
 244   (make-local-variable 'comment-start-skip)
 245
 246   (setq comment-start "#"
 247         comment-end ""
 248         comment-start-skip "\\([ \n\t]+\\)##?[ \n\t]+")
 249
 250   (let ((rnc-syntax-table (copy-syntax-table)))
 251     (modify-syntax-entry ?# "<   " rnc-syntax-table)
 252     (modify-syntax-entry ?\n ">   " rnc-syntax-table)
 253     (modify-syntax-entry ?\^m ">   " rnc-syntax-table)
 254     (modify-syntax-entry ?\\ "w   " rnc-syntax-table)
 255     (modify-syntax-entry ?' "\"   " rnc-syntax-table)
 256     (modify-syntax-entry ?. "w   " rnc-syntax-table)
 257     (modify-syntax-entry ?- "w   " rnc-syntax-table)
 258     (modify-syntax-entry ?_ "w   " rnc-syntax-table)
 259     (set-syntax-table rnc-syntax-table))
 260
 261   (setq mode-name "RNC"
 262         major-mode 'rnc-mode)
 263   (run-hooks 'rnc-mode-hook))
 264
 265 (provide 'rnc-mode)