code.delx.au - gnu-emacs-elpa/blob - sml-mode.el

   1 ;;; sml-mode.el. Major mode for editing (Standard) ML. Version 3.3(beta)
   2
   3 (defconst rcsid-sml-mode "@(#)$Name$:$Id$")
   4
   5 ;; Copyright (C) 1989-1999, Lars Bo Nielsen; 1994,1997, Matthew J. Morley
   6
   7 ;; $Revision$
   8 ;; $Date$
   9
  10 ;; This file is not part of GNU Emacs, but it is distributed under the
  11 ;; same conditions.
  12
  13 ;; ====================================================================
  14
  15 ;; This program is free software; you can redistribute it and/or
  16 ;; modify it under the terms of the GNU General Public License as
  17 ;; published by the Free Software Foundation; either version 2, or (at
  18 ;; your option) any later version.
  19
  20 ;; This program is distributed in the hope that it will be useful, but
  21 ;; WITHOUT ANY WARRANTY; without even the implied warranty of
  22 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
  23 ;; General Public License for more details.
  24
  25 ;; You should have received a copy of the GNU General Public License
  26 ;; along with GNU Emacs; see the file COPYING. If not, write to the
  27 ;; Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
  28
  29 ;; ====================================================================
  30
  31 ;;; HISTORY
  32
  33 ;; Still under construction: History obscure, needs a biographer as
  34 ;; well as a M-x doctor. Change Log on request.
  35
  36 ;; Hacked by Olin Shivers for comint from Lars Bo Nielsen's sml.el.
  37
  38 ;; Hacked by Matthew Morley to incorporate Fritz Knabe's hilite and
  39 ;; font-lock patterns, some of Steven Gilmore's (reduced) easy-menus,
  40 ;; and numerous bugs and bug-fixes.
  41
  42 ;; Author: Lars Bo Nielsen
  43 ;;      Olin Shivers
  44 ;;      Fritz Knabe (?)
  45 ;;      Steven Gilmore (?)
  46 ;;      Matthew Morley <mjm@scs.leeds.ac.uk> (aka <matthew@verisity.com>)
  47 ;;      Matthias Blume <blume@cs.princeton.edu> (aka <blume@kurims.kyoto-u.ac.jp>)
  48 ;;      (Stefan Monnier) monnier@cs.yale.edu
  49 ;; Maintainer: (Stefan Monnier) monnier+lists/emacs/sml@tequila.cs.yale.edu
  50 ;; Keywords: SML
  51
  52 ;;; DESCRIPTION
  53
  54 ;; See accompanying info file: sml-mode.info
  55
  56 ;;; FOR YOUR .EMACS FILE
  57
  58 ;; If sml-mode.el lives in some non-standard directory, you must tell
  59 ;; emacs where to get it. This may or may not be necessary:
  60
  61 ;; (setq load-path (cons (expand-file-name "~jones/lib/emacs") load-path))
  62
  63 ;; Then to access the commands autoload sml-mode with that command:
  64
  65 ;; (autoload 'sml-mode "sml-mode" "Major mode for editing ML programs." t)
  66 ;;
  67 ;; If files ending in ".sml" or ".ML" are hereafter considered to contain
  68 ;; Standard ML source, put their buffers into sml-mode automatically:
  69
  70 ;; (setq auto-mode-alist
  71 ;;       (cons '(("\\.sml$" . sml-mode)
  72 ;;               ("\\.ML$"  . sml-mode)) auto-mode-alist))
  73
  74 ;; Here's an example of setting things up in the sml-mode-hook:
  75
  76 ;; (setq sml-mode-hook
  77 ;;       '(lambda() "ML mode hacks"
  78 ;;          (setq sml-indent-level 2         ; conserve on horiz. space
  79 ;;                indent-tabs-mode nil)))    ; whatever
  80
  81 ;; sml-mode-hook is run whenever a new sml-mode buffer is created.
  82 ;; There is an sml-load-hook too, which is only run when this file is
  83 ;; loaded. One use for this hook is to select your preferred
  84 ;; highlighting scheme, like this:
  85
  86 ;; (setq sml-load-hook
  87 ;;       '(lambda() "Highlights." (require 'sml-hilite)))
  88
  89 ;; hilit19 is the magic that actually does the highlighting. My set up
  90 ;; for hilit19 runs something like this:
  91
  92 ;; (if window-system
  93 ;;     (setq hilit-background-mode   t ; monochrome (alt: 'dark or 'light)
  94 ;;           hilit-inhibit-hooks     nil
  95 ;;           hilit-inhibit-rebinding nil
  96 ;;           hilit-quietly           t))
  97
  98 ;; Alternatively, you can (require 'sml-font) which uses the font-lock
  99 ;; package instead.
 100
 101 ;; Finally, there are inferior-sml-{mode,load}-hooks -- see comments
 102 ;; in sml-proc.el. For much more information consult the mode's *info*
 103 ;; tree.
 104
 105 ;;; VERSION STRING
 106
 107 (defconst sml-mode-version-string "sml-mode, version 3.9.2")
 108
 109 (require 'cl)
 110 (require 'sml-util)
 111 (require 'sml-move)
 112 (require 'sml-defs)
 113
 114 ;;; VARIABLES CONTROLLING INDENTATION
 115
 116 (defvar sml-indent-level 4
 117   "*Indentation of blocks in ML (see also `sml-structure-indent').")
 118
 119 (defvar sml-indent-args sml-indent-level
 120   "*Indentation of args placed on a separate line.")
 121
 122 ;; (defvar sml-indent-align-args t
 123 ;;   "*Whether the arguments should be aligned.")
 124
 125 ;; (defvar sml-case-indent nil
 126 ;;   "*How to indent case-of expressions.
 127 ;;     If t:   case expr                     If nil:   case expr of
 128 ;;               of exp1 => ...                            exp1 => ...
 129 ;;                | exp2 => ...                          | exp2 => ...
 130
 131 ;; The first seems to be the standard in SML/NJ, but the second
 132 ;; seems nicer...")
 133
 134 (defvar sml-electric-semi-mode nil
 135   "*If t, `\;' will self insert, reindent the line, and do a newline.
 136 If nil, just insert a `\;'. (To insert while t, do: C-q \;).")
 137
 138 ;;; OTHER GENERIC MODE VARIABLES
 139
 140 (defvar sml-mode-info "sml-mode"
 141   "*Where to find Info file for sml-mode.
 142 The default assumes the info file \"sml-mode.info\" is on Emacs' info
 143 directory path. If it is not, either put the file on the standard path
 144 or set the variable sml-mode-info to the exact location of this file
 145 which is part of the sml-mode 3.2 (and later) distribution. E.g:
 146
 147   (setq sml-mode-info \"/usr/me/lib/info/sml-mode\")
 148
 149 in your .emacs file. You can always set it interactively with the
 150 set-variable command.")
 151
 152 (defvar sml-mode-hook nil
 153   "*This hook is run when sml-mode is loaded, or a new sml-mode buffer created.
 154 This is a good place to put your preferred key bindings.")
 155
 156 (defvar sml-load-hook nil
 157   "*This hook is run when sml-mode (sml-mode.el) is loaded into Emacs.")
 158
 159 (defvar sml-mode-abbrev-table nil "*SML mode abbrev table (default nil)")
 160
 161 ;;; CODE FOR SML-MODE
 162
 163 (defun sml-mode-info ()
 164   "Command to access the TeXinfo documentation for sml-mode.
 165 See doc for the variable sml-mode-info."
 166   (interactive)
 167   (require 'info)
 168   (condition-case nil
 169       (Info-goto-node (concat "(" sml-mode-info ")"))
 170     (error (progn
 171              (describe-variable 'sml-mode-info)
 172              (message "Can't find it... set this variable first!")))))
 173
 174
 175 ;;; Autoload functions -- no-doc is another idea cribbed from AucTeX!
 176
 177 (let ((sml-no-doc
 178        "This function is part of sml-proc, and has not yet been loaded.
 179 Full documentation will be available after autoloading the function."))
 180
 181   (autoload 'run-sml            "sml-proc"   sml-no-doc t)
 182   (autoload 'sml-compile        "sml-proc"   sml-no-doc t)
 183   (autoload 'sml-load-file      "sml-proc"   sml-no-doc t)
 184   (autoload 'switch-to-sml      "sml-proc"   sml-no-doc t)
 185   (autoload 'sml-send-region    "sml-proc"   sml-no-doc t)
 186   (autoload 'sml-send-buffer    "sml-proc"   sml-no-doc t))
 187
 188 ;; font-lock setup
 189
 190 (defconst sml-keywords-regexp
 191   (sml-syms-re "abstraction" "abstype" "and" "andalso" "as" "before" "case"
 192                "datatype" "else" "end" "eqtype" "exception" "do" "fn"
 193                "fun" "functor" "handle" "if" "in" "include" "infix"
 194                "infixr" "let" "local" "nonfix" "of" "op" "open" "orelse"
 195                "overload" "raise" "rec" "sharing" "sig" "signature"
 196                "struct" "structure" "then" "type" "val" "where" "while"
 197                "with" "withtype")
 198   "A regexp that matches any and all keywords of SML.")
 199
 200 (defconst sml-font-lock-keywords
 201   `(;;(sml-font-comments-and-strings)
 202     ("\\<\\(fun\\|and\\)\\s-+\\(\\sw+\\)"
 203      (1 font-lock-keyword-face)
 204      (2 font-lock-function-def-face))
 205     ("\\<\\(\\(data\\|abs\\|with\\|eq\\)?type\\)\\s-+\\('\\s-*\\sw+\\s-+\\)*\\(\\sw+\\)"
 206      (1 font-lock-keyword-face)
 207      (4 font-lock-type-def-face))
 208     ("\\<\\(val\\)\\s-+\\(\\sw+\\>\\s-*\\)?\\(\\sw+\\)\\s-*="
 209      (1 font-lock-keyword-face)
 210      ;;(6 font-lock-variable-def-face nil t)
 211      (3 font-lock-variable-def-face))
 212     ("\\<\\(structure\\|functor\\|abstraction\\)\\s-+\\(\\sw+\\)"
 213      (1 font-lock-keyword-face)
 214      (2 font-lock-module-def-face))
 215     ("\\<\\(signature\\)\\s-+\\(\\sw+\\)"
 216      (1 font-lock-keyword-face)
 217      (2 font-lock-interface-def-face))
 218
 219     (,sml-keywords-regexp . font-lock-keyword-face))
 220   "Regexps matching standard SML keywords.")
 221
 222 ;; default faces values
 223 (flet ((def-face (face def)
 224          "Define a face for font-lock."
 225          (unless (boundp face)
 226            (set face (cond
 227                       ((facep face) face)
 228                       ((facep def) (copy-face def face))
 229                       (t def))))))
 230   (def-face 'font-lock-function-def-face 'font-lock-function-name-face)
 231   (def-face 'font-lock-type-def-face 'font-lock-type-face)
 232   (def-face 'font-lock-module-def-face 'font-lock-function-name-face)
 233   (def-face 'font-lock-interface-def-face 'font-lock-type-face)
 234   (def-face 'font-lock-variable-def-face 'font-lock-variable-name-face))
 235
 236 (defvar sml-syntax-prop-table
 237   (let ((st (make-syntax-table)))
 238     (modify-syntax-entry ?l "(d" st)
 239     (modify-syntax-entry ?s "(d" st)
 240     (modify-syntax-entry ?d ")l" st)
 241     (modify-syntax-entry ?\\ "." st)
 242     (modify-syntax-entry ?* "." st)
 243     st))
 244
 245 (defun sml-get-depth-st ()
 246   (save-excursion
 247     (let* ((disp (if (eq (char-before) ?\)) (progn (backward-char) -1) nil))
 248            (foo (backward-char))
 249            (disp (if (eq (char-before) ?\() (progn (backward-char) 0) disp))
 250            (pt (point)))
 251       (when disp
 252         (let* ((depth
 253                 (save-match-data
 254                   (if (re-search-backward "\\*)\\|(\\*" nil t)
 255                       (+ (or (get-char-property (point) 'comment-depth) 0)
 256                          (case (char-after) (?\( 1) (?* 0))
 257                          disp)
 258                     0)))
 259                (depth (if (> depth 0) depth)))
 260           (put-text-property pt (1+ pt) 'comment-depth depth)
 261           (when depth sml-syntax-prop-table))))))
 262
 263 (defconst sml-font-lock-syntactic-keywords
 264   `(;;("\\<\\(l\\)\\(et\\|ocal\\)\\>" (1 ',sml-syntax-prop-table))
 265     ;;("\\<\\(s\\)\\(ig\\truct\\)\\>" (1 ',sml-syntax-prop-table))
 266     ;;("\\<en\\(d\\)\\>" (1 ',sml-syntax-prop-table))
 267     ("^\\s-*\\(\\\\\\)" (1 ',sml-syntax-prop-table))
 268     ("(?\\(\\*\\))?" (1 (sml-get-depth-st)))))
 269
 270 (defconst sml-font-lock-defaults
 271   '(sml-font-lock-keywords nil nil ((?_ . "w") (?' . "w")) nil
 272                            (font-lock-syntactic-keywords . sml-font-lock-syntactic-keywords)))
 273
 274
 275 ;;; MORE CODE FOR SML-MODE
 276
 277 (defun sml-mode-version ()
 278   "This file's version number (sml-mode)."
 279   (interactive)
 280   (message sml-mode-version-string))
 281
 282 ;;;###Autoload
 283 (defun sml-mode ()
 284   "Major mode for editing ML code.
 285 Tab indents for ML code.
 286 Comments are delimited with (* ... *).
 287 Blank lines and form-feeds separate paragraphs.
 288 Delete converts tabs to spaces as it moves back.
 289
 290 For information on running an inferior ML process, see the documentation
 291 for inferior-sml-mode (set this up with \\[sml]).
 292
 293 Customisation: Entry to this mode runs the hooks on sml-mode-hook.
 294
 295 Variables controlling the indentation
 296 =====================================
 297
 298 Seek help (\\[describe-variable]) on individual variables to get current settings.
 299
 300 sml-indent-level (default 4)
 301     The indentation of a block of code.
 302
 303 sml-electric-semi-mode (default nil)
 304     If t, a `\;' will reindent line, and perform a newline.
 305
 306 Mode map
 307 ========
 308 \\{sml-mode-map}"
 309
 310   (interactive)
 311   (kill-all-local-variables)
 312   (sml-mode-variables)
 313   (use-local-map sml-mode-map)
 314   (setq major-mode 'sml-mode)
 315   (setq mode-name "SML")
 316   (set (make-local-variable 'outline-regexp) sml-outline-regexp)
 317   (run-hooks 'sml-mode-hook))            ; Run the hook last
 318
 319 (defun sml-mode-variables ()
 320   (set-syntax-table sml-mode-syntax-table)
 321   (setq local-abbrev-table sml-mode-abbrev-table)
 322   ;; A paragraph is separated by blank lines or ^L only.
 323
 324   (set (make-local-variable 'paragraph-start)
 325        (concat "^[\t ]*$\\|" page-delimiter))
 326   (set (make-local-variable 'paragraph-separate) paragraph-start)
 327   (set (make-local-variable 'indent-line-function) 'sml-indent-line)
 328   (set (make-local-variable 'comment-start) "(* ")
 329   (set (make-local-variable 'comment-end) " *)")
 330   (set (make-local-variable 'comment-column) 40)
 331   (set (make-local-variable 'comment-start-skip) "(\\*+[ \t]?")
 332   (set (make-local-variable 'comment-indent-function) 'sml-comment-indent)
 333   (set (make-local-variable 'font-lock-defaults) sml-font-lock-defaults))
 334
 335 (defun sml-electric-pipe ()
 336   "Insert a \"|\".
 337 Depending on the context insert the name of function, a \"=>\" etc."
 338   (interactive)
 339   (sml-with-ist
 340    (unless (save-excursion (skip-chars-backward "\t ") (bolp)) (insert "\n"))
 341    (insert "| ")
 342    (let ((text
 343           (save-excursion
 344             (backward-char 2)           ;back over the just inserted "| "
 345             (sml-find-matching-starter sml-pipehead-re
 346                                        (sml-op-prec "|" 'back))
 347             (let ((sym (sml-forward-sym)))
 348               (sml-forward-spaces)
 349               (cond
 350                ((string= sym "|")
 351                 (let ((f (sml-forward-sym)))
 352                   (sml-find-forward "\\(=>\\|=\\||\\)\\S.")
 353                   (cond
 354                    ((looking-at "|") "") ;probably a datatype
 355                    ((looking-at "=>") " => ") ;`case', or `fn' or `handle'
 356                    ((looking-at "=") (concat f "  = "))))) ;a function
 357                ((string= sym "and")
 358                 ;; could be a datatype or a function
 359                 (while (and (setq sym (sml-forward-sym))
 360                             (string-match "^'" sym))
 361                   (sml-forward-spaces))
 362                 (sml-forward-spaces)
 363                 (if (or (not sym)
 364                         (equal (sml-forward-sym) "d="))
 365                     ""
 366                   (concat sym "  = ")))
 367                ;; trivial cases
 368                ((string= sym "fun")
 369                 (while (and (setq sym (sml-forward-sym))
 370                             (string-match "^'" sym))
 371                   (sml-forward-spaces))
 372                 (concat sym "  = "))
 373                ((member sym '("case" "handle" "fn")) " => ")
 374                ((member sym '("abstype" "datatype")) "")
 375                (t (error "Wow, now, there's a bug")))))))
 376
 377      (insert text)
 378      (sml-indent-line)
 379      (beginning-of-line)
 380      (skip-chars-forward "\t |")
 381      (skip-syntax-forward "w")
 382      (skip-chars-forward "\t ")
 383      (when (= ?= (char-after)) (backward-char)))))
 384
 385 (defun sml-electric-semi ()
 386   "Inserts a \;.
 387 If variable sml-electric-semi-mode is t, indent the current line, insert
 388 a newline, and indent."
 389   (interactive)
 390   (insert "\;")
 391   (if sml-electric-semi-mode
 392       (reindent-then-newline-and-indent)))
 393
 394 ;;; INDENTATION !!!
 395
 396 (defun sml-mark-function ()
 397   "Synonym for mark-paragraph -- sorry.
 398 If anyone has a good algorithm for this..."
 399   (interactive)
 400   (mark-paragraph))
 401
 402 (defun sml-indent-region (begin end)
 403   "Indent region of ML code."
 404   (interactive "r")
 405   (message "Indenting region...")
 406   (save-excursion
 407     (goto-char end) (setq end (point-marker)) (goto-char begin)
 408     (while (< (point) end)
 409       (skip-chars-forward "\t\n ")
 410       (sml-indent-line)
 411       (end-of-line))
 412     (move-marker end nil))
 413   (message "Indenting region... done"))
 414
 415 (defun sml-indent-line ()
 416   "Indent current line of ML code."
 417   (interactive)
 418   (let ((indent (sml-calculate-indentation)))
 419     (if (/= (current-indentation) indent)
 420         (save-excursion                 ;; Added 890601 (point now stays)
 421           (let ((beg (progn (beginning-of-line) (point))))
 422             (skip-chars-forward "\t ")
 423             (delete-region beg (point))
 424             (indent-to indent))))
 425     ;; If point is before indentation, move point to indentation
 426     (if (< (current-column) (current-indentation))
 427         (skip-chars-forward "\t "))))
 428
 429 (defun sml-back-to-outer-indent ()
 430   "Unindents to the next outer level of indentation."
 431   (interactive)
 432   (save-excursion
 433     (beginning-of-line)
 434     (skip-chars-forward "\t ")
 435     (let ((start-column (current-column))
 436           (indent (current-column)))
 437       (if (> start-column 0)
 438           (progn
 439             (save-excursion
 440               (while (>= indent start-column)
 441                 (if (re-search-backward "^[^\n]" nil t)
 442                     (setq indent (current-indentation))
 443                   (setq indent 0))))
 444             (backward-delete-char-untabify (- start-column indent)))))))
 445
 446 (defun sml-find-comment-indent ()
 447   (save-excursion
 448     (let ((depth 1))
 449       (while (> depth 0)
 450         (if (re-search-backward "(\\*\\|\\*)" nil t)
 451             (cond
 452              ((looking-at "*)") (incf depth))
 453              ((looking-at comment-start-skip) (decf depth)))
 454           (setq depth -1)))
 455       (if (= depth 0)
 456           (1+ (current-column))
 457         nil))))
 458
 459 (defun sml-calculate-indentation ()
 460   (save-excursion
 461     (beginning-of-line) (skip-chars-forward "\t ")
 462     (sml-with-ist
 463      ;; Indentation for comments alone on a line, matches the
 464      ;; proper indentation of the next line.
 465      (when (looking-at comment-start-skip) (sml-forward-spaces))
 466      (let (data
 467            (sml-point (point))
 468            (sym (save-excursion (sml-forward-sym))))
 469        (or
 470         ;; continued comment
 471         (and (looking-at "\\*") (sml-find-comment-indent))
 472
 473         ;; Continued string ? (Added 890113 lbn)
 474         (and (looking-at "\\\\")
 475              (save-excursion
 476                (if (save-excursion (previous-line 1)
 477                                    (beginning-of-line)
 478                                    (looking-at "[\t ]*\\\\"))
 479                    (progn (previous-line 1) (current-indentation))
 480                  (if (re-search-backward "[^\\\\]\"" nil t)
 481                      (1+ (current-column))
 482                    0))))
 483
 484         (and (setq data (assoc sym sml-close-paren))
 485              (sml-indent-relative sym data))
 486
 487         (and (looking-at sml-starters-re)
 488              (let ((sym (unless (save-excursion (sml-backward-arg))
 489                           (sml-backward-spaces)
 490                           (sml-backward-sym))))
 491                (if sym (sml-get-sym-indent sym)
 492                  ;; FIXME: this can take a *long* time !!
 493                  (sml-find-matching-starter sml-starters-re)
 494                  (current-column))))
 495
 496         (and (string= sym "|") (sml-indent-pipe))
 497
 498         (sml-indent-arg)
 499         (sml-indent-default))))))
 500
 501 (defun sml-indent-relative (sym data)
 502   (save-excursion
 503     (sml-forward-sym) (sml-backward-sexp nil)
 504     (unless (second data) (sml-backward-spaces) (sml-backward-sym))
 505     (+ (or (cdr (assoc sym sml-symbol-indent)) 0)
 506        (sml-delegated-indent))))
 507
 508 (defun sml-indent-pipe ()
 509   (when (sml-find-matching-starter sml-pipehead-re
 510                                    (sml-op-prec "|" 'back))
 511     (if (looking-at "|")
 512         (if (sml-bolp) (current-column) (sml-indent-pipe))
 513       (let ((pipe-indent (or (cdr (assoc "|" sml-symbol-indent)) -2)))
 514         (when (looking-at "\\(data\\|abs\\)type\\>")
 515           (re-search-forward "="))
 516         (sml-forward-sym)
 517         (sml-forward-spaces)
 518         (+ pipe-indent (current-column))))))
 519
 520 (defun sml-find-forward (re)
 521   (sml-forward-spaces)
 522   (while (and (not (looking-at re))
 523               (progn
 524                 (or (ignore-errors (forward-sexp 1) t) (forward-char 1))
 525                 (sml-forward-spaces)
 526                 (not (looking-at re))))))
 527
 528 (defun sml-indent-arg ()
 529   (and (save-excursion (ignore-errors (sml-forward-arg)))
 530        ;;(not (looking-at sml-not-arg-re))
 531        ;; looks like a function or an argument
 532        (sml-move-if (sml-backward-arg))
 533        ;; an argument
 534        (if (save-excursion (not (sml-backward-arg)))
 535            ;; a first argument
 536            (+ (current-column) sml-indent-args)
 537          ;; not a first arg
 538          (while (and (/= (current-column) (current-indentation))
 539                      (sml-move-if (sml-backward-arg))))
 540          (unless (save-excursion (sml-backward-arg))
 541            ;; all earlier args are on the same line
 542            (sml-forward-arg) (sml-forward-spaces))
 543          (current-column))))
 544
 545 (defun sml-get-indent (data sym)
 546   (let ((head-sym (pop data)) d)
 547     (cond
 548      ((not (listp data)) data)
 549      ((setq d (member sym data)) (second d))
 550      ((and (consp data) (not (stringp (car data)))) (car data))
 551      (t sml-indent-level))))
 552
 553 (defun sml-dangling-sym ()
 554   (save-excursion
 555     (and (not (sml-bolp))
 556          (< (sml-point-after (end-of-line))
 557             (sml-point-after (sml-forward-sym)
 558                              (sml-forward-spaces))))))
 559
 560 (defun sml-delegated-indent ()
 561   (if (sml-dangling-sym)
 562       (sml-indent-default 'noindent)
 563     (sml-move-if (backward-word 1)
 564                  (looking-at sml-agglomerate-re))
 565     (current-column)))
 566
 567 (defun sml-get-sym-indent (sym &optional style)
 568   "expects to be looking-at SYM.
 569 If indentation is delegated, the point will be at the start of
 570 the parent at the end of this function."
 571   (assert (equal sym (save-excursion (sml-forward-sym))))
 572   (save-excursion
 573     (let ((delegate (assoc sym sml-close-paren))
 574           (head-sym sym))
 575       (when (and delegate (not (eval (third delegate))))
 576         ;;(sml-find-match-backward sym delegate)
 577         (sml-forward-sym) (sml-backward-sexp nil)
 578         (setq head-sym
 579               (if (second delegate)
 580                   (save-excursion (sml-forward-sym))
 581                 (sml-backward-spaces) (sml-backward-sym))))
 582
 583       (let ((idata (assoc head-sym sml-indent-rule)))
 584         (when idata
 585           ;;(if (or style (not delegate))
 586           ;; normal indentation
 587           (let ((indent (sml-get-indent idata sym)))
 588             (when indent (+ (sml-delegated-indent) indent)))
 589           ;; delgate indentation to the parent
 590           ;;(sml-forward-sym) (sml-backward-sexp nil)
 591           ;;(let* ((parent-sym (save-excursion (sml-forward-sym)))
 592           ;;     (parent-indent (cdr (assoc parent-sym sml-indent-starters))))
 593           ;; check the special rules
 594           ;;(+ (sml-delegated-indent)
 595           ;; (or (sml-get-indent indent-data 1 'strict)
 596           ;; (sml-get-indent parent-indent 1 'strict)
 597           ;; (sml-get-indent indent-data 0)
 598           ;; (sml-get-indent parent-indent 0))))))))
 599           )))))
 600
 601 (defun sml-indent-default (&optional noindent)
 602   (let* ((sym-after (save-excursion (sml-forward-sym)))
 603          (_ (sml-backward-spaces))
 604          (sym-before (sml-backward-sym))
 605          (sym-indent (and sym-before (sml-get-sym-indent sym-before))))
 606     (if sym-indent
 607         ;; the previous sym is an indentation introducer: follow the rule
 608         (let ((indent-after (or (cdr (assoc sym-after sml-symbol-indent)) 0)))
 609           (if noindent (current-column) (+ sym-indent indent-after)))
 610       ;; default-default
 611       (let* ((prec-after (sml-op-prec sym-after 'back))
 612              (prec (or (sml-op-prec sym-before 'back) prec-after 100)))
 613         ;; go back until you hit a symbol that has a lower prec than the
 614         ;; "current one", or until you backed over a sym that has the same prec
 615         ;; but is at the beginning of a line.
 616         (while (and (not (sml-bolp))
 617                     (sml-move-if (sml-backward-sexp (1- prec)))
 618                     (not (sml-bolp)))
 619           (while (sml-move-if (sml-backward-sexp prec))))
 620         ;; the `noindent' case does back over an introductory symbol
 621         ;; such as `fun', ...
 622         (when noindent
 623           (sml-move-if
 624            (sml-backward-spaces)
 625            (string-match sml-starters-re (or (sml-backward-sym) ""))))
 626         (current-column)))))
 627
 628
 629 (defun sml-bolp ()
 630   (save-excursion
 631     (skip-chars-backward " \t|") (bolp)))
 632
 633
 634 ;; maybe `|' should be set to word-syntax in our temp syntax table ?
 635 (defun sml-current-indentation ()
 636   (save-excursion
 637     (beginning-of-line)
 638     (skip-chars-forward " \t|")
 639     (current-column)))
 640
 641
 642 (defun sml-find-matching-starter (regexp &optional prec)
 643   (ignore-errors
 644     (sml-backward-sexp prec)
 645     (while (not (or (looking-at regexp) (bobp)))
 646       (sml-backward-sexp prec))
 647     (not (bobp))))
 648
 649 (defun sml-comment-indent ()
 650   (if (looking-at "^(\\*")              ; Existing comment at beginning
 651       0                                 ; of line stays there.
 652     (save-excursion
 653       (skip-chars-backward " \t")
 654       (max (1+ (current-column))        ; Else indent at comment column
 655            comment-column))))           ; except leave at least one space.
 656
 657 ;;; INSERTING PROFORMAS (COMMON SML-FORMS)
 658
 659 (defvar sml-forms-alist nil
 660   "*The alist of templates to auto-insert.
 661
 662 You can extend this alist to your heart's content. For each additional
 663 template NAME in the list, declare a keyboard macro or function (or
 664 interactive command) called 'sml-form-NAME'.
 665
 666 If 'sml-form-NAME' is a function it takes no arguments and should
 667 insert the template at point\; if this is a command it may accept any
 668 sensible interactive call arguments\; keyboard macros can't take
 669 arguments at all. Apropos keyboard macros, see `name-last-kbd-macro'
 670 and `sml-addto-forms-alist'.
 671
 672 `sml-forms-alist' understands let, local, case, abstype, datatype,
 673 signature, structure, and functor by default.")
 674
 675 (defmacro sml-def-skeleton (name interactor &rest elements)
 676   (let ((fsym (intern (concat "sml-form-" name))))
 677     `(progn
 678        (add-to-list 'sml-forms-alist ',(cons name fsym))
 679        (define-skeleton ,fsym
 680          ,(format "SML-mode skeleton for `%s..' expressions" name)
 681          ,interactor
 682          ,(concat name " ") >
 683          ,@elements))))
 684 (put 'sml-def-skeleton 'lisp-indent-function 2)
 685
 686 (sml-def-skeleton "let" nil
 687   _ "\nin" > "\nend" >)
 688
 689 (sml-def-skeleton "if" nil
 690   _ " then " > "\nelse " >)
 691
 692 (sml-def-skeleton "local" nil
 693   _ "\nin" > "\nend" >)
 694
 695 (sml-def-skeleton "case" "Case expr: "
 696   str "\nof " > _ " => ")
 697
 698 (sml-def-skeleton "signature" "Signature name: "
 699   str " =\nsig" > "\n" > _ "\nend" >)
 700
 701 (sml-def-skeleton "structure" "Structure name: "
 702   str " =\nstruct" > "\n" > _ "\nend" >)
 703
 704 (sml-def-skeleton "functor" "Functor name: "
 705   str " () : =\nstruct" > "\n" > _ "\nend" >)
 706
 707 (sml-def-skeleton "datatype" "Datatype name and type parameters: "
 708   str " =" \n)
 709
 710 (sml-def-skeleton "abstype" "Abstype name and type parameters: "
 711   str " =" \n _ "\nwith" > "\nend" >)
 712
 713 ;;
 714
 715 (defun sml-forms-menu (menu)
 716   (easy-menu-filter-return
 717    (easy-menu-create-menu "Forms"
 718          (mapcar (lambda (x)
 719                    (let ((name (car x))
 720                          (fsym (cdr x)))
 721                      (vector name fsym t)))
 722                  sml-forms-alist))))
 723
 724 (defvar sml-last-form "let")
 725
 726 (defun sml-electric-space ()
 727   "Expand a symbol into an SML form, or just insert a space.
 728 If the point directly precedes a symbol for which an SML form exists,
 729 the corresponding form is inserted."
 730   (interactive)
 731   (let* ((point (point))
 732          (sym (sml-backward-sym)))
 733     (if (not (and sym (assoc sym sml-forms-alist)))
 734         (progn (goto-char point) (insert " "))
 735       (delete-region (point) point)
 736       (sml-insert-form sym nil))))
 737
 738 (defun sml-insert-form (name newline)
 739   "Interactive short-cut to insert a common ML form.
 740 If a perfix argument is given insert a newline and indent first, or
 741 just move to the proper indentation if the line is blank\; otherwise
 742 insert at point (which forces indentation to current column).
 743
 744 The default form to insert is 'whatever you inserted last time'
 745 \(just hit return when prompted\)\; otherwise the command reads with
 746 completion from `sml-forms-alist'."
 747   (interactive
 748    (list (completing-read
 749           (format "Form to insert: (default %s) " sml-last-form)
 750           sml-forms-alist nil t nil)
 751          current-prefix-arg))
 752   ;; default is whatever the last insert was...
 753   (if (string= name "") (setq name sml-last-form) (setq sml-last-form name))
 754   (unless (or (not newline)
 755               (save-excursion (beginning-of-line) (looking-at "\\s-*$")))
 756     (insert "\n"))
 757   (unless (/= ?w (char-syntax (char-before))) (insert " "))
 758   (let ((f (cdr (assoc name sml-forms-alist))))
 759     (cond
 760      ((commandp f) (command-execute f))
 761      (f (funcall f))
 762      (t (error "Undefined form: %s" name)))))
 763
 764 ;; See also macros.el in emacs lisp dir.
 765
 766 (defun sml-addto-forms-alist (name)
 767   "Assign a name to the last keyboard macro defined.
 768 Argument NAME is transmogrified to sml-form-NAME which is the symbol
 769 actually defined.
 770
 771 The symbol's function definition becomes the keyboard macro string.
 772
 773 If that works, NAME is added to `sml-forms-alist' so you'll be able to
 774 reinvoke the macro through \\[sml-insert-form]. You might want to save
 775 the macro to use in a later editing session -- see `insert-kbd-macro'
 776 and add these macros to your .emacs file.
 777
 778 See also `edit-kbd-macro' which is bound to \\[edit-kbd-macro]."
 779   (interactive "sName for last kbd macro (\"sml-form-\" will be added): ")
 780   (when (string= name "") (error "No command name given"))
 781   (let ((fsym (intern (concat "sml-form-" name))))
 782     (name-last-kbd-macro fsym)
 783     (message "Macro bound to %s" fsym)
 784     (add-to-list 'sml-forms-alist (cons name fsym))))
 785
 786 ;; at a pinch these could be added to SML/Forms menu through the good
 787 ;; offices of activate-menubar-hook or something... but documentation
 788 ;; of this and/or menu-bar-update-hook is sparse in 19.33. anyway, use
 789 ;; completing read for sml-insert-form prompt...
 790
 791 ;;; & do the user's customisation
 792 (run-hooks 'sml-load-hook)
 793
 794 ;;; sml-mode.el has just finished.
 795 (provide 'sml-mode)