Mercurial > urweb

changeset 358:583ca86a55a0

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Good progress on highlighting embedded XML
author Adam Chlipala <adamc@hcoop.net>
date Sun, 12 Oct 2008 21:33:52 -0400
parents 368d9411ae67
children 465593c024ca
files src/elisp/urweb-mode.el
diffstat 1 files changed, 51 insertions(+), 6 deletions(-) [+]
line wrap: on
line diff
--- a/src/elisp/urweb-mode.el	Sun Oct 12 12:53:45 2008 -0400
+++ b/src/elisp/urweb-mode.el	Sun Oct 12 21:33:52 2008 -0400
@@ -41,7 +41,7 @@
 ;; Still under construction: History obscure, needs a biographer as
 ;; well as a M-x doctor. Change Log on request.
 
-;; Hacked by Olin Shivers for comint from Lars Bo Nielsen's urweb.el.
+;; Hacked by Olin Shivers for comint from Lars Bo Nielsen's sml.el.
 
 ;; Hacked by Matthew Morley to incorporate Fritz Knabe's hilite and
 ;; font-lock patterns, some of Steven Gilmore's (reduced) easy-menus,
@@ -160,6 +160,25 @@
 
 ;; The font lock regular expressions.
 
+(defun inXml (depth)
+  (and
+   (re-search-backward "[<>{}]" nil t)
+   (cond
+    ((looking-at "{")
+     (and (> depth 0)
+          (inXml (- depth 1))))
+    ((looking-at "}")
+     (inXml (+ depth 1)))
+    ((save-excursion (backward-char 1) (or (looking-at "=>") (looking-at "->")))
+     (inXml depth))
+    ((looking-at "<")
+     nil)
+    ((looking-at ">")
+     (if (> depth 0)
+         (and (re-search-backward "<" nil t)
+              (inXml depth))
+       (progn (backward-char 5) (not (looking-at "/html"))))))))
+
 (defconst urweb-font-lock-keywords
   `(;;(urweb-font-comments-and-strings)
     ("\\<\\(fun\\|and\\)\\s-+\\(\\sw+\\)\\s-+[^ \t\n=]"
@@ -178,14 +197,18 @@
      (1 font-lock-keyword-face)
      (2 font-lock-interface-def-face))
 
-    ("<\\(\\sw+\\)[^>]*>"
+    ("\\(<\\sw+\\)\\(\\s-\\|\\sw\\|=\\|\"[^\"]*\"\\|{[^}]*}\\)*/?\\(>\\)"
+     (1 font-lock-tag-face)
+     (3 font-lock-tag-face))
+    ("\\(</\\sw+>\\)"
      (1 font-lock-tag-face))
-    ("</\\(\\sw+\\)[^>]*>"
-     (1 font-lock-tag-face))
+    ("\\([^<>{}]+\\)"
+     (1 (if (save-excursion (inXml 0))
+            font-lock-string-face
+          nil)))
     
     (,urweb-keywords-regexp . font-lock-keyword-face)
     (,urweb-sql-keywords-regexp . font-lock-sql-face)
-;   (,urweb-lident-regexp . font-lock-variable-face)
     (,urweb-cident-regexp . font-lock-cvariable-face))
   "Regexps matching standard Ur/Web keywords.")
 
@@ -231,6 +254,13 @@
 (defvar font-lock-tag-face 'font-lock-tag-face
   "Face name to use for XML tags.")
 
+(defface font-lock-attr-face
+  '((t (:bold t)))
+  "Font Lock mode face used to highlight XML attributes."
+  :group 'font-lock-highlighting-faces)
+(defvar font-lock-attr-face 'font-lock-attr-face
+  "Face name to use for XML attributes.")
+
 ;;
 ;; Code to handle nested comments and unusual string escape sequences
 ;;
@@ -306,12 +336,19 @@
 ;;;###autoload
 (add-to-list 'auto-mode-alist '("\\.s\\(ml\\|ig\\)\\'" . urweb-mode))
 
+;(mmm-add-classes
+; '((urweb-html
+;    :submode html-mode
+;    :front "<html>"
+;    :back "</html>")))
+
 ;;;###autoload
 (define-derived-mode urweb-mode fundamental-mode "Ur/Web"
   "\\<urweb-mode-map>Major mode for editing Ur/Web code.
 This mode runs `urweb-mode-hook' just before exiting.
 \\{urweb-mode-map}"
   (set (make-local-variable 'font-lock-defaults) urweb-font-lock-defaults)
+  (set (make-local-variable 'font-lock-multiline) 'undecided)
   (set (make-local-variable 'outline-regexp) urweb-outline-regexp)
   (set (make-local-variable 'imenu-create-index-function)
        'urweb-imenu-create-index)
@@ -325,9 +362,15 @@
   (set (make-local-variable 'forward-sexp-function) 'urweb-user-forward-sexp)
   ;; For XEmacs
   (easy-menu-add urweb-mode-menu)
+
+;  (setq mmm-classes '(urweb-html)) 
+
   ;; Compatibility.  FIXME: we should use `-' in Emacs-CVS.
   (unless (boundp 'skeleton-positions) (set (make-local-variable '@) nil))
-  (urweb-mode-variables))
+
+  (urweb-mode-variables)
+;  (mmm-mode-on)
+  )
 
 (defun urweb-mode-variables ()
   (set-syntax-table urweb-mode-syntax-table)
@@ -687,6 +730,8 @@
 	(urweb-skip-siblings))
       fullname)))
 
+
+
 (provide 'urweb-mode)
 
 ;;; urweb-mode.el ends here