Mercurial > urweb

comparison src/elisp/urweb-mode.el @ 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
comparison
equal deleted inserted replaced
357:368d9411ae67 358:583ca86a55a0
39 ;;; HISTORY 39 ;;; HISTORY
40 40
41 ;; Still under construction: History obscure, needs a biographer as 41 ;; Still under construction: History obscure, needs a biographer as
42 ;; well as a M-x doctor. Change Log on request. 42 ;; well as a M-x doctor. Change Log on request.
43 43
44 ;; Hacked by Olin Shivers for comint from Lars Bo Nielsen's urweb.el. 44 ;; Hacked by Olin Shivers for comint from Lars Bo Nielsen's sml.el.
45 45
46 ;; Hacked by Matthew Morley to incorporate Fritz Knabe's hilite and 46 ;; Hacked by Matthew Morley to incorporate Fritz Knabe's hilite and
47 ;; font-lock patterns, some of Steven Gilmore's (reduced) easy-menus, 47 ;; font-lock patterns, some of Steven Gilmore's (reduced) easy-menus,
48 ;; and numerous bugs and bug-fixes. 48 ;; and numerous bugs and bug-fixes.
49 49
157 "A regexp that matches uppercase Ur/Web identifiers.") 157 "A regexp that matches uppercase Ur/Web identifiers.")
158 158
159 ;;; Font-lock settings ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 159 ;;; Font-lock settings ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
160 160
161 ;; The font lock regular expressions. 161 ;; The font lock regular expressions.
162
163 (defun inXml (depth)
164 (and
165 (re-search-backward "[<>{}]" nil t)
166 (cond
167 ((looking-at "{")
168 (and (> depth 0)
169 (inXml (- depth 1))))
170 ((looking-at "}")
171 (inXml (+ depth 1)))
172 ((save-excursion (backward-char 1) (or (looking-at "=>") (looking-at "->")))
173 (inXml depth))
174 ((looking-at "<")
175 nil)
176 ((looking-at ">")
177 (if (> depth 0)
178 (and (re-search-backward "<" nil t)
179 (inXml depth))
180 (progn (backward-char 5) (not (looking-at "/html"))))))))
162 181
163 (defconst urweb-font-lock-keywords 182 (defconst urweb-font-lock-keywords
164 `(;;(urweb-font-comments-and-strings) 183 `(;;(urweb-font-comments-and-strings)
165 ("\\<\\(fun\\|and\\)\\s-+\\(\\sw+\\)\\s-+[^ \t\n=]" 184 ("\\<\\(fun\\|and\\)\\s-+\\(\\sw+\\)\\s-+[^ \t\n=]"
166 (1 font-lock-keyword-face) 185 (1 font-lock-keyword-face)
176 (2 font-lock-module-def-face)) 195 (2 font-lock-module-def-face))
177 ("\\<\\(signature\\)\\s-+\\(\\sw+\\)" 196 ("\\<\\(signature\\)\\s-+\\(\\sw+\\)"
178 (1 font-lock-keyword-face) 197 (1 font-lock-keyword-face)
179 (2 font-lock-interface-def-face)) 198 (2 font-lock-interface-def-face))
180 199
181 ("<\\(\\sw+\\)[^>]*>" 200 ("\\(<\\sw+\\)\\(\\s-\\|\\sw\\|=\\|\"[^\"]*\"\\|{[^}]*}\\)*/?\\(>\\)"
201 (1 font-lock-tag-face)
202 (3 font-lock-tag-face))
203 ("\\(</\\sw+>\\)"
182 (1 font-lock-tag-face)) 204 (1 font-lock-tag-face))
183 ("</\\(\\sw+\\)[^>]*>" 205 ("\\([^<>{}]+\\)"
184 (1 font-lock-tag-face)) 206 (1 (if (save-excursion (inXml 0))
207 font-lock-string-face
208 nil)))
185 209
186 (,urweb-keywords-regexp . font-lock-keyword-face) 210 (,urweb-keywords-regexp . font-lock-keyword-face)
187 (,urweb-sql-keywords-regexp . font-lock-sql-face) 211 (,urweb-sql-keywords-regexp . font-lock-sql-face)
188 ; (,urweb-lident-regexp . font-lock-variable-face)
189 (,urweb-cident-regexp . font-lock-cvariable-face)) 212 (,urweb-cident-regexp . font-lock-cvariable-face))
190 "Regexps matching standard Ur/Web keywords.") 213 "Regexps matching standard Ur/Web keywords.")
191 214
192 (defface font-lock-type-def-face 215 (defface font-lock-type-def-face
193 '((t (:bold t))) 216 '((t (:bold t)))
228 '((t (:bold t))) 251 '((t (:bold t)))
229 "Font Lock mode face used to highlight XML tags." 252 "Font Lock mode face used to highlight XML tags."
230 :group 'font-lock-highlighting-faces) 253 :group 'font-lock-highlighting-faces)
231 (defvar font-lock-tag-face 'font-lock-tag-face 254 (defvar font-lock-tag-face 'font-lock-tag-face
232 "Face name to use for XML tags.") 255 "Face name to use for XML tags.")
256
257 (defface font-lock-attr-face
258 '((t (:bold t)))
259 "Font Lock mode face used to highlight XML attributes."
260 :group 'font-lock-highlighting-faces)
261 (defvar font-lock-attr-face 'font-lock-attr-face
262 "Face name to use for XML attributes.")
233 263
234 ;; 264 ;;
235 ;; Code to handle nested comments and unusual string escape sequences 265 ;; Code to handle nested comments and unusual string escape sequences
236 ;; 266 ;;
237 267
304 334
305 ;;;###autoload (add-to-list 'load-path (file-name-directory load-file-name)) 335 ;;;###autoload (add-to-list 'load-path (file-name-directory load-file-name))
306 ;;;###autoload 336 ;;;###autoload
307 (add-to-list 'auto-mode-alist '("\\.s\\(ml\\|ig\\)\\'" . urweb-mode)) 337 (add-to-list 'auto-mode-alist '("\\.s\\(ml\\|ig\\)\\'" . urweb-mode))
308 338
339 ;(mmm-add-classes
340 ; '((urweb-html
341 ; :submode html-mode
342 ; :front "<html>"
343 ; :back "</html>")))
344
309 ;;;###autoload 345 ;;;###autoload
310 (define-derived-mode urweb-mode fundamental-mode "Ur/Web" 346 (define-derived-mode urweb-mode fundamental-mode "Ur/Web"
311 "\\<urweb-mode-map>Major mode for editing Ur/Web code. 347 "\\<urweb-mode-map>Major mode for editing Ur/Web code.
312 This mode runs `urweb-mode-hook' just before exiting. 348 This mode runs `urweb-mode-hook' just before exiting.
313 \\{urweb-mode-map}" 349 \\{urweb-mode-map}"
314 (set (make-local-variable 'font-lock-defaults) urweb-font-lock-defaults) 350 (set (make-local-variable 'font-lock-defaults) urweb-font-lock-defaults)
351 (set (make-local-variable 'font-lock-multiline) 'undecided)
315 (set (make-local-variable 'outline-regexp) urweb-outline-regexp) 352 (set (make-local-variable 'outline-regexp) urweb-outline-regexp)
316 (set (make-local-variable 'imenu-create-index-function) 353 (set (make-local-variable 'imenu-create-index-function)
317 'urweb-imenu-create-index) 354 'urweb-imenu-create-index)
318 (set (make-local-variable 'add-log-current-defun-function) 355 (set (make-local-variable 'add-log-current-defun-function)
319 'urweb-current-fun-name) 356 'urweb-current-fun-name)
323 (set (make-local-variable 'require-final-newline) t) 360 (set (make-local-variable 'require-final-newline) t)
324 ;; forward-sexp-function is an experimental variable in my hacked Emacs. 361 ;; forward-sexp-function is an experimental variable in my hacked Emacs.
325 (set (make-local-variable 'forward-sexp-function) 'urweb-user-forward-sexp) 362 (set (make-local-variable 'forward-sexp-function) 'urweb-user-forward-sexp)
326 ;; For XEmacs 363 ;; For XEmacs
327 (easy-menu-add urweb-mode-menu) 364 (easy-menu-add urweb-mode-menu)
365
366 ; (setq mmm-classes '(urweb-html))
367
328 ;; Compatibility. FIXME: we should use `-' in Emacs-CVS. 368 ;; Compatibility. FIXME: we should use `-' in Emacs-CVS.
329 (unless (boundp 'skeleton-positions) (set (make-local-variable '@) nil)) 369 (unless (boundp 'skeleton-positions) (set (make-local-variable '@) nil))
330 (urweb-mode-variables)) 370
371 (urweb-mode-variables)
372 ; (mmm-mode-on)
373 )
331 374
332 (defun urweb-mode-variables () 375 (defun urweb-mode-variables ()
333 (set-syntax-table urweb-mode-syntax-table) 376 (set-syntax-table urweb-mode-syntax-table)
334 (setq local-abbrev-table urweb-mode-abbrev-table) 377 (setq local-abbrev-table urweb-mode-abbrev-table)
335 ;; A paragraph is separated by blank lines or ^L only. 378 ;; A paragraph is separated by blank lines or ^L only.
685 (setq fullname (if fullname (concat name "." fullname) name)) 728 (setq fullname (if fullname (concat name "." fullname) name))
686 ;; Skip all other declarations that we find at the same level. 729 ;; Skip all other declarations that we find at the same level.
687 (urweb-skip-siblings)) 730 (urweb-skip-siblings))
688 fullname))) 731 fullname)))
689 732
733
734
690 (provide 'urweb-mode) 735 (provide 'urweb-mode)
691 736
692 ;;; urweb-mode.el ends here 737 ;;; urweb-mode.el ends here