1 ;;; sml-mode.el --- Major mode for editing (Standard) ML
3 ;; Copyright (C) 1989 Lars Bo Nielsen
4 ;; Copyright (C) 1994-1997 Matthew J. Morley
5 ;; Copyright (C) 1999-2000 Stefan Monnier
7 ;; Author: Lars Bo Nielsen
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
19 ;; This file is not part of GNU Emacs, but it is distributed under the
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.
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.
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.
40 ;; Still under construction: History obscure, needs a biographer as
41 ;; well as a M-x doctor. Change Log on request.
43 ;; Hacked by Olin Shivers for comint from Lars Bo Nielsen's sml.el.
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.
51 ;; See accompanying info file: sml-mode.info
53 ;;; FOR YOUR .EMACS FILE
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:
58 ;; (add-to-list 'load-path "~jones/lib/emacs/")
60 ;; Then to access the commands autoload sml-mode with that command:
62 ;; (load "sml-mode-startup")
64 ;; sml-mode-hook is run whenever a new sml-mode buffer is created.
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*
72 (eval-when-compile (require 'cl))
77 ;;; VARIABLES CONTROLLING INDENTATION
79 (defcustom sml-indent-level 4
80 "*Indentation of blocks in ML (see also `sml-structure-indent')."
84 (defcustom sml-indent-args sml-indent-level
85 "*Indentation of args placed on a separate line."
89 ;; (defvar sml-indent-align-args t
90 ;; "*Whether the arguments should be aligned.")
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 => ...
98 ;; The first seems to be the standard in SML/NJ, but the second
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] \;)."
107 ;;; OTHER GENERIC MODE VARIABLES
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
115 (setq sml-mode-info \"/usr/me/lib/info/sml-mode\")
117 in your .emacs file. You can always set it interactively with the
118 set-variable command.")
120 (defvar sml-mode-hook nil
121 "*Run upon entering `sml-mode'.
122 This is a good place to put your preferred key bindings.")
124 ;;; CODE FOR SML-MODE
126 (defun sml-mode-info ()
127 "Command to access the TeXinfo documentation for `sml-mode'.
128 See doc for the variable `sml-mode-info'."
134 (describe-variable 'sml-mode-info)
135 (message "Can't find it... set this variable first!")))))
138 ;;; Autoload functions -- no-doc is another idea cribbed from AucTeX!
141 "This function is part of sml-proc, and has not yet been loaded.
142 Full documentation will be available after autoloading the function."))
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))
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.")
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))
181 (,sml-keywords-regexp . font-lock-keyword-face))
182 "Regexps matching standard SML keywords.")
184 (defface font-lock-type-def-face
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.")
191 (defface font-lock-module-def-face
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.")
198 (defface font-lock-interface-def-face
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.")
206 ;;; Code to handle nested comments and unusual string escape sequences
209 (defsyntax sml-syntax-prop-table
210 '((?\\ . ".") (?* . "."))
211 "Syntax table for text-properties")
213 ;; For Emacsen that have no built-in support for nested comments
214 (defun sml-get-depth-st ()
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))
223 (if (re-search-backward "\\*)\\|(\\*" nil t)
224 (+ (or (get-char-property (point) 'comment-depth) 0)
225 (case (char-after) (?\( 1) (?* 0))
228 (depth (if (> depth 0) depth)))
229 (put-text-property pt (1+ pt) 'comment-depth depth)
230 (when depth sml-syntax-prop-table))))))
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)))))))
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)))
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)
251 (defun sml-imenu-create-index ()
253 (goto-char (point-max))
254 (while (re-search-backward sml-imenu-regexp nil t)
256 (let ((kind (match-string 2))
257 (column (progn (goto-char (match-beginning 2)) (current-column)))
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 "=")
265 (looking-at "sig\\|struct")))
266 (push (cons (concat (make-string (/ column 2) ?\ ) name) location)
270 ;;; MORE CODE FOR SML-MODE
273 (add-to-list 'auto-mode-alist '("\\.s\\(ml\\|ig\\)\\'" . sml-mode))
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.
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))
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.
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))
308 (defun sml-electric-pipe ()
310 Depending on the context insert the name of function, a \"=>\" etc."
313 (unless (save-excursion (skip-chars-backward "\t ") (bolp)) (insert "\n"))
317 (backward-char 2) ;back over the just inserted "| "
318 (let ((sym (sml-find-matching-starter sml-pipeheads
319 (sml-op-prec "|" 'back))))
324 (let ((f (sml-forward-sym)))
325 (sml-find-forward "\\(=>\\|=\\||\\)\\S.")
327 ((looking-at "|") "") ;probably a datatype
328 ((looking-at "=>") " => ") ;`case', or `fn' or `handle'
329 ((looking-at "=") (concat f " = "))))) ;a function
331 ;; could be a datatype or a function
332 (while (and (setq sym (sml-forward-sym))
333 (string-match "^'" sym))
334 (sml-forward-spaces))
337 (equal (sml-forward-sym) "d="))
342 (while (and (setq sym (sml-forward-sym))
343 (string-match "^'" sym))
344 (sml-forward-spaces))
346 ((member sym '("case" "handle" "fn" "of")) " => ")
347 ;;((member sym '("abstype" "datatype")) "")
351 (indent-according-to-mode)
353 (skip-chars-forward "\t |")
354 (skip-syntax-forward "w")
355 (skip-chars-forward "\t ")
356 (when (= ?= (char-after)) (backward-char)))))
358 (defun sml-electric-semi ()
360 If variable `sml-electric-semi-mode' is t, indent the current line, insert
361 a newline, and indent."
364 (if sml-electric-semi-mode
365 (reindent-then-newline-and-indent)))
369 (defun sml-mark-function ()
370 "Synonym for `mark-paragraph' -- sorry.
371 If anyone has a good algorithm for this..."
375 ;; (defun sml-indent-region (begin end)
376 ;; "Indent region of ML code."
378 ;; (message "Indenting region...")
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)
385 ;; (move-marker end nil))
386 ;; (message "Indenting region... done"))
388 (defun sml-indent-line ()
389 "Indent current line of ML code."
391 (let ((savep (> (current-column) (current-indentation)))
392 (indent (max (or (ignore-errors (sml-calculate-indentation)) 0) 0)))
394 (save-excursion (indent-line-to indent))
395 (indent-line-to indent))))
397 (defun sml-back-to-outer-indent ()
398 "Unindents to the next outer level of indentation."
402 (skip-chars-forward "\t ")
403 (let ((start-column (current-column))
404 (indent (current-column)))
405 (if (> start-column 0)
408 (while (>= indent start-column)
409 (if (re-search-backward "^[^\n]" nil t)
410 (setq indent (current-indentation))
412 (backward-delete-char-untabify (- start-column indent)))))))
414 (defun sml-find-comment-indent ()
418 (if (re-search-backward "(\\*\\|\\*)" nil t)
420 ((looking-at "*)") (incf depth))
421 ((looking-at comment-start-skip) (decf depth)))
424 (1+ (current-column))
427 (defun sml-calculate-indentation ()
429 (beginning-of-line) (skip-chars-forward "\t ")
431 ;; Indentation for comments alone on a line, matches the
432 ;; proper indentation of the next line.
433 (when (looking-at "(\\*") (sml-forward-spaces))
436 (sym (save-excursion (sml-forward-sym))))
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))
445 (and (looking-at "\\*") (sml-find-comment-indent))
447 ;; Continued string ? (Added 890113 lbn)
448 (and (looking-at "\\\\")
450 (if (save-excursion (previous-line 1)
452 (looking-at "[\t ]*\\\\"))
453 (progn (previous-line 1) (current-indentation))
454 (if (re-search-backward "[^\\\\]\"" nil t)
455 (1+ (current-column))
458 (and (setq data (assoc sym sml-close-paren))
459 (sml-indent-relative sym data))
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)
470 (and (string= sym "|") (sml-indent-pipe))
473 (sml-indent-default))))))
475 (defun sml-indent-relative (sym data)
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))))
482 (defun sml-indent-pipe ()
483 (let ((sym (sml-find-matching-starter sml-pipeheads
484 (sml-op-prec "|" 'back))))
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 "="))
493 (+ pipe-indent (current-column)))))))
495 (defun sml-find-forward (re)
497 (while (and (not (looking-at re))
499 (or (ignore-errors (forward-sexp 1) t) (forward-char 1))
501 (not (looking-at re))))))
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))
509 (if (save-excursion (not (sml-backward-arg)))
511 (+ (current-column) sml-indent-args)
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))
520 (defun sml-get-indent (data sym)
521 (let ((head-sym (pop data)) d)
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))))
528 (defun sml-dangling-sym ()
530 (and (not (sml-bolp))
531 (< (sml-point-after (end-of-line))
532 (sml-point-after (sml-forward-sym)
533 (sml-forward-spaces))))))
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))
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))))
549 (let ((delegate (assoc sym sml-close-paren))
551 (when (and delegate (not (eval (third delegate))))
552 ;;(sml-find-match-backward sym delegate)
553 (sml-forward-sym) (sml-backward-sexp nil)
555 (if (second delegate)
556 (save-excursion (sml-forward-sym))
557 (sml-backward-spaces) (sml-backward-sym))))
559 (let ((idata (assoc head-sym sml-indent-rule)))
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))))))))
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))))
583 ;; the previous sym is an indentation introducer: follow the rule
584 (let ((indent-after (or (cdr (assoc sym-after sml-symbol-indent)) 0)))
588 (+ sym-indent indent-after)))
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)))
598 (while (sml-move-if (sml-backward-sexp prec))))
599 ;; the `noindent' case does back over an introductory symbol
600 ;; such as `fun', ...
603 (sml-backward-spaces)
604 (member (sml-backward-sym) sml-starters-syms)))
610 (skip-chars-backward " \t|") (bolp)))
613 ;; maybe `|' should be set to word-syntax in our temp syntax table ?
614 (defun sml-current-indentation ()
617 (skip-chars-forward " \t|")
621 (defun sml-find-matching-starter (syms &optional prec)
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))))
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
636 (sml-backward-sexp nil)
637 (sml-skip-siblings)))
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)
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.
648 ;; Obviously, let's not try again if we're at bobp.
649 (unless (bobp) (sml-beginning-of-defun)))))
651 (defcustom sml-max-name-components 3
652 "Maximum number of components to use for the current function name."
656 (defun sml-current-fun-name ()
658 (let ((count sml-max-name-components)
661 (while (and (> count 0)
662 (setq name (sml-beginning-of-defun)))
664 (setq fullname (if fullname (concat name "." fullname) name))
665 ;; Skip all other declarations that we find at the same level.
670 (defun sml-comment-indent ()
671 (if (looking-at "^(\\*") ; Existing comment at beginning
672 0 ; of line stays there.
675 ;;; INSERTING PROFORMAS (COMMON SML-FORMS)
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.")
690 (defmacro sml-def-skeleton (name interactor &rest elements)
691 (let ((fsym (intern (concat "sml-form-" name))))
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)
700 (put 'sml-def-skeleton 'lisp-indent-function 2)
702 (sml-def-skeleton "let" nil
703 _ "\nin" > "\nend" >)
705 (sml-def-skeleton "if" nil
706 _ " then " > "\nelse " >)
708 (sml-def-skeleton "local" nil
709 _ "\nin" > "\nend" >)
711 (sml-def-skeleton "case" "Case expr: "
712 str "\nof " > _ " => ")
714 (sml-def-skeleton "signature" "Signature name: "
715 str " =\nsig" > "\n" > _ "\nend" >)
717 (sml-def-skeleton "structure" "Structure name: "
718 str " =\nstruct" > "\n" > _ "\nend" >)
720 (sml-def-skeleton "functor" "Functor name: "
721 str " () : =\nstruct" > "\n" > _ "\nend" >)
723 (sml-def-skeleton "datatype" "Datatype name and type params: "
726 (sml-def-skeleton "abstype" "Abstype name and type params: "
727 str " =" \n _ "\nwith" > "\nend" >)
731 (sml-def-skeleton "struct" nil
734 (sml-def-skeleton "sig" nil
737 (sml-def-skeleton "val" nil
740 (sml-def-skeleton "fn" nil
743 (sml-def-skeleton "fun" nil
748 (defun sml-forms-menu (menu)
749 (easy-menu-filter-return
750 (easy-menu-create-menu "Forms"
754 (vector name fsym t)))
757 (defvar sml-last-form "let")
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."
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)))
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).
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'."
780 (list (completing-read
781 (format "Form to insert: (default %s) " sml-last-form)
782 sml-forms-alist nil t nil)
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-*$")))
789 (unless (/= ?w (char-syntax (char-before))) (insert " "))
790 (let ((f (cdr (assoc name sml-forms-alist))))
792 ((commandp f) (command-execute f))
794 (t (error "Undefined form: %s" name)))))
796 ;; See also macros.el in emacs lisp dir.
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
803 The symbol's function definition becomes the keyboard macro string.
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.
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))))
819 ;;;; SML/NJ's Compilation Manager support
823 (add-to-list 'completion-ignored-extensions "CM/")
825 (add-to-list 'auto-mode-alist '("\\.cm\\'" . sml-cm-mode))
827 (define-generic-mode 'sml-cm-mode
829 '("library" "Library" "LIBRARY" "group" "Group" "GROUP" "is" "IS"
830 "structure" "functor" "signature" "funsig")
832 (list (lambda () (local-set-key "\C-c\C-c" 'sml-compile)))
833 "Generic mode for SML/NJ's Compilation Manager configuration files.")
836 ;;;; ML-Yacc (and ML-lex) support
839 ;; That seems to be good enough for now ;-)
841 (define-derived-mode sml-lex-mode sml-mode "SML-Lex")
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)
848 (defcustom sml-yacc-indent-action 16
849 "Indentation column of the opening paren of actions."
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."
859 (defcustom sml-yacc-indent-term nil
860 "Indentation column of the (non)term part.
861 If nil, align it with previous cases."
865 (defvar sml-yacc-font-lock-keywords
866 (cons '("^\\(\\sw+\\s-*:\\|\\s-*|\\)\\(\\s-*\\sw+\\)*"
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)))
878 (defun sml-yacc-bnf-p ()
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)))
886 (save-excursion (indent-line-to indent))
887 (indent-line-to indent))))
889 (defun sml-yacc-indentation ()
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.
897 ;; Special handling of indentation inside %term and %nonterm
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)))
904 (looking-at "\\s-*\\(%\\sw*\\||\\)?\\s-*")
905 (goto-char (match-end 0))
906 (+ offset (current-column)))))
907 ((looking-at "(") sml-yacc-indent-action)
909 (if (numberp sml-yacc-indent-pipe) sml-yacc-indent-pipe
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))))
922 (add-to-list 'auto-mode-alist '("\\.grm\\'" . sml-yacc-mode))
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))
930 ;;; sml-mode.el ends here