Mercurial > urweb

comparison src/elisp/urweb-mode.el @ 360:c1e96b387115

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Syntax highlighting for embedded XML
author Adam Chlipala <adamc@hcoop.net>
date Tue, 14 Oct 2008 16:37:43 -0400
parents 465593c024ca
children 24a31b35e08f
comparison
equal deleted inserted replaced
359:465593c024ca 360:c1e96b387115
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 162
163 (defun inXml (depth) 163 (defun inXml ()
164 (and 164 (save-excursion
165 (re-search-backward "[<>{}]" nil t) 165 (let (
166 (cond 166 (depth 0)
167 ((looking-at "{") 167 (finished nil)
168 (and (> depth 0) 168 (answer nil)
169 (inXml (- depth 1)))) 169 )
170 ((looking-at "}") 170 (while (and (not finished) (re-search-backward "[<>{}]" nil t))
171 (inXml (+ depth 1))) 171 (cond
172 ((save-excursion (backward-char 1) (or (looking-at "=>") (looking-at "->"))) 172 ((looking-at "{")
173 (inXml depth)) 173 (if (> depth 0)
174 ((looking-at "<") 174 (setq depth (- depth 1))
175 nil) 175 (setq finished t)))
176 ((looking-at ">") 176 ((looking-at "}")
177 (if (> depth 0) 177 (setq depth (+ depth 1)))
178 (and (re-search-backward "<" nil t) 178 ((save-excursion (backward-char 1) (or (looking-at "=>") (looking-at "->")))
179 (inXml depth)) 179 nil)
180 (progn (backward-char 5) (not (looking-at "/html")))))))) 180 ((looking-at "<")
181 (setq finished t))
182 ((looking-at ">")
183 (if (> depth 0)
184 (if (not (re-search-backward "<" nil t))
185 (setq finished t))
186 (progn (backward-char 4)
187 (setq answer (not (or
188 (looking-at "/xml")
189 (looking-at "xml/"))))
190 (setq finished t))))))
191 answer)))
192
193 (defun amAttribute (face)
194 (if (ignore-errors (save-excursion (backward-word 2) (backward-char 1) (looking-at "<")))
195 nil
196 face))
181 197
182 (defconst urweb-font-lock-keywords 198 (defconst urweb-font-lock-keywords
183 `(;;(urweb-font-comments-and-strings) 199 `(;;(urweb-font-comments-and-strings)
184 ("\\(<\\sw+\\)\\(\\s-\\|\\sw\\|=\\|\"[^\"]*\"\\|{[^}]*}\\)*/?\\(>\\)" 200 ("\\(<\\sw+\\)\\(\\s-\\|\\sw\\|=\\|\"[^\"]*\"\\|{[^}]*}\\)*/?\\(>\\)"
185 (1 font-lock-tag-face) 201 (1 font-lock-tag-face)
186 (3 font-lock-tag-face)) 202 (3 font-lock-tag-face))
187 ("\\(</\\sw+>\\)" 203 ("\\(</\\sw+>\\)"
188 (1 font-lock-tag-face)) 204 (1 font-lock-tag-face))
189 ("\\([^<>{}]+\\)" 205 ("\\([^<>{}]+\\)"
190 (1 (if (save-excursion (inXml 0)) 206 (1 (if (inXml)
191 font-lock-string-face 207 font-lock-string-face
192 nil))) 208 nil)))
193 209
194 ("\\<\\(fun\\|and\\)\\s-+\\(\\sw+\\)\\s-+[^ \t\n=]" 210 ("\\<\\(fun\\|and\\)\\s-+\\(\\sw+\\)\\s-+[^ \t\n=]"
195 (1 font-lock-keyword-face) 211 (1 font-lock-keyword-face)
196 (2 font-lock-function-name-face)) 212 (2 (amAttribute font-lock-function-name-face)))
197 ("\\<\\(\\(data\\)?type\\|con\\|class\\)\\s-+\\(\\sw+\\)" 213 ("\\<\\(\\(data\\)?type\\|con\\|class\\)\\s-+\\(\\sw+\\)"
198 (1 font-lock-keyword-face) 214 (1 font-lock-keyword-face)
199 (3 font-lock-type-def-face)) 215 (3 (amAttribute font-lock-type-def-face)))
200 ("\\<\\(val\\|table\\|sequence\\)\\s-+\\(\\sw+\\>\\s-*\\)?\\(\\sw+\\)\\s-*[=:]" 216 ("\\<\\(val\\|table\\|sequence\\)\\s-+\\(\\sw+\\>\\s-*\\)?\\(\\sw+\\)\\s-*[=:]"
201 (1 font-lock-keyword-face) 217 (1 font-lock-keyword-face)
202 (3 font-lock-variable-name-face)) 218 (3 (amAttribute font-lock-variable-name-face)))
203 ("\\<\\(structure\\|functor\\)\\s-+\\(\\sw+\\)" 219 ("\\<\\(structure\\|functor\\)\\s-+\\(\\sw+\\)"
204 (1 font-lock-keyword-face) 220 (1 font-lock-keyword-face)
205 (2 font-lock-module-def-face)) 221 (2 (amAttribute font-lock-module-def-face)))
206 ("\\<\\(signature\\)\\s-+\\(\\sw+\\)" 222 ("\\<\\(signature\\)\\s-+\\(\\sw+\\)"
207 (1 font-lock-keyword-face) 223 (1 font-lock-keyword-face)
208 (2 font-lock-interface-def-face)) 224 (2 (amAttribute font-lock-interface-def-face)))
209 225
210 (,urweb-keywords-regexp . font-lock-keyword-face) 226 (,urweb-keywords-regexp . font-lock-keyword-face)
211 (,urweb-sql-keywords-regexp . font-lock-sql-face) 227 (,urweb-sql-keywords-regexp . font-lock-sql-face)
212 (,urweb-cident-regexp . font-lock-cvariable-face)) 228 (,urweb-cident-regexp . font-lock-cvariable-face))
213 "Regexps matching standard Ur/Web keywords.") 229 "Regexps matching standard Ur/Web keywords.")
334 350
335 ;;;###autoload (add-to-list 'load-path (file-name-directory load-file-name)) 351 ;;;###autoload (add-to-list 'load-path (file-name-directory load-file-name))
336 ;;;###autoload 352 ;;;###autoload
337 (add-to-list 'auto-mode-alist '("\\.s\\(ml\\|ig\\)\\'" . urweb-mode)) 353 (add-to-list 'auto-mode-alist '("\\.s\\(ml\\|ig\\)\\'" . urweb-mode))
338 354
339 ;(mmm-add-classes
340 ; '((urweb-html
341 ; :submode html-mode
342 ; :front "<html>"
343 ; :back "</html>")))
344
345 ;;;###autoload 355 ;;;###autoload
346 (define-derived-mode urweb-mode fundamental-mode "Ur/Web" 356 (define-derived-mode urweb-mode fundamental-mode "Ur/Web"
347 "\\<urweb-mode-map>Major mode for editing Ur/Web code. 357 "\\<urweb-mode-map>Major mode for editing Ur/Web code.
348 This mode runs `urweb-mode-hook' just before exiting. 358 This mode runs `urweb-mode-hook' just before exiting.
349 \\{urweb-mode-map}" 359 \\{urweb-mode-map}"
361 ;; forward-sexp-function is an experimental variable in my hacked Emacs. 371 ;; forward-sexp-function is an experimental variable in my hacked Emacs.
362 (set (make-local-variable 'forward-sexp-function) 'urweb-user-forward-sexp) 372 (set (make-local-variable 'forward-sexp-function) 'urweb-user-forward-sexp)
363 ;; For XEmacs 373 ;; For XEmacs
364 (easy-menu-add urweb-mode-menu) 374 (easy-menu-add urweb-mode-menu)
365 375
366 ; (setq mmm-classes '(urweb-html))
367
368 ;; Compatibility. FIXME: we should use `-' in Emacs-CVS. 376 ;; Compatibility. FIXME: we should use `-' in Emacs-CVS.
369 (unless (boundp 'skeleton-positions) (set (make-local-variable '@) nil)) 377 (unless (boundp 'skeleton-positions) (set (make-local-variable '@) nil))
370 378
371 (urweb-mode-variables) 379 (urweb-mode-variables))
372 ; (mmm-mode-on)
373 )
374 380
375 (defun urweb-mode-variables () 381 (defun urweb-mode-variables ()
376 (set-syntax-table urweb-mode-syntax-table) 382 (set-syntax-table urweb-mode-syntax-table)
377 (setq local-abbrev-table urweb-mode-abbrev-table) 383 (setq local-abbrev-table urweb-mode-abbrev-table)
378 ;; A paragraph is separated by blank lines or ^L only. 384 ;; A paragraph is separated by blank lines or ^L only.