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+\\s-+\\)*\\(\\sw+\\)"
 203      (1 font-lock-keyword-face)
 204      (3 font-lock-function-def-face))
 205     ("\\<\\(\\(data\\|abs\\|with\\|eq\\)?type\\)\\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 Entry to this mode runs the hooks on sml-mode-hook.
 286 \\{sml-mode-map}"
 287
 288   (interactive)
 289   (kill-all-local-variables)
 290   (sml-mode-variables)
 291   (use-local-map sml-mode-map)
 292   (setq major-mode 'sml-mode)
 293   (setq mode-name "SML")
 294   (set (make-local-variable 'outline-regexp) sml-outline-regexp)
 295   (run-hooks 'sml-mode-hook))            ; Run the hook last
 296
 297 (defun sml-mode-variables ()
 298   (set-syntax-table sml-mode-syntax-table)
 299   (setq local-abbrev-table sml-mode-abbrev-table)
 300   ;; A paragraph is separated by blank lines or ^L only.
 301
 302   (set (make-local-variable 'paragraph-start)
 303        (concat "^[\t ]*$\\|" page-delimiter))
 304   (set (make-local-variable 'paragraph-separate) paragraph-start)
 305   (set (make-local-variable 'indent-line-function) 'sml-indent-line)
 306   (set (make-local-variable 'comment-start) "(* ")
 307   (set (make-local-variable 'comment-end) " *)")
 308   (set (make-local-variable 'comment-column) 40)
 309   (set (make-local-variable 'comment-start-skip) "(\\*+[ \t]?")
 310   (set (make-local-variable 'comment-indent-function) 'sml-comment-indent)
 311   (set (make-local-variable 'font-lock-defaults) sml-font-lock-defaults))
 312
 313 (defun sml-electric-pipe ()
 314   "Insert a \"|\".
 315 Depending on the context insert the name of function, a \"=>\" etc."
 316   (interactive)
 317   (sml-with-ist
 318    (unless (save-excursion (skip-chars-backward "\t ") (bolp)) (insert "\n"))
 319    (insert "| ")
 320    (let ((text
 321           (save-excursion
 322             (backward-char 2)           ;back over the just inserted "| "
 323             (sml-find-matching-starter sml-pipehead-re
 324                                        (sml-op-prec "|" 'back))
 325             (let ((sym (sml-forward-sym)))
 326               (sml-forward-spaces)
 327               (cond
 328                ((string= sym "|")
 329                 (let ((f (sml-forward-sym)))
 330                   (sml-find-forward "\\(=>\\|=\\||\\)\\S.")
 331                   (cond
 332                    ((looking-at "|") "") ;probably a datatype
 333                    ((looking-at "=>") " => ") ;`case', or `fn' or `handle'
 334                    ((looking-at "=") (concat f "  = "))))) ;a function
 335                ((string= sym "and")
 336                 ;; could be a datatype or a function
 337                 (while (and (setq sym (sml-forward-sym))
 338                             (string-match "^'" sym))
 339                   (sml-forward-spaces))
 340                 (sml-forward-spaces)
 341                 (if (or (not sym)
 342                         (equal (sml-forward-sym) "d="))
 343                     ""
 344                   (concat sym "  = ")))
 345                ;; trivial cases
 346                ((string= sym "fun")
 347                 (while (and (setq sym (sml-forward-sym))
 348                             (string-match "^'" sym))
 349                   (sml-forward-spaces))
 350                 (concat sym "  = "))
 351                ((member sym '("case" "handle" "fn")) " => ")
 352                ((member sym '("abstype" "datatype")) "")
 353                (t (error "Wow, now, there's a bug")))))))
 354
 355      (insert text)
 356      (sml-indent-line)
 357      (beginning-of-line)
 358      (skip-chars-forward "\t |")
 359      (skip-syntax-forward "w")
 360      (skip-chars-forward "\t ")
 361      (when (= ?= (char-after)) (backward-char)))))
 362
 363 (defun sml-electric-semi ()
 364   "Inserts a \;.
 365 If variable sml-electric-semi-mode is t, indent the current line, insert
 366 a newline, and indent."
 367   (interactive)
 368   (insert "\;")
 369   (if sml-electric-semi-mode
 370       (reindent-then-newline-and-indent)))
 371
 372 ;;; INDENTATION !!!
 373
 374 (defun sml-mark-function ()
 375   "Synonym for mark-paragraph -- sorry.
 376 If anyone has a good algorithm for this..."
 377   (interactive)
 378   (mark-paragraph))
 379
 380 ;; (defun sml-indent-region (begin end)
 381 ;;   "Indent region of ML code."
 382 ;;   (interactive "r")
 383 ;;   (message "Indenting region...")
 384 ;;   (save-excursion
 385 ;;     (goto-char end) (setq end (point-marker)) (goto-char begin)
 386 ;;     (while (< (point) end)
 387 ;;       (skip-chars-forward "\t\n ")
 388 ;;       (sml-indent-line)
 389 ;;       (end-of-line))
 390 ;;     (move-marker end nil))
 391 ;;   (message "Indenting region... done"))
 392
 393 (defun sml-indent-line ()
 394   "Indent current line of ML code."
 395   (interactive)
 396   (let ((indent (sml-calculate-indentation)))
 397     (if (/= (current-indentation) indent)
 398         (save-excursion                 ;; Added 890601 (point now stays)
 399           (let ((beg (progn (beginning-of-line) (point))))
 400             (skip-chars-forward "\t ")
 401             (delete-region beg (point))
 402             (indent-to indent))))
 403     ;; If point is before indentation, move point to indentation
 404     (if (< (current-column) (current-indentation))
 405         (skip-chars-forward "\t "))))
 406
 407 (defun sml-back-to-outer-indent ()
 408   "Unindents to the next outer level of indentation."
 409   (interactive)
 410   (save-excursion
 411     (beginning-of-line)
 412     (skip-chars-forward "\t ")
 413     (let ((start-column (current-column))
 414           (indent (current-column)))
 415       (if (> start-column 0)
 416           (progn
 417             (save-excursion
 418               (while (>= indent start-column)
 419                 (if (re-search-backward "^[^\n]" nil t)
 420                     (setq indent (current-indentation))
 421                   (setq indent 0))))
 422             (backward-delete-char-untabify (- start-column indent)))))))
 423
 424 (defun sml-find-comment-indent ()
 425   (save-excursion
 426     (let ((depth 1))
 427       (while (> depth 0)
 428         (if (re-search-backward "(\\*\\|\\*)" nil t)
 429             (cond
 430              ((looking-at "*)") (incf depth))
 431              ((looking-at comment-start-skip) (decf depth)))
 432           (setq depth -1)))
 433       (if (= depth 0)
 434           (1+ (current-column))
 435         nil))))
 436
 437 (defun sml-calculate-indentation ()
 438   (save-excursion
 439     (beginning-of-line) (skip-chars-forward "\t ")
 440     (sml-with-ist
 441      ;; Indentation for comments alone on a line, matches the
 442      ;; proper indentation of the next line.
 443      (when (looking-at comment-start-skip) (sml-forward-spaces))
 444      (let (data
 445            (sml-point (point))
 446            (sym (save-excursion (sml-forward-sym))))
 447        (or
 448         ;; allow the user to override the indentation
 449         (when (looking-at sml-fixindent-re) (current-indentation))
 450
 451         ;; continued comment
 452         (and (looking-at "\\*") (sml-find-comment-indent))
 453
 454         ;; Continued string ? (Added 890113 lbn)
 455         (and (looking-at "\\\\")
 456              (save-excursion
 457                (if (save-excursion (previous-line 1)
 458                                    (beginning-of-line)
 459                                    (looking-at "[\t ]*\\\\"))
 460                    (progn (previous-line 1) (current-indentation))
 461                  (if (re-search-backward "[^\\\\]\"" nil t)
 462                      (1+ (current-column))
 463                    0))))
 464
 465         (and (setq data (assoc sym sml-close-paren))
 466              (sml-indent-relative sym data))
 467
 468         (and (looking-at sml-starters-re)
 469              (let ((sym (unless (save-excursion (sml-backward-arg))
 470                           (sml-backward-spaces)
 471                           (sml-backward-sym))))
 472                (if sym (sml-get-sym-indent sym)
 473                  ;; FIXME: this can take a *long* time !!
 474                  (sml-find-matching-starter sml-starters-re)
 475                  (current-column))))
 476
 477         (and (string= sym "|") (sml-indent-pipe))
 478
 479         (sml-indent-arg)
 480         (sml-indent-default))))))
 481
 482 (defun sml-indent-relative (sym data)
 483   (save-excursion
 484     (sml-forward-sym) (sml-backward-sexp nil)
 485     (unless (second data) (sml-backward-spaces) (sml-backward-sym))
 486     (+ (or (cdr (assoc sym sml-symbol-indent)) 0)
 487        (sml-delegated-indent))))
 488
 489 (defun sml-indent-pipe ()
 490   (when (sml-find-matching-starter sml-pipehead-re
 491                                    (sml-op-prec "|" 'back))
 492     (if (looking-at "|")
 493         (if (sml-bolp) (current-column) (sml-indent-pipe))
 494       (let ((pipe-indent (or (cdr (assoc "|" sml-symbol-indent)) -2)))
 495         (when (looking-at "\\(data\\|abs\\)type\\>")
 496           (re-search-forward "="))
 497         (sml-forward-sym)
 498         (sml-forward-spaces)
 499         (+ pipe-indent (current-column))))))
 500
 501 (defun sml-find-forward (re)
 502   (sml-forward-spaces)
 503   (while (and (not (looking-at re))
 504               (progn
 505                 (or (ignore-errors (forward-sexp 1) t) (forward-char 1))
 506                 (sml-forward-spaces)
 507                 (not (looking-at re))))))
 508
 509 (defun sml-indent-arg ()
 510   (and (save-excursion (ignore-errors (sml-forward-arg)))
 511        ;;(not (looking-at sml-not-arg-re))
 512        ;; looks like a function or an argument
 513        (sml-move-if (sml-backward-arg))
 514        ;; an argument
 515        (if (save-excursion (not (sml-backward-arg)))
 516            ;; a first argument
 517            (+ (current-column) sml-indent-args)
 518          ;; not a first arg
 519          (while (and (/= (current-column) (current-indentation))
 520                      (sml-move-if (sml-backward-arg))))
 521          (unless (save-excursion (sml-backward-arg))
 522            ;; all earlier args are on the same line
 523            (sml-forward-arg) (sml-forward-spaces))
 524          (current-column))))
 525
 526 (defun sml-get-indent (data sym)
 527   (let ((head-sym (pop data)) d)
 528     (cond
 529      ((not (listp data)) data)
 530      ((setq d (member sym data)) (second d))
 531      ((and (consp data) (not (stringp (car data)))) (car data))
 532      (t sml-indent-level))))
 533
 534 (defun sml-dangling-sym ()
 535   (save-excursion
 536     (and (not (sml-bolp))
 537          (< (sml-point-after (end-of-line))
 538             (sml-point-after (sml-forward-sym)
 539                              (sml-forward-spaces))))))
 540
 541 (defun sml-delegated-indent ()
 542   (if (sml-dangling-sym)
 543       (sml-indent-default 'noindent)
 544     (sml-move-if (backward-word 1)
 545                  (looking-at sml-agglomerate-re))
 546     (current-column)))
 547
 548 (defun sml-get-sym-indent (sym &optional style)
 549   "expects to be looking-at SYM.
 550 If indentation is delegated, the point will be at the start of
 551 the parent at the end of this function."
 552   (assert (equal sym (save-excursion (sml-forward-sym))))
 553   (save-excursion
 554     (let ((delegate (assoc sym sml-close-paren))
 555           (head-sym sym))
 556       (when (and delegate (not (eval (third delegate))))
 557         ;;(sml-find-match-backward sym delegate)
 558         (sml-forward-sym) (sml-backward-sexp nil)
 559         (setq head-sym
 560               (if (second delegate)
 561                   (save-excursion (sml-forward-sym))
 562                 (sml-backward-spaces) (sml-backward-sym))))
 563
 564       (let ((idata (assoc head-sym sml-indent-rule)))
 565         (when idata
 566           ;;(if (or style (not delegate))
 567           ;; normal indentation
 568           (let ((indent (sml-get-indent idata sym)))
 569             (when indent (+ (sml-delegated-indent) indent)))
 570           ;; delgate indentation to the parent
 571           ;;(sml-forward-sym) (sml-backward-sexp nil)
 572           ;;(let* ((parent-sym (save-excursion (sml-forward-sym)))
 573           ;;     (parent-indent (cdr (assoc parent-sym sml-indent-starters))))
 574           ;; check the special rules
 575           ;;(+ (sml-delegated-indent)
 576           ;; (or (sml-get-indent indent-data 1 'strict)
 577           ;; (sml-get-indent parent-indent 1 'strict)
 578           ;; (sml-get-indent indent-data 0)
 579           ;; (sml-get-indent parent-indent 0))))))))
 580           )))))
 581
 582 (defun sml-indent-default (&optional noindent)
 583   (let* ((sym-after (save-excursion (sml-forward-sym)))
 584          (_ (sml-backward-spaces))
 585          (sym-before (sml-backward-sym))
 586          (sym-indent (and sym-before (sml-get-sym-indent sym-before))))
 587     (if sym-indent
 588         ;; the previous sym is an indentation introducer: follow the rule
 589         (let ((indent-after (or (cdr (assoc sym-after sml-symbol-indent)) 0)))
 590           (if noindent (current-column) (+ sym-indent indent-after)))
 591       ;; default-default
 592       (let* ((prec-after (sml-op-prec sym-after 'back))
 593              (prec (or (sml-op-prec sym-before 'back) prec-after 100)))
 594         ;; go back until you hit a symbol that has a lower prec than the
 595         ;; "current one", or until you backed over a sym that has the same prec
 596         ;; but is at the beginning of a line.
 597         (while (and (not (sml-bolp))
 598                     (sml-move-if (sml-backward-sexp (1- prec)))
 599                     (not (sml-bolp)))
 600           (while (sml-move-if (sml-backward-sexp prec))))
 601         ;; the `noindent' case does back over an introductory symbol
 602         ;; such as `fun', ...
 603         (when noindent
 604           (sml-move-if
 605            (sml-backward-spaces)
 606            (string-match sml-starters-re (or (sml-backward-sym) ""))))
 607         (current-column)))))
 608
 609
 610 (defun sml-bolp ()
 611   (save-excursion
 612     (skip-chars-backward " \t|") (bolp)))
 613
 614
 615 ;; maybe `|' should be set to word-syntax in our temp syntax table ?
 616 (defun sml-current-indentation ()
 617   (save-excursion
 618     (beginning-of-line)
 619     (skip-chars-forward " \t|")
 620     (current-column)))
 621
 622
 623 (defun sml-find-matching-starter (regexp &optional prec)
 624   (ignore-errors
 625     (sml-backward-sexp prec)
 626     (while (not (or (looking-at regexp) (bobp)))
 627       (sml-backward-sexp prec))
 628     (not (bobp))))
 629
 630 (defun sml-comment-indent ()
 631   (if (looking-at "^(\\*")              ; Existing comment at beginning
 632       0                                 ; of line stays there.
 633     (save-excursion
 634       (skip-chars-backward " \t")
 635       (max (1+ (current-column))        ; Else indent at comment column
 636            comment-column))))           ; except leave at least one space.
 637
 638 ;;; INSERTING PROFORMAS (COMMON SML-FORMS)
 639
 640 (defvar sml-forms-alist nil
 641   "*The alist of templates to auto-insert.
 642
 643 You can extend this alist to your heart's content. For each additional
 644 template NAME in the list, declare a keyboard macro or function (or
 645 interactive command) called 'sml-form-NAME'.
 646
 647 If 'sml-form-NAME' is a function it takes no arguments and should
 648 insert the template at point\; if this is a command it may accept any
 649 sensible interactive call arguments\; keyboard macros can't take
 650 arguments at all. Apropos keyboard macros, see `name-last-kbd-macro'
 651 and `sml-addto-forms-alist'.
 652
 653 `sml-forms-alist' understands let, local, case, abstype, datatype,
 654 signature, structure, and functor by default.")
 655
 656 (defmacro sml-def-skeleton (name interactor &rest elements)
 657   (let ((fsym (intern (concat "sml-form-" name))))
 658     `(progn
 659        (add-to-list 'sml-forms-alist ',(cons name fsym))
 660        (define-skeleton ,fsym
 661          ,(format "SML-mode skeleton for `%s..' expressions" name)
 662          ,interactor
 663          ,(concat name " ") >
 664          ,@elements))))
 665 (put 'sml-def-skeleton 'lisp-indent-function 2)
 666
 667 (sml-def-skeleton "let" nil
 668   _ "\nin" > "\nend" >)
 669
 670 (sml-def-skeleton "if" nil
 671   _ " then " > "\nelse " >)
 672
 673 (sml-def-skeleton "local" nil
 674   _ "\nin" > "\nend" >)
 675
 676 (sml-def-skeleton "case" "Case expr: "
 677   str "\nof " > _ " => ")
 678
 679 (sml-def-skeleton "signature" "Signature name: "
 680   str " =\nsig" > "\n" > _ "\nend" >)
 681
 682 (sml-def-skeleton "structure" "Structure name: "
 683   str " =\nstruct" > "\n" > _ "\nend" >)
 684
 685 (sml-def-skeleton "functor" "Functor name: "
 686   str " () : =\nstruct" > "\n" > _ "\nend" >)
 687
 688 (sml-def-skeleton "datatype" "Datatype name and type parameters: "
 689   str " =" \n)
 690
 691 (sml-def-skeleton "abstype" "Abstype name and type parameters: "
 692   str " =" \n _ "\nwith" > "\nend" >)
 693
 694 ;;
 695
 696 (defun sml-forms-menu (menu)
 697   (easy-menu-filter-return
 698    (easy-menu-create-menu "Forms"
 699          (mapcar (lambda (x)
 700                    (let ((name (car x))
 701                          (fsym (cdr x)))
 702                      (vector name fsym t)))
 703                  sml-forms-alist))))
 704
 705 (defvar sml-last-form "let")
 706
 707 (defun sml-electric-space ()
 708   "Expand a symbol into an SML form, or just insert a space.
 709 If the point directly precedes a symbol for which an SML form exists,
 710 the corresponding form is inserted."
 711   (interactive)
 712   (let* ((point (point))
 713          (sym (sml-backward-sym)))
 714     (if (not (and sym (assoc sym sml-forms-alist)))
 715         (progn (goto-char point) (insert " "))
 716       (delete-region (point) point)
 717       (sml-insert-form sym nil))))
 718
 719 (defun sml-insert-form (name newline)
 720   "Interactive short-cut to insert a common ML form.
 721 If a perfix argument is given insert a newline and indent first, or
 722 just move to the proper indentation if the line is blank\; otherwise
 723 insert at point (which forces indentation to current column).
 724
 725 The default form to insert is 'whatever you inserted last time'
 726 \(just hit return when prompted\)\; otherwise the command reads with
 727 completion from `sml-forms-alist'."
 728   (interactive
 729    (list (completing-read
 730           (format "Form to insert: (default %s) " sml-last-form)
 731           sml-forms-alist nil t nil)
 732          current-prefix-arg))
 733   ;; default is whatever the last insert was...
 734   (if (string= name "") (setq name sml-last-form) (setq sml-last-form name))
 735   (unless (or (not newline)
 736               (save-excursion (beginning-of-line) (looking-at "\\s-*$")))
 737     (insert "\n"))
 738   (unless (/= ?w (char-syntax (char-before))) (insert " "))
 739   (let ((f (cdr (assoc name sml-forms-alist))))
 740     (cond
 741      ((commandp f) (command-execute f))
 742      (f (funcall f))
 743      (t (error "Undefined form: %s" name)))))
 744
 745 ;; See also macros.el in emacs lisp dir.
 746
 747 (defun sml-addto-forms-alist (name)
 748   "Assign a name to the last keyboard macro defined.
 749 Argument NAME is transmogrified to sml-form-NAME which is the symbol
 750 actually defined.
 751
 752 The symbol's function definition becomes the keyboard macro string.
 753
 754 If that works, NAME is added to `sml-forms-alist' so you'll be able to
 755 reinvoke the macro through \\[sml-insert-form]. You might want to save
 756 the macro to use in a later editing session -- see `insert-kbd-macro'
 757 and add these macros to your .emacs file.
 758
 759 See also `edit-kbd-macro' which is bound to \\[edit-kbd-macro]."
 760   (interactive "sName for last kbd macro (\"sml-form-\" will be added): ")
 761   (when (string= name "") (error "No command name given"))
 762   (let ((fsym (intern (concat "sml-form-" name))))
 763     (name-last-kbd-macro fsym)
 764     (message "Macro bound to %s" fsym)
 765     (add-to-list 'sml-forms-alist (cons name fsym))))
 766
 767 ;; at a pinch these could be added to SML/Forms menu through the good
 768 ;; offices of activate-menubar-hook or something... but documentation
 769 ;; of this and/or menu-bar-update-hook is sparse in 19.33. anyway, use
 770 ;; completing read for sml-insert-form prompt...
 771
 772 ;;; & do the user's customisation
 773 (run-hooks 'sml-load-hook)
 774
 775 ;;; sml-mode.el has just finished.
 776 (provide 'sml-mode)