Mercurial > urweb

comparison src/elisp/urweb-mode.el @ 350:3a1e36b14105

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
First sort-of-working run of urweb-mode
author Adam Chlipala <adamc@hcoop.net>
date Sun, 12 Oct 2008 10:04:17 -0400
parents
children d5148178a7be
comparison
equal deleted inserted replaced
349:beb72f8a7218 350:3a1e36b14105
1 ;;; urweb-mode.el --- Major mode for editing (Standard) ML
2
3 ;; Based on sml-mode:
4 ;; Copyright (C) 1999,2000,2004 Stefan Monnier
5 ;; Copyright (C) 1994-1997 Matthew J. Morley
6 ;; Copyright (C) 1989 Lars Bo Nielsen
7 ;;
8 ;; Modified for urweb-mode:
9 ;; Copyright (C) 2008 Adam Chlipala <adamc@hcoop.net>
10
11 ;; Author: Lars Bo Nielsen
12 ;; Olin Shivers
13 ;; Fritz Knabe (?)
14 ;; Steven Gilmore (?)
15 ;; Matthew Morley <mjm@scs.leeds.ac.uk> (aka <matthew@verisity.com>)
16 ;; Matthias Blume <blume@cs.princeton.edu> (aka <blume@kurims.kyoto-u.ac.jp>)
17 ;; (Stefan Monnier) monnier@cs.yale.edu
18 ;; Adam Chlipala
19
20 ;; This file is not part of GNU Emacs, but it is distributed under the
21 ;; same conditions.
22
23 ;; This program is free software; you can redistribute it and/or
24 ;; modify it under the terms of the GNU General Public License as
25 ;; published by the Free Software Foundation; either version 2, or (at
26 ;; your option) any later version.
27
28 ;; This program is distributed in the hope that it will be useful, but
29 ;; WITHOUT ANY WARRANTY; without even the implied warranty of
30 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
31 ;; General Public License for more details.
32
33 ;; You should have received a copy of the GNU General Public License
34 ;; along with GNU Emacs; see the file COPYING. If not, write to the
35 ;; Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
36
37 ;;; Commentary:
38
39 ;;; HISTORY
40
41 ;; Still under construction: History obscure, needs a biographer as
42 ;; well as a M-x doctor. Change Log on request.
43
44 ;; Hacked by Olin Shivers for comint from Lars Bo Nielsen's urweb.el.
45
46 ;; Hacked by Matthew Morley to incorporate Fritz Knabe's hilite and
47 ;; font-lock patterns, some of Steven Gilmore's (reduced) easy-menus,
48 ;; and numerous bugs and bug-fixes.
49
50 ;;; DESCRIPTION
51
52 ;; See accompanying info file: urweb-mode.info
53
54 ;;; FOR YOUR .EMACS FILE
55
56 ;; If urweb-mode.el lives in some non-standard directory, you must tell
57 ;; emacs where to get it. This may or may not be necessary:
58
59 ;; (add-to-list 'load-path "~jones/lib/emacs/")
60
61 ;; Then to access the commands autoload urweb-mode with that command:
62
63 ;; (load "urweb-mode-startup")
64
65 ;; urweb-mode-hook is run whenever a new urweb-mode buffer is created.
66
67 ;;; Code:
68
69 (eval-when-compile (require 'cl))
70 (require 'urweb-util)
71 (require 'urweb-move)
72 (require 'urweb-defs)
73 (condition-case nil (require 'skeleton) (error nil))
74
75 ;;; VARIABLES CONTROLLING INDENTATION
76
77 (defcustom urweb-indent-level 4
78 "*Indentation of blocks in Ur/Web (see also `urweb-structure-indent')."
79 :group 'urweb
80 :type '(integer))
81
82 (defcustom urweb-indent-args urweb-indent-level
83 "*Indentation of args placed on a separate line."
84 :group 'urweb
85 :type '(integer))
86
87 (defcustom urweb-electric-semi-mode nil
88 "*If non-nil, `\;' will self insert, reindent the line, and do a newline.
89 If nil, just insert a `\;'. (To insert while t, do: \\[quoted-insert] \;)."
90 :group 'urweb
91 :type 'boolean)
92
93 (defcustom urweb-rightalign-and t
94 "If non-nil, right-align `and' with its leader.
95 If nil: If t:
96 datatype a = A datatype a = A
97 and b = B and b = B"
98 :group 'urweb
99 :type 'boolean)
100
101 ;;; OTHER GENERIC MODE VARIABLES
102
103 (defvar urweb-mode-info "urweb-mode"
104 "*Where to find Info file for `urweb-mode'.
105 The default assumes the info file \"urweb-mode.info\" is on Emacs' info
106 directory path. If it is not, either put the file on the standard path
107 or set the variable `urweb-mode-info' to the exact location of this file
108
109 (setq urweb-mode-info \"/usr/me/lib/info/urweb-mode\")
110
111 in your .emacs file. You can always set it interactively with the
112 set-variable command.")
113
114 (defvar urweb-mode-hook nil
115 "*Run upon entering `urweb-mode'.
116 This is a good place to put your preferred key bindings.")
117
118 ;;; CODE FOR Ur/Web-MODE
119
120 (defun urweb-mode-info ()
121 "Command to access the TeXinfo documentation for `urweb-mode'.
122 See doc for the variable `urweb-mode-info'."
123 (interactive)
124 (require 'info)
125 (condition-case nil
126 (info urweb-mode-info)
127 (error (progn
128 (describe-variable 'urweb-mode-info)
129 (message "Can't find it... set this variable first!")))))
130
131
132 ;; font-lock setup
133
134 (defconst urweb-keywords-regexp
135 (urweb-syms-re "and" "case" "class" "con" "constraint" "constraints"
136 "datatype" "else" "end" "extern" "fn" "fold"
137 "fun" "functor" "if" "include"
138 "of" "open"
139 "rec" "sequence" "sig" "signature"
140 "struct" "structure" "table" "then" "type" "val" "where"
141 "with"
142
143 "Name" "Type" "Unit")
144 "A regexp that matches any non-SQL keywords of Ur/Web.")
145
146 (defconst urweb-sql-keywords-regexp
147 (urweb-syms-re "SELECT" "FROM" "AS" "WHERE" "SQL" "GROUP" "ORDER" "BY"
148 "HAVING" "LIMIT" "OFFSET" "ALL" "UNION" "INTERSECT" "EXCEPT"
149 "TRUE" "FALSE" "AND" "OR" "NOT" "COUNT" "AVG" "SUM" "MIN" "MAX"
150 "ASC" "DESC" "INSERT" "INTO" "VALUES" "UPDATE" "SET" "DELETE")
151 "A regexp that matches SQL keywords.")
152
153 ;;; Font-lock settings ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
154
155 ;; The font lock regular expressions.
156
157 (defconst urweb-font-lock-keywords
158 `(;;(urweb-font-comments-and-strings)
159 (,(concat "\\<\\(fun\\|and\\)\\s-+\\(\\sw+\\)\\s-+[^ \t\n=]")
160 (1 font-lock-keyword-face)
161 (6 font-lock-function-name-face))
162 (,(concat "\\<\\(\\(data\\)?type\\|con\\)\\s-+\\(\\sw+\\)")
163 (1 font-lock-keyword-face)
164 (7 font-lock-type-def-face))
165 ("\\<\\(val\\)\\s-+\\(\\sw+\\>\\s-*\\)?\\(\\sw+\\)\\s-*[=:]"
166 (1 font-lock-keyword-face)
167 (3 font-lock-variable-name-face))
168 ("\\<\\(structure\\|functor\\)\\s-+\\(\\sw+\\)"
169 (1 font-lock-keyword-face)
170 (2 font-lock-module-def-face))
171 ("\\<\\(signature\\)\\s-+\\(\\sw+\\)"
172 (1 font-lock-keyword-face)
173 (2 font-lock-interface-def-face))
174
175 (,urweb-keywords-regexp . font-lock-keyword-face)
176 (,urweb-sql-keywords-regexp . font-lock-sql-face))
177 "Regexps matching standard Ur/Web keywords.")
178
179 (defface font-lock-type-def-face
180 '((t (:bold t)))
181 "Font Lock mode face used to highlight type definitions."
182 :group 'font-lock-highlighting-faces)
183 (defvar font-lock-type-def-face 'font-lock-type-def-face
184 "Face name to use for type definitions.")
185
186 (defface font-lock-module-def-face
187 '((t (:bold t)))
188 "Font Lock mode face used to highlight module definitions."
189 :group 'font-lock-highlighting-faces)
190 (defvar font-lock-module-def-face 'font-lock-module-def-face
191 "Face name to use for module definitions.")
192
193 (defface font-lock-interface-def-face
194 '((t (:bold t)))
195 "Font Lock mode face used to highlight interface definitions."
196 :group 'font-lock-highlighting-faces)
197 (defvar font-lock-interface-def-face 'font-lock-interface-def-face
198 "Face name to use for interface definitions.")
199
200 (defface font-lock-sql-face
201 '((t (:bold t)))
202 "Font Lock mode face used to highlight SQL keywords."
203 :group 'font-lock-highlighting-faces)
204 (defvar font-lock-sql-face 'font-lock-sql-face
205 "Face name to use for SQL keywords.")
206
207 ;;
208 ;; Code to handle nested comments and unusual string escape sequences
209 ;;
210
211 (defsyntax urweb-syntax-prop-table
212 '((?\\ . ".") (?* . "."))
213 "Syntax table for text-properties")
214
215 ;; For Emacsen that have no built-in support for nested comments
216 (defun urweb-get-depth-st ()
217 (save-excursion
218 (let* ((disp (if (eq (char-before) ?\)) (progn (backward-char) -1) nil))
219 (_ (backward-char))
220 (disp (if (eq (char-before) ?\() (progn (backward-char) 0) disp))
221 (pt (point)))
222 (when disp
223 (let* ((depth
224 (save-match-data
225 (if (re-search-backward "\\*)\\|(\\*" nil t)
226 (+ (or (get-char-property (point) 'comment-depth) 0)
227 (case (char-after) (?\( 1) (?* 0))
228 disp)
229 0)))
230 (depth (if (> depth 0) depth)))
231 (put-text-property pt (1+ pt) 'comment-depth depth)
232 (when depth urweb-syntax-prop-table))))))
233
234 (defconst urweb-font-lock-syntactic-keywords
235 `(("^\\s-*\\(\\\\\\)" (1 ',urweb-syntax-prop-table))
236 ,@(unless urweb-builtin-nested-comments-flag
237 '(("(?\\(\\*\\))?" (1 (urweb-get-depth-st)))))))
238
239 (defconst urweb-font-lock-defaults
240 '(urweb-font-lock-keywords nil nil ((?_ . "w") (?' . "w")) nil
241 (font-lock-syntactic-keywords . urweb-font-lock-syntactic-keywords)))
242
243 ;;;;
244 ;;;; Imenu support
245 ;;;;
246
247 (defvar urweb-imenu-regexp
248 (concat "^[ \t]*\\(let[ \t]+\\)?"
249 (regexp-opt (append urweb-module-head-syms
250 '("and" "fun" "datatype" "type")) t)
251 "\\>"))
252
253 (defun urweb-imenu-create-index ()
254 (let (alist)
255 (goto-char (point-max))
256 (while (re-search-backward urweb-imenu-regexp nil t)
257 (save-excursion
258 (let ((kind (match-string 2))
259 (column (progn (goto-char (match-beginning 2)) (current-column)))
260 (location
261 (progn (goto-char (match-end 0))
262 (urweb-forward-spaces)
263 (when (looking-at urweb-tyvarseq-re)
264 (goto-char (match-end 0)))
265 (point)))
266 (name (urweb-forward-sym)))
267 ;; Eliminate trivial renamings.
268 (when (or (not (member kind '("structure" "signature")))
269 (progn (search-forward "=")
270 (urweb-forward-spaces)
271 (looking-at "sig\\|struct")))
272 (push (cons (concat (make-string (/ column 2) ?\ ) name) location)
273 alist)))))
274 alist))
275
276 ;;; MORE CODE FOR URWEB-MODE
277
278 ;;;###autoload (add-to-list 'load-path (file-name-directory load-file-name))
279 ;;;###autoload
280 (add-to-list 'auto-mode-alist '("\\.s\\(ml\\|ig\\)\\'" . urweb-mode))
281
282 ;;;###autoload
283 (define-derived-mode urweb-mode fundamental-mode "Ur/Web"
284 "\\<urweb-mode-map>Major mode for editing Ur/Web code.
285 This mode runs `urweb-mode-hook' just before exiting.
286 \\{urweb-mode-map}"
287 (set (make-local-variable 'font-lock-defaults) urweb-font-lock-defaults)
288 (set (make-local-variable 'outline-regexp) urweb-outline-regexp)
289 (set (make-local-variable 'imenu-create-index-function)
290 'urweb-imenu-create-index)
291 (set (make-local-variable 'add-log-current-defun-function)
292 'urweb-current-fun-name)
293 ;; Treat paragraph-separators in comments as paragraph-separators.
294 (set (make-local-variable 'paragraph-separate)
295 (concat "\\([ \t]*\\*)?\\)?\\(" paragraph-separate "\\)"))
296 (set (make-local-variable 'require-final-newline) t)
297 ;; forward-sexp-function is an experimental variable in my hacked Emacs.
298 (set (make-local-variable 'forward-sexp-function) 'urweb-user-forward-sexp)
299 ;; For XEmacs
300 (easy-menu-add urweb-mode-menu)
301 ;; Compatibility. FIXME: we should use `-' in Emacs-CVS.
302 (unless (boundp 'skeleton-positions) (set (make-local-variable '@) nil))
303 (urweb-mode-variables))
304
305 (defun urweb-mode-variables ()
306 (set-syntax-table urweb-mode-syntax-table)
307 (setq local-abbrev-table urweb-mode-abbrev-table)
308 ;; A paragraph is separated by blank lines or ^L only.
309
310 (set (make-local-variable 'indent-line-function) 'urweb-indent-line)
311 (set (make-local-variable 'comment-start) "(* ")
312 (set (make-local-variable 'comment-end) " *)")
313 (set (make-local-variable 'comment-nested) t)
314 ;;(set (make-local-variable 'block-comment-start) "* ")
315 ;;(set (make-local-variable 'block-comment-end) "")
316 ;; (set (make-local-variable 'comment-column) 40)
317 (set (make-local-variable 'comment-start-skip) "(\\*+\\s-*"))
318
319 (defun urweb-funname-of-and ()
320 "Name of the function this `and' defines, or nil if not a function.
321 Point has to be right after the `and' symbol and is not preserved."
322 (urweb-forward-spaces)
323 (if (looking-at urweb-tyvarseq-re) (goto-char (match-end 0)))
324 (let ((sym (urweb-forward-sym)))
325 (urweb-forward-spaces)
326 (unless (or (member sym '(nil "d="))
327 (member (urweb-forward-sym) '("d=")))
328 sym)))
329
330 ;;; INDENTATION !!!
331
332 (defun urweb-mark-function ()
333 "Synonym for `mark-paragraph' -- sorry.
334 If anyone has a good algorithm for this..."
335 (interactive)
336 (mark-paragraph))
337
338 (defun urweb-indent-line ()
339 "Indent current line of Ur/Web code."
340 (interactive)
341 (let ((savep (> (current-column) (current-indentation)))
342 (indent (max (or (ignore-errors (urweb-calculate-indentation)) 0) 0)))
343 (if savep
344 (save-excursion (indent-line-to indent))
345 (indent-line-to indent))))
346
347 (defun urweb-back-to-outer-indent ()
348 "Unindents to the next outer level of indentation."
349 (interactive)
350 (save-excursion
351 (beginning-of-line)
352 (skip-chars-forward "\t ")
353 (let ((start-column (current-column))
354 (indent (current-column)))
355 (if (> start-column 0)
356 (progn
357 (save-excursion
358 (while (>= indent start-column)
359 (if (re-search-backward "^[^\n]" nil t)
360 (setq indent (current-indentation))
361 (setq indent 0))))
362 (backward-delete-char-untabify (- start-column indent)))))))
363
364 (defun urweb-find-comment-indent ()
365 (save-excursion
366 (let ((depth 1))
367 (while (> depth 0)
368 (if (re-search-backward "(\\*\\|\\*)" nil t)
369 (cond
370 ;; FIXME: That's just a stop-gap.
371 ((eq (get-text-property (point) 'face) 'font-lock-string-face))
372 ((looking-at "*)") (incf depth))
373 ((looking-at comment-start-skip) (decf depth)))
374 (setq depth -1)))
375 (if (= depth 0)
376 (1+ (current-column))
377 nil))))
378
379 (defun urweb-calculate-indentation ()
380 (save-excursion
381 (beginning-of-line) (skip-chars-forward "\t ")
382 (urweb-with-ist
383 ;; Indentation for comments alone on a line, matches the
384 ;; proper indentation of the next line.
385 (when (looking-at "(\\*") (urweb-forward-spaces))
386 (let (data
387 (sym (save-excursion (urweb-forward-sym))))
388 (or
389 ;; Allow the user to override the indentation.
390 (when (looking-at (concat ".*" (regexp-quote comment-start)
391 "[ \t]*fixindent[ \t]*"
392 (regexp-quote comment-end)))
393 (current-indentation))
394
395 ;; Continued comment.
396 (and (looking-at "\\*") (urweb-find-comment-indent))
397
398 ;; Continued string ? (Added 890113 lbn)
399 (and (looking-at "\\\\")
400 (save-excursion
401 (if (save-excursion (previous-line 1)
402 (beginning-of-line)
403 (looking-at "[\t ]*\\\\"))
404 (progn (previous-line 1) (current-indentation))
405 (if (re-search-backward "[^\\\\]\"" nil t)
406 (1+ (current-column))
407 0))))
408
409 ;; Closing parens. Could be handled below with `urweb-indent-relative'?
410 (and (looking-at "\\s)")
411 (save-excursion
412 (skip-syntax-forward ")")
413 (backward-sexp 1)
414 (if (urweb-dangling-sym)
415 (urweb-indent-default 'noindent)
416 (current-column))))
417
418 (and (setq data (assoc sym urweb-close-paren))
419 (urweb-indent-relative sym data))
420
421 (and (member sym urweb-starters-syms)
422 (urweb-indent-starter sym))
423
424 (and (string= sym "|") (urweb-indent-pipe))
425
426 (urweb-indent-arg)
427 (urweb-indent-default))))))
428
429 (defsubst urweb-bolp ()
430 (save-excursion (skip-chars-backward " \t|") (bolp)))
431
432 (defun urweb-indent-starter (orig-sym)
433 "Return the indentation to use for a symbol in `urweb-starters-syms'.
434 Point should be just before the symbol ORIG-SYM and is not preserved."
435 (let ((sym (unless (save-excursion (urweb-backward-arg))
436 (urweb-backward-spaces)
437 (urweb-backward-sym))))
438 (if (member sym '(";" "d=")) (setq sym nil))
439 (if sym (urweb-get-sym-indent sym)
440 ;; FIXME: this can take a *long* time !!
441 (setq sym (urweb-find-matching-starter urweb-starters-syms))
442 ;; Don't align with `and' because it might be specially indented.
443 (if (and (or (equal orig-sym "and") (not (equal sym "and")))
444 (urweb-bolp))
445 (+ (current-column)
446 (if (and urweb-rightalign-and (equal orig-sym "and"))
447 (- (length sym) 3) 0))
448 (urweb-indent-starter orig-sym)))))
449
450 (defun urweb-indent-relative (sym data)
451 (save-excursion
452 (urweb-forward-sym) (urweb-backward-sexp nil)
453 (unless (second data) (urweb-backward-spaces) (urweb-backward-sym))
454 (+ (or (cdr (assoc sym urweb-symbol-indent)) 0)
455 (urweb-delegated-indent))))
456
457 (defun urweb-indent-pipe ()
458 (let ((sym (urweb-find-matching-starter urweb-pipeheads
459 (urweb-op-prec "|" 'back))))
460 (when sym
461 (if (string= sym "|")
462 (if (urweb-bolp) (current-column) (urweb-indent-pipe))
463 (let ((pipe-indent (or (cdr (assoc "|" urweb-symbol-indent)) -2)))
464 (when (or (member sym '("datatype"))
465 (and (equal sym "and")
466 (save-excursion
467 (forward-word 1)
468 (not (urweb-funname-of-and)))))
469 (re-search-forward "="))
470 (urweb-forward-sym)
471 (urweb-forward-spaces)
472 (+ pipe-indent (current-column)))))))
473
474 (defun urweb-find-forward (re)
475 (urweb-forward-spaces)
476 (while (and (not (looking-at re))
477 (progn
478 (or (ignore-errors (forward-sexp 1) t) (forward-char 1))
479 (urweb-forward-spaces)
480 (not (looking-at re))))))
481
482 (defun urweb-indent-arg ()
483 (and (save-excursion (ignore-errors (urweb-forward-arg)))
484 ;;(not (looking-at urweb-not-arg-re))
485 ;; looks like a function or an argument
486 (urweb-move-if (urweb-backward-arg))
487 ;; an argument
488 (if (save-excursion (not (urweb-backward-arg)))
489 ;; a first argument
490 (+ (current-column) urweb-indent-args)
491 ;; not a first arg
492 (while (and (/= (current-column) (current-indentation))
493 (urweb-move-if (urweb-backward-arg))))
494 (unless (save-excursion (urweb-backward-arg))
495 ;; all earlier args are on the same line
496 (urweb-forward-arg) (urweb-forward-spaces))
497 (current-column))))
498
499 (defun urweb-get-indent (data sym)
500 (let (d)
501 (cond
502 ((not (listp data)) data)
503 ((setq d (member sym data)) (cadr d))
504 ((and (consp data) (not (stringp (car data)))) (car data))
505 (t urweb-indent-level))))
506
507 (defun urweb-dangling-sym ()
508 "Non-nil if the symbol after point is dangling.
509 The symbol can be an Ur/Web symbol or an open-paren. \"Dangling\" means that
510 it is not on its own line but is the last element on that line."
511 (save-excursion
512 (and (not (urweb-bolp))
513 (< (urweb-point-after (end-of-line))
514 (urweb-point-after (or (urweb-forward-sym) (skip-syntax-forward "("))
515 (urweb-forward-spaces))))))
516
517 (defun urweb-delegated-indent ()
518 (if (urweb-dangling-sym)
519 (urweb-indent-default 'noindent)
520 (urweb-move-if (backward-word 1)
521 (looking-at urweb-agglomerate-re))
522 (current-column)))
523
524 (defun urweb-get-sym-indent (sym &optional style)
525 "Find the indentation for the SYM we're `looking-at'.
526 If indentation is delegated, point will move to the start of the parent.
527 Optional argument STYLE is currently ignored."
528 (assert (equal sym (save-excursion (urweb-forward-sym))))
529 (save-excursion
530 (let ((delegate (and (not (equal sym "end")) (assoc sym urweb-close-paren)))
531 (head-sym sym))
532 (when (and delegate (not (eval (third delegate))))
533 ;;(urweb-find-match-backward sym delegate)
534 (urweb-forward-sym) (urweb-backward-sexp nil)
535 (setq head-sym
536 (if (second delegate)
537 (save-excursion (urweb-forward-sym))
538 (urweb-backward-spaces) (urweb-backward-sym))))
539
540 (let ((idata (assoc head-sym urweb-indent-rule)))
541 (when idata
542 ;;(if (or style (not delegate))
543 ;; normal indentation
544 (let ((indent (urweb-get-indent (cdr idata) sym)))
545 (when indent (+ (urweb-delegated-indent) indent)))
546 ;; delgate indentation to the parent
547 ;;(urweb-forward-sym) (urweb-backward-sexp nil)
548 ;;(let* ((parent-sym (save-excursion (urweb-forward-sym)))
549 ;; (parent-indent (cdr (assoc parent-sym urweb-indent-starters))))
550 ;; check the special rules
551 ;;(+ (urweb-delegated-indent)
552 ;; (or (urweb-get-indent (cdr indent-data) 1 'strict)
553 ;; (urweb-get-indent (cdr parent-indent) 1 'strict)
554 ;; (urweb-get-indent (cdr indent-data) 0)
555 ;; (urweb-get-indent (cdr parent-indent) 0))))))))
556 )))))
557
558 (defun urweb-indent-default (&optional noindent)
559 (let* ((sym-after (save-excursion (urweb-forward-sym)))
560 (_ (urweb-backward-spaces))
561 (sym-before (urweb-backward-sym))
562 (sym-indent (and sym-before (urweb-get-sym-indent sym-before)))
563 (indent-after (or (cdr (assoc sym-after urweb-symbol-indent)) 0)))
564 (when (equal sym-before "end")
565 ;; I don't understand what's really happening here, but when
566 ;; it's `end' clearly, we need to do something special.
567 (forward-word 1)
568 (setq sym-before nil sym-indent nil))
569 (cond
570 (sym-indent
571 ;; the previous sym is an indentation introducer: follow the rule
572 (if noindent
573 ;;(current-column)
574 sym-indent
575 (+ sym-indent indent-after)))
576 ;; If we're just after a hanging open paren.
577 ((and (eq (char-syntax (preceding-char)) ?\()
578 (save-excursion (backward-char) (urweb-dangling-sym)))
579 (backward-char)
580 (urweb-indent-default))
581 (t
582 ;; default-default
583 (let* ((prec-after (urweb-op-prec sym-after 'back))
584 (prec (or (urweb-op-prec sym-before 'back) prec-after 100)))
585 ;; go back until you hit a symbol that has a lower prec than the
586 ;; "current one", or until you backed over a sym that has the same prec
587 ;; but is at the beginning of a line.
588 (while (and (not (urweb-bolp))
589 (while (urweb-move-if (urweb-backward-sexp (1- prec))))
590 (not (urweb-bolp)))
591 (while (urweb-move-if (urweb-backward-sexp prec))))
592 (if noindent
593 ;; the `noindent' case does back over an introductory symbol
594 ;; such as `fun', ...
595 (progn
596 (urweb-move-if
597 (urweb-backward-spaces)
598 (member (urweb-backward-sym) urweb-starters-syms))
599 (current-column))
600 ;; Use `indent-after' for cases such as when , or ; should be
601 ;; outdented so that their following terms are aligned.
602 (+ (if (progn
603 (if (equal sym-after ";")
604 (urweb-move-if
605 (urweb-backward-spaces)
606 (member (urweb-backward-sym) urweb-starters-syms)))
607 (and sym-after (not (looking-at sym-after))))
608 indent-after 0)
609 (current-column))))))))
610
611
612 ;; maybe `|' should be set to word-syntax in our temp syntax table ?
613 (defun urweb-current-indentation ()
614 (save-excursion
615 (beginning-of-line)
616 (skip-chars-forward " \t|")
617 (current-column)))
618
619
620 (defun urweb-find-matching-starter (syms &optional prec)
621 (let (sym)
622 (ignore-errors
623 (while
624 (progn (urweb-backward-sexp prec)
625 (setq sym (save-excursion (urweb-forward-sym)))
626 (not (or (member sym syms) (bobp)))))
627 (if (member sym syms) sym))))
628
629 (defun urweb-skip-siblings ()
630 (while (and (not (bobp)) (urweb-backward-arg))
631 (urweb-find-matching-starter urweb-starters-syms)))
632
633 (defun urweb-beginning-of-defun ()
634 (let ((sym (urweb-find-matching-starter urweb-starters-syms)))
635 (if (member sym '("fun" "and" "functor" "signature" "structure"
636 "datatype"))
637 (save-excursion (urweb-forward-sym) (urweb-forward-spaces)
638 (urweb-forward-sym))
639 ;; We're inside a "non function declaration": let's skip all other
640 ;; declarations that we find at the same level and try again.
641 (urweb-skip-siblings)
642 ;; Obviously, let's not try again if we're at bobp.
643 (unless (bobp) (urweb-beginning-of-defun)))))
644
645 (defcustom urweb-max-name-components 3
646 "Maximum number of components to use for the current function name."
647 :group 'urweb
648 :type 'integer)
649
650 (defun urweb-current-fun-name ()
651 (save-excursion
652 (let ((count urweb-max-name-components)
653 fullname name)
654 (end-of-line)
655 (while (and (> count 0)
656 (setq name (urweb-beginning-of-defun)))
657 (decf count)
658 (setq fullname (if fullname (concat name "." fullname) name))
659 ;; Skip all other declarations that we find at the same level.
660 (urweb-skip-siblings))
661 fullname)))
662
663 (provide 'urweb-mode)
664
665 ;;; urweb-mode.el ends here