elisp/domtool-mode.el

   1 ; Created by Brian Templeton (bpt@hcoop.net)
   2 ; Extended by Adam Chlipala (adamc@hcoop.net)
   3
   4 (eval-when-compile (require 'cl))
   5
   6 (defvar domtool-indent 2)
   7
   8 (defvar domtool-mode-syntax-table
   9   (let ((table (make-syntax-table)))
  10     (loop for i from ?a to ?z
  11           do (modify-syntax-entry i "w" table))
  12     (loop for i from ?A to ?Z
  13           do (modify-syntax-entry i "w" table))
  14     (loop for i from ?0 to ?9
  15           do (modify-syntax-entry i "w" table))
  16     (mapc
  17      (lambda (pair)
  18        (loop for ch across (if (stringp (car pair))
  19                                (car pair)
  20                              (string (car pair)))
  21              do (modify-syntax-entry ch (cadr pair) table)))
  22      '((" \t\n\14" " ")                 ; \14 is ^L
  23        (?_  "_")
  24        (?*  ". 23n")
  25        (?\( "()1")
  26        (?\) ")(4")
  27        (?\" "\"")
  28        (?\\ "\\")
  29        (?\[ "(]")
  30        (?\] ")[")
  31        ;; We identify single-line comments using
  32        ;; font-lock-syntactic-keywords, because it's easier to
  33        ;; recognize documentation comments using the syntax table.
  34        (?\{ "(}12b")
  35        (?\} "){34b")
  36        ("->=<,:;^!&" ".")               ; -> => <- = , : ; ^ ! &
  37        ))
  38     table))
  39
  40 (defun domtool-syms-re (&rest syms)
  41   (concat "\\<" (regexp-opt syms t) "\\>"))
  42
  43 (load-file "/usr/local/share/emacs/site-lisp/domtool-mode/domtool-tables.el")
  44
  45 (defvar domtool-font-lock-keywords
  46   `(,(concat
  47       "\\_<"
  48       (regexp-opt '("let" "in" "begin" "end" "with" "where" "extern" "type"
  49                     "val" "context" "Root")
  50                   t)
  51       "\\_>")
  52
  53     (,domtool-actions-regexp . font-lock-builtin-face)
  54     (,domtool-vals-regexp . font-lock-variable-name-face)
  55     (,domtool-contexts-regexp . font-lock-constant-face)
  56     (,domtool-env-vars-regexp . font-lock-constant-face)
  57     (,domtool-types-regexp . font-lock-type-face)
  58
  59     ("type[ \t]+\\(\\(\\sw\\|\\s_\\)+\\)" 1 font-lock-type-face)
  60     ("val[ \t]+\\(\\(\\sw\\|\\s_\\)+\\)" 1 font-lock-variable-name-face)))
  61
  62 (defvar domtool-font-lock-syntactic-keywords
  63   '(("\\(#\\).*\\(\n\\|\\'\\)"
  64      (1 "!")
  65      (2 "!"))))
  66
  67 (defun domtool-font-lock-syntactic-face-function (state)
  68   "Major mode for editing Domtool files."
  69   (cond ((nth 3 state) font-lock-string-face)
  70         ((eq (nth 7 state) t) font-lock-doc-face)
  71         (t font-lock-comment-face)))
  72
  73 (define-derived-mode domtool-mode fundamental-mode "Domtool"
  74   ;; For some reason, whatever twiddling `define-derived-mode' does
  75   ;; with the syntax table breaks recognition of (*...*) comments. So
  76   ;; we need to tell d-d-m to leave our syntax table alone.
  77   :syntax-table domtool-mode-syntax-table
  78   (set (make-local-variable 'indent-line-function) 'domtool-indent-line)
  79   (set (make-local-variable 'font-lock-defaults)
  80        '(domtool-font-lock-keywords
  81          nil nil nil nil
  82          (font-lock-syntactic-keywords
  83           . domtool-font-lock-syntactic-keywords)
  84          (font-lock-syntactic-face-function
  85           . domtool-font-lock-syntactic-face-function)))
  86   (set (make-local-variable 'comment-start) "(* ")
  87   (set (make-local-variable 'comment-end) " *)")
  88   (set (make-local-variable 'comment-nested) t)
  89
  90   (set (make-local-variable 'compile-command)
  91        (concat "domtool -tc " (file-relative-name buffer-file-name))))
  92
  93 (defun domtool-indent-line ()
  94   (let ((savep (> (current-column) (current-indentation)))
  95         (indent (domtool-calculate-indent)))
  96     (cond
  97      ((eq indent 'noindent) indent)
  98      (savep (save-excursion (indent-line-to indent)))
  99      (t (indent-line-to indent)))))
 100
 101 (defun until-closed-helper (level)
 102   (if
 103       (re-search-backward "\\_<\\(with\\|where\\|begin\\|end\\)\\_>"
 104                           nil t)
 105       (cond
 106        ((string= (match-string 0) "end")
 107         (until-closed-helper (+ level 1)))
 108        ((= level 0)
 109         (current-indentation))
 110        (t
 111         (until-closed-helper (- level 1))))
 112
 113     0))
 114
 115 (defun until-closed ()
 116   (save-excursion
 117     (until-closed-helper 0)))
 118
 119 (defun domtool-calculate-indent ()
 120   (save-excursion
 121     (back-to-indentation)
 122     (multiple-value-bind (previous-keyword base-indent)
 123         (save-excursion
 124           (if (re-search-backward "\\_<\\(with\\|where\\|begin\\|end\\)\\_>"
 125                                   nil t)
 126               (values (match-string 0) (current-indentation))
 127             (values nil 0)))
 128       (let ((state (syntax-ppss)))
 129         (cond
 130          ((nth 3 state)
 131           'noindent)
 132          ((nth 4 state)
 133           (domtool-calculate-comment-indent state))
 134          ((looking-at "\\_<\\(with\\|end\\)\\_>")
 135           (until-closed))
 136          ((not previous-keyword)
 137           base-indent)
 138          ((string= previous-keyword "end")
 139           base-indent)
 140          (t
 141           (+ base-indent domtool-indent)))))))
 142
 143 (defun domtool-calculate-comment-indent (state)
 144   (ecase (nth 7 state)
 145     ((t) 'noindent)
 146     ((syntax-table) 'noindent)          ; can't happen
 147     ((nil) (let ((start (nth 8 state))
 148                  (depth 0))
 149              (while (> (point) start)
 150                (re-search-backward "(\\*\\|\\*)" start t)
 151                (if (looking-at "(\\*")
 152                    (incf depth)
 153                  (decf depth)))
 154              (+ (current-indentation) depth)))))