]> code.delx.au - gnu-emacs-elpa/blob - sml-mode.el
Make the toplevel closer to usual practice.
[gnu-emacs-elpa] / sml-mode.el
1 ;;; sml-mode.el --- Major mode for editing (Standard) ML
2
3 ;; Copyright (C) 1989 Lars Bo Nielsen
4 ;; Copyright (C) 1994-1997 Matthew J. Morley
5 ;; Copyright (C) 1999-2000 Stefan Monnier
6
7 ;; Author: Lars Bo Nielsen
8 ;; Olin Shivers
9 ;; Fritz Knabe (?)
10 ;; Steven Gilmore (?)
11 ;; Matthew Morley <mjm@scs.leeds.ac.uk> (aka <matthew@verisity.com>)
12 ;; Matthias Blume <blume@cs.princeton.edu> (aka <blume@kurims.kyoto-u.ac.jp>)
13 ;; (Stefan Monnier) monnier@cs.yale.edu
14 ;; Maintainer: (Stefan Monnier) monnier+lists/emacs/sml@flint.cs.yale.edu
15 ;; Keywords: SML
16 ;; $Revision$
17 ;; $Date$
18
19 ;; This file is not part of GNU Emacs, but it is distributed under the
20 ;; same conditions.
21
22 ;; This program is free software; you can redistribute it and/or
23 ;; modify it under the terms of the GNU General Public License as
24 ;; published by the Free Software Foundation; either version 2, or (at
25 ;; your option) any later version.
26
27 ;; This program is distributed in the hope that it will be useful, but
28 ;; WITHOUT ANY WARRANTY; without even the implied warranty of
29 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
30 ;; General Public License for more details.
31
32 ;; You should have received a copy of the GNU General Public License
33 ;; along with GNU Emacs; see the file COPYING. If not, write to the
34 ;; Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
35
36 ;;; Commentary:
37
38 ;;; HISTORY
39
40 ;; Still under construction: History obscure, needs a biographer as
41 ;; well as a M-x doctor. Change Log on request.
42
43 ;; Hacked by Olin Shivers for comint from Lars Bo Nielsen's sml.el.
44
45 ;; Hacked by Matthew Morley to incorporate Fritz Knabe's hilite and
46 ;; font-lock patterns, some of Steven Gilmore's (reduced) easy-menus,
47 ;; and numerous bugs and bug-fixes.
48
49 ;;; DESCRIPTION
50
51 ;; See accompanying info file: sml-mode.info
52
53 ;;; FOR YOUR .EMACS FILE
54
55 ;; If sml-mode.el lives in some non-standard directory, you must tell
56 ;; emacs where to get it. This may or may not be necessary:
57
58 ;; (add-to-list 'load-path "~jones/lib/emacs/")
59
60 ;; Then to access the commands autoload sml-mode with that command:
61
62 ;; (load "sml-mode-startup")
63
64 ;; sml-mode-hook is run whenever a new sml-mode buffer is created.
65
66 ;; Finally, there are inferior-sml-{mode,load}-hooks -- see comments
67 ;; in sml-proc.el. For much more information consult the mode's *info*
68 ;; tree.
69
70 ;;; Code:
71
72 (eval-when-compile (require 'cl))
73 (require 'sml-util)
74 (require 'sml-move)
75 (require 'sml-defs)
76
77 ;;; VARIABLES CONTROLLING INDENTATION
78
79 (defcustom sml-indent-level 4
80 "*Indentation of blocks in ML (see also `sml-structure-indent')."
81 :group 'sml
82 :type '(integer))
83
84 (defcustom sml-indent-args sml-indent-level
85 "*Indentation of args placed on a separate line."
86 :group 'sml
87 :type '(integer))
88
89 ;; (defvar sml-indent-align-args t
90 ;; "*Whether the arguments should be aligned.")
91
92 ;; (defvar sml-case-indent nil
93 ;; "*How to indent case-of expressions.
94 ;; If t: case expr If nil: case expr of
95 ;; of exp1 => ... exp1 => ...
96 ;; | exp2 => ... | exp2 => ...
97
98 ;; The first seems to be the standard in SML/NJ, but the second
99 ;; seems nicer...")
100
101 (defcustom sml-electric-semi-mode nil
102 "*If non-nil, `\;' will self insert, reindent the line, and do a newline.
103 If nil, just insert a `\;'. (To insert while t, do: \\[quoted-insert] \;)."
104 :group 'sml
105 :type '(boolean))
106
107 ;;; OTHER GENERIC MODE VARIABLES
108
109 (defvar sml-mode-info "sml-mode"
110 "*Where to find Info file for `sml-mode'.
111 The default assumes the info file \"sml-mode.info\" is on Emacs' info
112 directory path. If it is not, either put the file on the standard path
113 or set the variable `sml-mode-info' to the exact location of this file
114
115 (setq sml-mode-info \"/usr/me/lib/info/sml-mode\")
116
117 in your .emacs file. You can always set it interactively with the
118 set-variable command.")
119
120 (defvar sml-mode-hook nil
121 "*Run upon entering `sml-mode'.
122 This is a good place to put your preferred key bindings.")
123
124 ;;; CODE FOR SML-MODE
125
126 (defun sml-mode-info ()
127 "Command to access the TeXinfo documentation for `sml-mode'.
128 See doc for the variable `sml-mode-info'."
129 (interactive)
130 (require 'info)
131 (condition-case nil
132 (info sml-mode-info)
133 (error (progn
134 (describe-variable 'sml-mode-info)
135 (message "Can't find it... set this variable first!")))))
136
137
138 ;;; Autoload functions -- no-doc is another idea cribbed from AucTeX!
139
140 (let ((sml-no-doc
141 "This function is part of sml-proc, and has not yet been loaded.
142 Full documentation will be available after autoloading the function."))
143
144 (autoload 'sml-compile "sml-proc" sml-no-doc t)
145 (autoload 'sml-load-file "sml-proc" sml-no-doc t)
146 (autoload 'switch-to-sml "sml-proc" sml-no-doc t)
147 (autoload 'sml-send-region "sml-proc" sml-no-doc t)
148 (autoload 'sml-send-buffer "sml-proc" sml-no-doc t))
149
150 ;; font-lock setup
151
152 (defconst sml-keywords-regexp
153 (sml-syms-re "abstraction" "abstype" "and" "andalso" "as" "before" "case"
154 "datatype" "else" "end" "eqtype" "exception" "do" "fn"
155 "fun" "functor" "handle" "if" "in" "include" "infix"
156 "infixr" "let" "local" "nonfix" "of" "op" "open" "orelse"
157 "overload" "raise" "rec" "sharing" "sig" "signature"
158 "struct" "structure" "then" "type" "val" "where" "while"
159 "with" "withtype" "o")
160 "A regexp that matches any and all keywords of SML.")
161
162 (defconst sml-font-lock-keywords
163 `(;;(sml-font-comments-and-strings)
164 ("\\<\\(fun\\|and\\)\\s-+\\('\\sw+\\s-+\\)*\\(\\sw+\\)"
165 (1 font-lock-keyword-face)
166 (3 font-lock-function-name-face))
167 ("\\<\\(\\(data\\|abs\\|with\\|eq\\)?type\\)\\s-+\\('\\sw+\\s-+\\)*\\(\\sw+\\)"
168 (1 font-lock-keyword-face)
169 (4 font-lock-type-def-face))
170 ("\\<\\(val\\)\\s-+\\(\\sw+\\>\\s-*\\)?\\(\\sw+\\)\\s-*[=:]"
171 (1 font-lock-keyword-face)
172 ;;(6 font-lock-variable-def-face nil t)
173 (3 font-lock-variable-name-face))
174 ("\\<\\(structure\\|functor\\|abstraction\\)\\s-+\\(\\sw+\\)"
175 (1 font-lock-keyword-face)
176 (2 font-lock-module-def-face))
177 ("\\<\\(signature\\)\\s-+\\(\\sw+\\)"
178 (1 font-lock-keyword-face)
179 (2 font-lock-interface-def-face))
180
181 (,sml-keywords-regexp . font-lock-keyword-face))
182 "Regexps matching standard SML keywords.")
183
184 (defface font-lock-type-def-face
185 '((t (:bold t)))
186 "Font Lock mode face used to highlight type definitions."
187 :group 'font-lock-highlighting-faces)
188 (defvar font-lock-type-def-face 'font-lock-type-def-face
189 "Face name to use for type definitions.")
190
191 (defface font-lock-module-def-face
192 '((t (:bold t)))
193 "Font Lock mode face used to highlight module definitions."
194 :group 'font-lock-highlighting-faces)
195 (defvar font-lock-module-def-face 'font-lock-module-def-face
196 "Face name to use for module definitions.")
197
198 (defface font-lock-interface-def-face
199 '((t (:bold t)))
200 "Font Lock mode face used to highlight interface definitions."
201 :group 'font-lock-highlighting-faces)
202 (defvar font-lock-interface-def-face 'font-lock-interface-def-face
203 "Face name to use for interface definitions.")
204
205 ;;;
206 ;;; Code to handle nested comments and unusual string escape sequences
207 ;;;
208
209 (defsyntax sml-syntax-prop-table
210 '((?\\ . ".") (?* . "."))
211 "Syntax table for text-properties")
212
213 ;; For Emacsen that have no built-in support for nested comments
214 (defun sml-get-depth-st ()
215 (save-excursion
216 (let* ((disp (if (eq (char-before) ?\)) (progn (backward-char) -1) nil))
217 (foo (backward-char))
218 (disp (if (eq (char-before) ?\() (progn (backward-char) 0) disp))
219 (pt (point)))
220 (when disp
221 (let* ((depth
222 (save-match-data
223 (if (re-search-backward "\\*)\\|(\\*" nil t)
224 (+ (or (get-char-property (point) 'comment-depth) 0)
225 (case (char-after) (?\( 1) (?* 0))
226 disp)
227 0)))
228 (depth (if (> depth 0) depth)))
229 (put-text-property pt (1+ pt) 'comment-depth depth)
230 (when depth sml-syntax-prop-table))))))
231
232 (defconst sml-font-lock-syntactic-keywords
233 `(("^\\s-*\\(\\\\\\)" (1 ',sml-syntax-prop-table))
234 ,@(unless sml-builtin-nested-comments-flag
235 '(("(?\\(\\*\\))?" (1 (sml-get-depth-st)))))))
236
237 (defconst sml-font-lock-defaults
238 '(sml-font-lock-keywords nil nil ((?_ . "w") (?' . "w")) nil
239 (font-lock-syntactic-keywords . sml-font-lock-syntactic-keywords)))
240
241 ;;;;
242 ;;;; Imenu support
243 ;;;;
244
245 (defvar sml-imenu-regexp
246 (concat "^[ \t]*\\(let[ \t]+\\)?"
247 (regexp-opt (append sml-module-head-syms
248 '("and" "fun" "datatype" "abstype" "type")) t)
249 "\\>"))
250
251 (defun sml-imenu-create-index ()
252 (let (alist)
253 (goto-char (point-max))
254 (while (re-search-backward sml-imenu-regexp nil t)
255 (save-excursion
256 (let ((kind (match-string 2))
257 (column (progn (goto-char (match-beginning 2)) (current-column)))
258 (location
259 (progn (goto-char (match-end 0)) (sml-forward-spaces) (point)))
260 (name (sml-forward-sym)))
261 ;; Eliminate trivial renamings.
262 (when (or (not (member kind '("structure" "signature")))
263 (progn (search-forward "=")
264 (sml-forward-spaces)
265 (looking-at "sig\\|struct")))
266 (push (cons (concat (make-string (/ column 2) ?\ ) name) location)
267 alist)))))
268 alist))
269
270 ;;; MORE CODE FOR SML-MODE
271
272 ;;;###Autoload
273 (add-to-list 'auto-mode-alist '("\\.s\\(ml\\|ig\\)\\'" . sml-mode))
274
275 ;;;###Autoload
276 (define-derived-mode sml-mode fundamental-mode "SML"
277 "\\<sml-mode-map>Major mode for editing ML code.
278 This mode runs `sml-mode-hook' just before exiting.
279 \\{sml-mode-map}"
280 (set (make-local-variable 'font-lock-defaults) sml-font-lock-defaults)
281 (set (make-local-variable 'outline-regexp) sml-outline-regexp)
282 (set (make-local-variable 'imenu-create-index-function)
283 'sml-imenu-create-index)
284 (set (make-local-variable 'add-log-current-defun-function)
285 'sml-current-fun-name)
286 ;; forward-sexp-function is an experimental variable in my hacked Emacs.
287 (set (make-local-variable 'forward-sexp-function) 'sml-user-forward-sexp)
288 (sml-mode-variables))
289
290 (defun sml-mode-variables ()
291 (set-syntax-table sml-mode-syntax-table)
292 (setq local-abbrev-table sml-mode-abbrev-table)
293 ;; A paragraph is separated by blank lines or ^L only.
294
295 (set (make-local-variable 'paragraph-start)
296 (concat "^[\t ]*$\\|" page-delimiter))
297 (set (make-local-variable 'paragraph-separate) paragraph-start)
298 (set (make-local-variable 'indent-line-function) 'sml-indent-line)
299 (set (make-local-variable 'comment-start) "(* ")
300 (set (make-local-variable 'comment-end) " *)")
301 (set (make-local-variable 'comment-nested) t)
302 ;;(set (make-local-variable 'block-comment-start) "* ")
303 ;;(set (make-local-variable 'block-comment-end) "")
304 (set (make-local-variable 'comment-column) 40)
305 (set (make-local-variable 'comment-start-skip) "(\\*+\\s-*")
306 (set (make-local-variable 'comment-indent-function) 'sml-comment-indent))
307
308 (defun sml-electric-pipe ()
309 "Insert a \"|\".
310 Depending on the context insert the name of function, a \"=>\" etc."
311 (interactive)
312 (sml-with-ist
313 (unless (save-excursion (skip-chars-backward "\t ") (bolp)) (insert "\n"))
314 (insert "| ")
315 (let ((text
316 (save-excursion
317 (backward-char 2) ;back over the just inserted "| "
318 (let ((sym (sml-find-matching-starter sml-pipeheads
319 (sml-op-prec "|" 'back))))
320 (sml-forward-sym)
321 (sml-forward-spaces)
322 (cond
323 ((string= sym "|")
324 (let ((f (sml-forward-sym)))
325 (sml-find-forward "\\(=>\\|=\\||\\)\\S.")
326 (cond
327 ((looking-at "|") "") ;probably a datatype
328 ((looking-at "=>") " => ") ;`case', or `fn' or `handle'
329 ((looking-at "=") (concat f " = "))))) ;a function
330 ((string= sym "and")
331 ;; could be a datatype or a function
332 (while (and (setq sym (sml-forward-sym))
333 (string-match "^'" sym))
334 (sml-forward-spaces))
335 (sml-forward-spaces)
336 (if (or (not sym)
337 (equal (sml-forward-sym) "d="))
338 ""
339 (concat sym " = ")))
340 ;; trivial cases
341 ((string= sym "fun")
342 (while (and (setq sym (sml-forward-sym))
343 (string-match "^'" sym))
344 (sml-forward-spaces))
345 (concat sym " = "))
346 ((member sym '("case" "handle" "fn" "of")) " => ")
347 ;;((member sym '("abstype" "datatype")) "")
348 (t ""))))))
349
350 (insert text)
351 (indent-according-to-mode)
352 (beginning-of-line)
353 (skip-chars-forward "\t |")
354 (skip-syntax-forward "w")
355 (skip-chars-forward "\t ")
356 (when (= ?= (char-after)) (backward-char)))))
357
358 (defun sml-electric-semi ()
359 "Insert a \;.
360 If variable `sml-electric-semi-mode' is t, indent the current line, insert
361 a newline, and indent."
362 (interactive)
363 (insert "\;")
364 (if sml-electric-semi-mode
365 (reindent-then-newline-and-indent)))
366
367 ;;; INDENTATION !!!
368
369 (defun sml-mark-function ()
370 "Synonym for `mark-paragraph' -- sorry.
371 If anyone has a good algorithm for this..."
372 (interactive)
373 (mark-paragraph))
374
375 ;; (defun sml-indent-region (begin end)
376 ;; "Indent region of ML code."
377 ;; (interactive "r")
378 ;; (message "Indenting region...")
379 ;; (save-excursion
380 ;; (goto-char end) (setq end (point-marker)) (goto-char begin)
381 ;; (while (< (point) end)
382 ;; (skip-chars-forward "\t\n ")
383 ;; (indent-according-to-mode)
384 ;; (end-of-line))
385 ;; (move-marker end nil))
386 ;; (message "Indenting region... done"))
387
388 (defun sml-indent-line ()
389 "Indent current line of ML code."
390 (interactive)
391 (let ((savep (> (current-column) (current-indentation)))
392 (indent (max (or (ignore-errors (sml-calculate-indentation)) 0) 0)))
393 (if savep
394 (save-excursion (indent-line-to indent))
395 (indent-line-to indent))))
396
397 (defun sml-back-to-outer-indent ()
398 "Unindents to the next outer level of indentation."
399 (interactive)
400 (save-excursion
401 (beginning-of-line)
402 (skip-chars-forward "\t ")
403 (let ((start-column (current-column))
404 (indent (current-column)))
405 (if (> start-column 0)
406 (progn
407 (save-excursion
408 (while (>= indent start-column)
409 (if (re-search-backward "^[^\n]" nil t)
410 (setq indent (current-indentation))
411 (setq indent 0))))
412 (backward-delete-char-untabify (- start-column indent)))))))
413
414 (defun sml-find-comment-indent ()
415 (save-excursion
416 (let ((depth 1))
417 (while (> depth 0)
418 (if (re-search-backward "(\\*\\|\\*)" nil t)
419 (cond
420 ((looking-at "*)") (incf depth))
421 ((looking-at comment-start-skip) (decf depth)))
422 (setq depth -1)))
423 (if (= depth 0)
424 (1+ (current-column))
425 nil))))
426
427 (defun sml-calculate-indentation ()
428 (save-excursion
429 (beginning-of-line) (skip-chars-forward "\t ")
430 (sml-with-ist
431 ;; Indentation for comments alone on a line, matches the
432 ;; proper indentation of the next line.
433 (when (looking-at "(\\*") (sml-forward-spaces))
434 (let (data
435 (sml-point (point))
436 (sym (save-excursion (sml-forward-sym))))
437 (or
438 ;; allow the user to override the indentation
439 (when (looking-at (concat ".*" (regexp-quote comment-start)
440 "[ \t]*fixindent[ \t]*"
441 (regexp-quote comment-end)))
442 (current-indentation))
443
444 ;; continued comment
445 (and (looking-at "\\*") (sml-find-comment-indent))
446
447 ;; Continued string ? (Added 890113 lbn)
448 (and (looking-at "\\\\")
449 (save-excursion
450 (if (save-excursion (previous-line 1)
451 (beginning-of-line)
452 (looking-at "[\t ]*\\\\"))
453 (progn (previous-line 1) (current-indentation))
454 (if (re-search-backward "[^\\\\]\"" nil t)
455 (1+ (current-column))
456 0))))
457
458 (and (setq data (assoc sym sml-close-paren))
459 (sml-indent-relative sym data))
460
461 (and (member (save-excursion (sml-forward-sym)) sml-starters-syms)
462 (let ((sym (unless (save-excursion (sml-backward-arg))
463 (sml-backward-spaces)
464 (sml-backward-sym))))
465 (if sym (sml-get-sym-indent sym)
466 ;; FIXME: this can take a *long* time !!
467 (sml-find-matching-starter sml-starters-syms)
468 (current-column))))
469
470 (and (string= sym "|") (sml-indent-pipe))
471
472 (sml-indent-arg)
473 (sml-indent-default))))))
474
475 (defun sml-indent-relative (sym data)
476 (save-excursion
477 (sml-forward-sym) (sml-backward-sexp nil)
478 (unless (second data) (sml-backward-spaces) (sml-backward-sym))
479 (+ (or (cdr (assoc sym sml-symbol-indent)) 0)
480 (sml-delegated-indent))))
481
482 (defun sml-indent-pipe ()
483 (let ((sym (sml-find-matching-starter sml-pipeheads
484 (sml-op-prec "|" 'back))))
485 (when sym
486 (if (string= sym "|")
487 (if (sml-bolp) (current-column) (sml-indent-pipe))
488 (let ((pipe-indent (or (cdr (assoc "|" sml-symbol-indent)) -2)))
489 (when (member sym '("datatype" "abstype"))
490 (re-search-forward "="))
491 (sml-forward-sym)
492 (sml-forward-spaces)
493 (+ pipe-indent (current-column)))))))
494
495 (defun sml-find-forward (re)
496 (sml-forward-spaces)
497 (while (and (not (looking-at re))
498 (progn
499 (or (ignore-errors (forward-sexp 1) t) (forward-char 1))
500 (sml-forward-spaces)
501 (not (looking-at re))))))
502
503 (defun sml-indent-arg ()
504 (and (save-excursion (ignore-errors (sml-forward-arg)))
505 ;;(not (looking-at sml-not-arg-re))
506 ;; looks like a function or an argument
507 (sml-move-if (sml-backward-arg))
508 ;; an argument
509 (if (save-excursion (not (sml-backward-arg)))
510 ;; a first argument
511 (+ (current-column) sml-indent-args)
512 ;; not a first arg
513 (while (and (/= (current-column) (current-indentation))
514 (sml-move-if (sml-backward-arg))))
515 (unless (save-excursion (sml-backward-arg))
516 ;; all earlier args are on the same line
517 (sml-forward-arg) (sml-forward-spaces))
518 (current-column))))
519
520 (defun sml-get-indent (data sym)
521 (let ((head-sym (pop data)) d)
522 (cond
523 ((not (listp data)) data)
524 ((setq d (member sym data)) (second d))
525 ((and (consp data) (not (stringp (car data)))) (car data))
526 (t sml-indent-level))))
527
528 (defun sml-dangling-sym ()
529 (save-excursion
530 (and (not (sml-bolp))
531 (< (sml-point-after (end-of-line))
532 (sml-point-after (sml-forward-sym)
533 (sml-forward-spaces))))))
534
535 (defun sml-delegated-indent ()
536 (if (sml-dangling-sym)
537 (sml-indent-default 'noindent)
538 (sml-move-if (backward-word 1)
539 (looking-at sml-agglomerate-re))
540 (current-column)))
541
542 (defun sml-get-sym-indent (sym &optional style)
543 "Find the indentation for the SYM we're `looking-at'.
544 If indentation is delegated, the point will be at the start of
545 the parent at the end of this function.
546 Optional argument STYLE is currently ignored"
547 (assert (equal sym (save-excursion (sml-forward-sym))))
548 (save-excursion
549 (let ((delegate (assoc sym sml-close-paren))
550 (head-sym sym))
551 (when (and delegate (not (eval (third delegate))))
552 ;;(sml-find-match-backward sym delegate)
553 (sml-forward-sym) (sml-backward-sexp nil)
554 (setq head-sym
555 (if (second delegate)
556 (save-excursion (sml-forward-sym))
557 (sml-backward-spaces) (sml-backward-sym))))
558
559 (let ((idata (assoc head-sym sml-indent-rule)))
560 (when idata
561 ;;(if (or style (not delegate))
562 ;; normal indentation
563 (let ((indent (sml-get-indent idata sym)))
564 (when indent (+ (sml-delegated-indent) indent)))
565 ;; delgate indentation to the parent
566 ;;(sml-forward-sym) (sml-backward-sexp nil)
567 ;;(let* ((parent-sym (save-excursion (sml-forward-sym)))
568 ;; (parent-indent (cdr (assoc parent-sym sml-indent-starters))))
569 ;; check the special rules
570 ;;(+ (sml-delegated-indent)
571 ;; (or (sml-get-indent indent-data 1 'strict)
572 ;; (sml-get-indent parent-indent 1 'strict)
573 ;; (sml-get-indent indent-data 0)
574 ;; (sml-get-indent parent-indent 0))))))))
575 )))))
576
577 (defun sml-indent-default (&optional noindent)
578 (let* ((sym-after (save-excursion (sml-forward-sym)))
579 (_ (sml-backward-spaces))
580 (sym-before (sml-backward-sym))
581 (sym-indent (and sym-before (sml-get-sym-indent sym-before))))
582 (if sym-indent
583 ;; the previous sym is an indentation introducer: follow the rule
584 (let ((indent-after (or (cdr (assoc sym-after sml-symbol-indent)) 0)))
585 (if noindent
586 ;;(current-column)
587 sym-indent
588 (+ sym-indent indent-after)))
589 ;; default-default
590 (let* ((prec-after (sml-op-prec sym-after 'back))
591 (prec (or (sml-op-prec sym-before 'back) prec-after 100)))
592 ;; go back until you hit a symbol that has a lower prec than the
593 ;; "current one", or until you backed over a sym that has the same prec
594 ;; but is at the beginning of a line.
595 (while (and (not (sml-bolp))
596 (sml-move-if (sml-backward-sexp (1- prec)))
597 (not (sml-bolp)))
598 (while (sml-move-if (sml-backward-sexp prec))))
599 ;; the `noindent' case does back over an introductory symbol
600 ;; such as `fun', ...
601 (when noindent
602 (sml-move-if
603 (sml-backward-spaces)
604 (member (sml-backward-sym) sml-starters-syms)))
605 (current-column)))))
606
607
608 (defun sml-bolp ()
609 (save-excursion
610 (skip-chars-backward " \t|") (bolp)))
611
612
613 ;; maybe `|' should be set to word-syntax in our temp syntax table ?
614 (defun sml-current-indentation ()
615 (save-excursion
616 (beginning-of-line)
617 (skip-chars-forward " \t|")
618 (current-column)))
619
620
621 (defun sml-find-matching-starter (syms &optional prec)
622 (let (sym)
623 (ignore-errors
624 (while
625 (progn (sml-backward-sexp prec)
626 (setq sym (save-excursion (sml-forward-sym)))
627 (not (or (member sym syms) (bobp)))))
628 (unless (bobp) sym))))
629
630 (defun sml-skip-siblings ()
631 (while (and (not (bobp)) (sml-backward-arg))
632 (sml-find-matching-starter sml-starters-syms))
633 (when (looking-at "in\\>\\|local\\>")
634 ;;skip over `local...in' and continue
635 (forward-word 1)
636 (sml-backward-sexp nil)
637 (sml-skip-siblings)))
638
639 (defun sml-beginning-of-defun ()
640 (let ((sym (sml-find-matching-starter sml-starters-syms)))
641 (if (member sym '("fun" "and" "functor" "signature" "structure"
642 "abstraction" "datatype" "abstype"))
643 (save-excursion (sml-forward-sym) (sml-forward-spaces)
644 (sml-forward-sym))
645 ;; We're inside a "non function declaration": let's skip all other
646 ;; declarations that we find at the same level and try again.
647 (sml-skip-siblings)
648 ;; Obviously, let's not try again if we're at bobp.
649 (unless (bobp) (sml-beginning-of-defun)))))
650
651 (defcustom sml-max-name-components 3
652 "Maximum number of components to use for the current function name."
653 :group 'sml
654 :type 'integer)
655
656 (defun sml-current-fun-name ()
657 (save-excursion
658 (let ((count sml-max-name-components)
659 fullname name)
660 (end-of-line)
661 (while (and (> count 0)
662 (setq name (sml-beginning-of-defun)))
663 (decf count)
664 (setq fullname (if fullname (concat name "." fullname) name))
665 ;; Skip all other declarations that we find at the same level.
666 (sml-skip-siblings))
667 fullname)))
668
669
670 (defun sml-comment-indent ()
671 (if (looking-at "^(\\*") ; Existing comment at beginning
672 0 ; of line stays there.
673 comment-column))
674
675 ;;; INSERTING PROFORMAS (COMMON SML-FORMS)
676
677 (defvar sml-forms-alist nil
678 "*Alist of code templates.
679 You can extend this alist to your heart's content. For each additional
680 template NAME in the list, declare a keyboard macro or function (or
681 interactive command) called 'sml-form-NAME'.
682 If 'sml-form-NAME' is a function it takes no arguments and should
683 insert the template at point\; if this is a command it may accept any
684 sensible interactive call arguments\; keyboard macros can't take
685 arguments at all. Apropos keyboard macros, see `name-last-kbd-macro'
686 and `sml-addto-forms-alist'.
687 `sml-forms-alist' understands let, local, case, abstype, datatype,
688 signature, structure, and functor by default.")
689
690 (defmacro sml-def-skeleton (name interactor &rest elements)
691 (let ((fsym (intern (concat "sml-form-" name))))
692 `(progn
693 (add-to-list 'sml-forms-alist ',(cons name fsym))
694 (define-abbrev sml-mode-abbrev-table ,name "" ',fsym)
695 (define-skeleton ,fsym
696 ,(format "SML-mode skeleton for `%s..' expressions" name)
697 ,interactor
698 ,(concat name " ") >
699 ,@elements))))
700 (put 'sml-def-skeleton 'lisp-indent-function 2)
701
702 (sml-def-skeleton "let" nil
703 _ "\nin" > "\nend" >)
704
705 (sml-def-skeleton "if" nil
706 _ " then " > "\nelse " >)
707
708 (sml-def-skeleton "local" nil
709 _ "\nin" > "\nend" >)
710
711 (sml-def-skeleton "case" "Case expr: "
712 str "\nof " > _ " => ")
713
714 (sml-def-skeleton "signature" "Signature name: "
715 str " =\nsig" > "\n" > _ "\nend" >)
716
717 (sml-def-skeleton "structure" "Structure name: "
718 str " =\nstruct" > "\n" > _ "\nend" >)
719
720 (sml-def-skeleton "functor" "Functor name: "
721 str " () : =\nstruct" > "\n" > _ "\nend" >)
722
723 (sml-def-skeleton "datatype" "Datatype name and type params: "
724 str " =" \n)
725
726 (sml-def-skeleton "abstype" "Abstype name and type params: "
727 str " =" \n _ "\nwith" > "\nend" >)
728
729 ;;
730
731 (sml-def-skeleton "struct" nil
732 _ "\nend" >)
733
734 (sml-def-skeleton "sig" nil
735 _ "\nend" >)
736
737 (sml-def-skeleton "val" nil
738 _ " = " >)
739
740 (sml-def-skeleton "fn" nil
741 _ " =>" >)
742
743 (sml-def-skeleton "fun" nil
744 _ " =" >)
745
746 ;;
747
748 (defun sml-forms-menu (menu)
749 (easy-menu-filter-return
750 (easy-menu-create-menu "Forms"
751 (mapcar (lambda (x)
752 (let ((name (car x))
753 (fsym (cdr x)))
754 (vector name fsym t)))
755 sml-forms-alist))))
756
757 (defvar sml-last-form "let")
758
759 (defun sml-electric-space ()
760 "Expand a symbol into an SML form, or just insert a space.
761 If the point directly precedes a symbol for which an SML form exists,
762 the corresponding form is inserted."
763 (interactive)
764 (let ((abbrev-mode (not abbrev-mode))
765 (last-command-char ?\ )
766 ;; Bind `this-command' to fool skeleton's special abbrev handling.
767 (this-command 'self-insert-command))
768 (call-interactively 'self-insert-command)))
769
770 (defun sml-insert-form (name newline)
771 "Interactive short-cut to insert the NAME common ML form.
772 If a prefix argument is given insert a NEWLINE and indent first, or
773 just move to the proper indentation if the line is blank\; otherwise
774 insert at point (which forces indentation to current column).
775
776 The default form to insert is 'whatever you inserted last time'
777 \(just hit return when prompted\)\; otherwise the command reads with
778 completion from `sml-forms-alist'."
779 (interactive
780 (list (completing-read
781 (format "Form to insert: (default %s) " sml-last-form)
782 sml-forms-alist nil t nil)
783 current-prefix-arg))
784 ;; default is whatever the last insert was...
785 (if (string= name "") (setq name sml-last-form) (setq sml-last-form name))
786 (unless (or (not newline)
787 (save-excursion (beginning-of-line) (looking-at "\\s-*$")))
788 (insert "\n"))
789 (unless (/= ?w (char-syntax (char-before))) (insert " "))
790 (let ((f (cdr (assoc name sml-forms-alist))))
791 (cond
792 ((commandp f) (command-execute f))
793 (f (funcall f))
794 (t (error "Undefined form: %s" name)))))
795
796 ;; See also macros.el in emacs lisp dir.
797
798 (defun sml-addto-forms-alist (name)
799 "Assign a name to the last keyboard macro defined.
800 Argument NAME is transmogrified to sml-form-NAME which is the symbol
801 actually defined.
802
803 The symbol's function definition becomes the keyboard macro string.
804
805 If that works, NAME is added to `sml-forms-alist' so you'll be able to
806 reinvoke the macro through \\[sml-insert-form]. You might want to save
807 the macro to use in a later editing session -- see `insert-kbd-macro'
808 and add these macros to your .emacs file.
809
810 See also `edit-kbd-macro' which is bound to \\[edit-kbd-macro]."
811 (interactive "sName for last kbd macro (\"sml-form-\" will be added): ")
812 (when (string= name "") (error "No command name given"))
813 (let ((fsym (intern (concat "sml-form-" name))))
814 (name-last-kbd-macro fsym)
815 (message "Macro bound to %s" fsym)
816 (add-to-list 'sml-forms-alist (cons name fsym))))
817
818 ;;;;
819 ;;;; SML/NJ's Compilation Manager support
820 ;;;;
821
822 ;;;###autoload
823 (add-to-list 'completion-ignored-extensions "CM/")
824 ;;;###autoload
825 (add-to-list 'auto-mode-alist '("\\.cm\\'" . sml-cm-mode))
826 ;;;###autoload
827 (define-generic-mode 'sml-cm-mode
828 '(("(*" . "*)"))
829 '("library" "Library" "LIBRARY" "group" "Group" "GROUP" "is" "IS"
830 "structure" "functor" "signature" "funsig")
831 nil '("\\.cm\\'")
832 (list (lambda () (local-set-key "\C-c\C-c" 'sml-compile)))
833 "Generic mode for SML/NJ's Compilation Manager configuration files.")
834
835 ;;;;
836 ;;;; ML-Yacc (and ML-lex) support
837 ;;;;
838
839 ;; That seems to be good enough for now ;-)
840 ;;;###autoload
841 (define-derived-mode sml-lex-mode sml-mode "SML-Lex")
842
843 (defface sml-yacc-bnf-face
844 '((t (:foreground "darkgreen")))
845 "Face used to highlight (non)terminals in `sml-yacc-mode'.")
846 (defvar sml-yacc-bnf-face 'sml-yacc-bnf-face)
847
848 (defcustom sml-yacc-indent-action 16
849 "Indentation column of the opening paren of actions."
850 :group 'sml
851 :type 'integer)
852
853 (defcustom sml-yacc-indent-pipe nil
854 "Indentation column of the pipe char in the BNF.
855 If nil, align it with `:' or with previous cases."
856 :group 'sml
857 :type 'integer)
858
859 (defcustom sml-yacc-indent-term nil
860 "Indentation column of the (non)term part.
861 If nil, align it with previous cases."
862 :group 'sml
863 :type 'integer)
864
865 (defvar sml-yacc-font-lock-keywords
866 (cons '("^\\(\\sw+\\s-*:\\|\\s-*|\\)\\(\\s-*\\sw+\\)*"
867 (0 (save-excursion
868 (save-match-data
869 (goto-char (match-beginning 0))
870 (unless (or (re-search-forward "\\<of\\>" (match-end 0) 'move)
871 (progn (sml-forward-spaces)
872 (not (looking-at "("))))
873 sml-yacc-bnf-face)))))
874 sml-font-lock-keywords))
875 (defconst sml-yacc-font-lock-defaults
876 (cons sml-yacc-font-lock-keywords (cdr sml-font-lock-defaults)))
877
878 (defun sml-yacc-bnf-p ()
879
880
881 (defun sml-yacc-indent-line ()
882 "Indent current line of ML-Yacc code."
883 (let ((savep (> (current-column) (current-indentation)))
884 (indent (max (or (ignore-errors (sml-yacc-indentation)) 0) 0)))
885 (if savep
886 (save-excursion (indent-line-to indent))
887 (indent-line-to indent))))
888
889 (defun sml-yacc-indentation ()
890 (save-excursion
891 (back-to-indentation)
892 (or (and (looking-at "%\\|\\(\\sw\\|\\s_\\)+\\s-*:") 0)
893 (when (save-excursion
894 (condition-case nil (progn (up-list -1) nil) (scan-error t)))
895 ;; We're outside an action.
896 (cond
897 ;; Special handling of indentation inside %term and %nonterm
898 ((save-excursion
899 (and (re-search-backward "^%\\(\\sw+\\)" nil t)
900 (member (match-string 1) '("term" "nonterm"))))
901 (if (numberp sml-yacc-indent-term) sml-yacc-indent-term
902 (let ((offset (if (looking-at "|") -2 0)))
903 (forward-line -1)
904 (looking-at "\\s-*\\(%\\sw*\\||\\)?\\s-*")
905 (goto-char (match-end 0))
906 (+ offset (current-column)))))
907 ((looking-at "(") sml-yacc-indent-action)
908 ((looking-at "|")
909 (if (numberp sml-yacc-indent-pipe) sml-yacc-indent-pipe
910 (backward-sexp 1)
911 (while (progn (sml-backward-spaces)
912 (/= 0 (skip-syntax-backward "w_"))))
913 (sml-backward-spaces)
914 (if (not (looking-at "\\s-$"))
915 (1- (current-column))
916 (skip-syntax-forward " ")
917 (- (current-column) 2))))))
918 ;; default to SML rules
919 (sml-calculate-indentation))))
920
921 ;;;###autoload
922 (add-to-list 'auto-mode-alist '("\\.grm\\'" . sml-yacc-mode))
923 ;;;###autoload
924 (define-derived-mode sml-yacc-mode sml-mode "SML-Yacc"
925 (set (make-local-variable 'indent-line-function) 'sml-yacc-indent-line)
926 (set (make-local-variable 'font-lock-defaults) sml-yacc-font-lock-defaults))
927
928 (provide 'sml-mode)
929
930 ;;; sml-mode.el ends here