--- /dev/null
+SML-MODE (3.3b) -- Major Emacs mode for editing Standard ML.
+
+ 3.3(beta) because i really am looking at the indentation algorithm,
+ but the new features mentioned below are stable -- modulo bugs.
+
+Files:
+
+ sml-mode.el (SML mode elisp code)
+ sml-proc.el (ML interaction code, defaults to SML/NJ(0.93))
+ sml-hilite.el (hilit19 functions)
+ sml-font.el (font-lock functions)
+ sml-menus.el (Simple menus)
+
+ sml-poly-ml.el (Additional library code to run Poly/ML)
+ sml-mosml.el (Additional library code to run Moscow ML)
+
+ sml-mode.info (Softcopy manual -- Info for (X)Emacs19)
+ sml-site.el (Simple, system-wide installation)
+
+Extras:
+
+ sml-mode.dvi (Hardcopy manual)
+
+Warning:
+
+ Tried and sort of tested on GNU Emacs 19.3{3,4} and XEmacs 19.14.
+
+ XEmacs 19.11 is known to hang on sending regions to the interaction
+ buffer -- so leave the variable SML-TEMP-THRESHOLD = 0.
+
+System Installation Guide:
+
+ If you're installing this for others in the Emacs hierarchy, either
+
+ go to the site-lisp directory and unpack the tar file there,
+
+ or create a subdirectory, say site-lisp/sml-mode, and copy at
+ least the sml*.el files into it.
+
+ In either case move or copy the file sml-site.el into the site-lisp
+ directory itself (or some other place that's on the user's default
+ load-path) and read and edit this file. All that's really needed is
+ to ensure that Emacs can find the sml*.el files and the .info file.
+
+ Tell your eager users to
+
+ (requite 'sml-site)
+
+ in their .emacses. Point them to the help file. At your option, byte
+ compile the sml*.el files (and sml-site.el too, if you like).
+
+Private Installation Guide:
+
+ If you are having to install his in your home directory, say, create
+ a directory like "/home/xxx/lib/emacs/sml-mode", if your login name
+ is xxx, and copy the sml-*.el files to there. Then put:
+
+ (setq load-path (cons "/home/xxx/lib/emacs/sml-mode" load-path))
+ (autoload 'sml-mode "sml-mode" "Major mode for editing ML programs." t)
+
+ in your .emacs file. Add:
+
+ (setq auto-mode-alist
+ (append '(("\\.sml$" . sml-mode)
+ ("\\.sig$" . sml-mode)
+ ("\\.ML$" . sml-mode)) auto-mode-alist))
+
+ to your .emacs so that whenever you visit a file with one of these
+ extensions you will automatically be placed in sml-mode.
+
+ Put the info file (sml-mode.info) somewhere convenient like
+ "/home/xxx/lib/emacs/sml-mode/sml-mode.info", and add
+
+ (setq sml-mode-info "/home/xxx/lib/emacs/sml-mode/sml-mode.info")
+
+ again to your .emacs -- this gives access to on-line help. This help
+ file gives lots of tips about configuring SML mode to suit your
+ preferences: C-c C-i will get you there from SML mode.
+
+ If you want SML mode to speak to Moscow ML or Poly/ML instead of
+ SML/NJ, just add something like this to your .emacs:
+
+ (defun my-mosml-setup () "Configure inferior SML mode for Moscow ML"
+ (load-library "sml-mosml"))
+ (add-hook 'inferior-sml-load-hook 'my-mosml-setup)
+
+ so that when you M-x sml you'll get mosml instead.
+
+New in SML mode Version 3.3 (feedback welcomed on this):
+
+ 1
+
+ implemented some multi-frame handling capabilities, specifically so
+ sml runs in a dedicated window. this is more complex than it needs to
+ be because of XEmacs...
+
+ the variable SML-DEDICATED-FRAME defaults to t if running under a
+ window system; set it to nil in SML-LOAD-HOOK if you want the old
+ split window behaviour back.
+
+ 2
+
+ debugged SML-NEXT-ERROR a bit, and improved it to echo the error
+ message in the minibuffer (if possible) and highlight the region in
+ which the error was found (if a suitable character range was given).
+
+ the variable SML-ERROR-OVERLAY controls whether or not to highlight
+ (default is yes); set this to nil in SML-MODE-HOOK to switch this
+ off.
+
+ SML-NEXT-ERROR won't always raise the inferior ML buffer's frame; it
+ only does so if there's no window already showing the buffer, or if
+ there's an error message it can't understand. i think!
+
+ 3
+
+ support for Moscow ML -- see sml-mosml.el.
+
+ 4
+
+ forms (aka, templates or macros) insertion semantics have changed
+ because there were bugs. maybe there still are, but anyway: by
+ default C-c C-m inserts the macro at point, C-u C-c C-m will do a
+ newline-and-indent before inserting the macro.
+
+ abstractions are history, and you can play with extending the
+ collection of builtin macros to your heart's content. lookup the
+ function SML-ADDTO-FORMS-ALIST, and the variable SML-FORMS-ALIST.
+
+ 5
+
+ drag-and-droppishness, without the drop: SML-DRAG-MOUSE is bound to
+ M-S-down-mouse-1; if you drag the mouse over a region it will be
+ magically sucked into the ML buffer (like C-c C-r, only you don't
+ have to C-@ first). this might be flakey as it heavily depends on
+ the underlying mouse-drag/track-mouse semantics of the various
+ Emacses out there. can't do much about that, sorry.
+
+ 6
+
+ anything else i've forgotten already!
+
+To Do:
+
+ 0
+
+ indentation is hopeless for sequential code (semicolons). this needs
+ attention; indeed all the indentation code does. Ian Zimmerman's very
+ excellent (looking) indentation code for caml-mode may point the way
+ forward. or we all go over to programming in Lisp instead of ML...
+
+Matthew Morley <mjm@scs.leeds.ac.uk>
+05/97
--- /dev/null
+;;; sml-font.el --- Highlighting for sml-mode using font-lock.
+;;
+;; Copyright (C) 1995 Frederick Knabe
+;;
+;; Author: Fritz Knabe <knabe@ecrc.de>
+;; ECRC GmbH, Arabellastr. 17, 81925 Munich, Germany
+;; Created: 26 June 1995
+;; Modified: 14 April 1997, M.J.Morley <mjm@scs.leeds.ac.uk>
+;; Add a couple of keywords to s-f-l-standard-keywords.
+;;
+;; $Revision: 1.6 $
+;; $Date: 1997/04/29 19:55:40 $
+;;
+;; ====================================================================
+;; This program is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation; either version 2 of the License, or
+;; (at your option) any later version.
+;;
+;; This program is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+;;
+;; If you did not receive a copy of the GNU General Public License with
+;; this program, write to the Free Software Foundation, Inc., 675 Mass
+;; Ave, Cambridge, MA 02139, USA.
+;; ====================================================================
+;;
+;;; DESCRIPTION
+;;
+;; This package sets up highlighting of SML using font-lock. If you
+;; use the new version of font-lock distributed in GNU Emacs, SML's
+;; nested comments as well as its special string escapes will be
+;; handled properly. The version of font-lock distributed with XEmacs
+;; can also be used, but these special cases will not be handled.
+;;
+;; Should the fontification become incorrect while editing (for
+;; example, when uncommenting), M-x font-lock-fontify-buffer will clear
+;; things up.
+;;
+;; To install (assuming that you use sml-mode 3.1), put the following
+;; in your .emacs:
+;;
+;; (setq sml-hilite nil) ; Turn off highlighting based on hilit19
+;;
+;; ;; For GNU Emacs
+;; (eval-after-load "sml-mode" '(require 'sml-font))
+;;
+;; ;; For XEmacs
+;; (require 'sml-font)
+;;
+;;
+;; Versions 3.2 and later of sml-mode define sml-load-hook (and the
+;; variable sml-hilite is spurious), so you can simply put:
+;;
+;; (setq sml-load-hook
+;; '(lambda() "Fontify SML." (require 'sml-font)))
+;;
+;; By default, font-lock will be turned on automatically for every SML
+;; buffer. If you don't want this, also add the following:
+;;
+;; (setq sml-font-lock-auto-on nil)
+;;
+;; If you want to add to the keywords that will be fontified, set the
+;; variable sml-font-lock-extra-keywords (see its documentation).
+;;
+;; Thanks to Matthew Morley <morley@gmd.de> for suggestions and fixes.
+;;
+
+(require 'font-lock)
+
+(defvar sml-font-lock-auto-on t
+ "*If non-nil, turn on font-lock unconditionally for every SML buffer.")
+
+(defvar sml-font-lock-extra-keywords nil
+ ;; The example is easier to read if you load this package and use C-h v
+ ;; to view the documentation.
+ "*List of regexps to fontify as additional SML keywords.
+
+For example, to add `xfun', `xfn', `special', and `=>', the value could be
+
+ (\"\\=\\=\\=\\\\=\\=\\=\\<xfu?n\\\\|special\\\\>\" \"=>\")
+
+The word delimiters in the first pattern prevent spurious highlighting
+of keywords embedded inside other words (e.g., we don't want the tail of
+`myxfun' to be highlighted). You cannot use word delimiters with
+symbolic patterns, however, because only alphanumerics are defined as
+Emacs word constituents. The second pattern would match the tail of a
+symbolic identifier such as `==>', which might not be what you want.")
+
+(defvar sml-font-lock-standard-keywords
+ ;; Generated with Simon Marshall's make-regexp:
+ ;; (make-regexp
+ ;; '("abstype" "and" "andalso" "as" "case" "datatype"
+ ;; "else" "end" "eqtype" "exception" "do" "fn" "fun" "functor"
+ ;; "handle" "if" "in" "include" "infix" "infixr" "let" "local" "nonfix"
+ ;; "of" "op" "open" "orelse" "overload" "raise" "rec" "sharing" "sig"
+ ;; "signature" "struct" "structure" "then" "type" "val" "where" "while"
+ ;; "with" "withtype") t)
+
+ "\\<\\(a\\(bstype\\|nd\\(\\|also\\)\\|s\\)\\|case\\|d\\(atatype\\|o\\)\\|\
+e\\(lse\\|nd\\|qtype\\|xception\\)\\|f\\(n\\|un\\(\\|ctor\\)\\)\\|\handle\\|\
+i\\([fn]\\|n\\(clude\\|fixr?\\)\\)\\|l\\(et\\|ocal\\)\\|nonfix\\|\
+o\\([fp]\\|pen\\|relse\\|verload\\)\\|r\\(aise\\|ec\\)\\|\
+s\\(haring\\|ig\\(\\|nature\\)\\|truct\\(\\|ure\\)\\)\\|t\\(hen\\|ype\\)\\|\
+val\\|w\\(h\\(ere\\|ile\\)\\|ith\\(\\|type\\)\\)\\)\\>"
+
+ "Regexp matching standard SML keywords.")
+
+(defvar sml-font-lock-all nil
+ "Font-lock matchers for SML.")
+
+(defun sml-font-lock-setup ()
+ "Set buffer-local font-lock variables and possibly turn on font-lock."
+ (let ((new-font-lock (boundp 'font-lock-defaults)))
+ ;; If new-font-lock is t, use sml-font-comments-and-strings to do
+ ;; fontification of comments and strings. Otherwise, do
+ ;; fontification using the SML syntax table (which will not always
+ ;; be correct).
+ (or sml-font-lock-all
+ (setq sml-font-lock-all
+ (append
+ (and new-font-lock (list (list 'sml-font-comments-and-strings)))
+ sml-font-lock-extra-keywords
+ (list (list sml-font-lock-standard-keywords 1
+ 'font-lock-keyword-face)))))
+ (cond (new-font-lock
+ (make-local-variable 'font-lock-defaults)
+ (setq font-lock-defaults '(sml-font-lock-all t)))
+ (t
+ (setq font-lock-keywords sml-font-lock-all))))
+ (and sml-font-lock-auto-on (turn-on-font-lock)))
+
+(add-hook 'sml-mode-hook 'sml-font-lock-setup)
+
+(defvar sml-font-cache '((0 . normal))
+ "List of (POSITION . STATE) pairs for an SML buffer.
+The STATE is either `normal', `comment', or `string'. The POSITION is
+immediately after the token that caused the state change.")
+
+(make-variable-buffer-local 'sml-font-cache)
+
+(defun sml-font-comments-and-strings (limit)
+ "Fontify SML comments and strings up to LIMIT.
+Handles nested comments and SML's escapes for breaking a string over lines.
+Uses sml-font-cache to maintain the fontification state over the buffer."
+ (let ((beg (point))
+ last class)
+ (while (< beg limit)
+ (while (and sml-font-cache
+ (> (car (car sml-font-cache)) beg))
+ (setq sml-font-cache (cdr sml-font-cache)))
+ (setq last (car (car sml-font-cache)))
+ (setq class (cdr (car sml-font-cache)))
+ (goto-char last)
+ (cond
+ ((eq class 'normal)
+ (cond
+ ((not (re-search-forward "\\((\\*\\)\\|\\(\"\\)" limit t))
+ (goto-char limit))
+ ((match-beginning 1)
+ (setq sml-font-cache (cons (cons (point) 'comment) sml-font-cache)))
+ ((match-beginning 2)
+ (setq sml-font-cache (cons (cons (point) 'string) sml-font-cache)))))
+ ((eq class 'comment)
+ (cond
+ ((let ((nest 1))
+ (while (and (> nest 0)
+ (re-search-forward "\\((\\*\\)\\|\\(\\*)\\)" limit t))
+ (cond
+ ((match-beginning 1) (setq nest (+ nest 1)))
+ ((match-beginning 2) (setq nest (- nest 1)))))
+ (> nest 0))
+ (goto-char limit))
+ (t
+ (setq sml-font-cache (cons (cons (point) 'normal) sml-font-cache))))
+ (put-text-property (- last 2) (point) 'face 'font-lock-comment-face))
+ ((eq class 'string)
+ (while (and (re-search-forward
+ "\\(\"\\)\\|\\(\\\\\\s-*\\\\\\)\\|\\(\\\\\"\\)" limit t)
+ (not (match-beginning 1))))
+ (cond
+ ((match-beginning 1)
+ (setq sml-font-cache (cons (cons (point) 'normal) sml-font-cache)))
+ (t
+ (goto-char limit)))
+ (put-text-property (- last 1) (point) 'face 'font-lock-string-face)))
+ (setq beg (point)))))
+
+(provide 'sml-font)
--- /dev/null
+;;; sml-hilite.el. Highlighting for sml-mode using hilit19.
+
+;; Copyright (C) 1995 Frederick Knabe
+;;
+;; Author: Fritz Knabe <knabe@ecrc.de>
+;; ECRC GmbH, Arabellastr. 17, 81925 Munich, Germany
+;;
+;; Created: 08-Nov-94, Fritz Knabe <knabe@ecrc.de>
+;; Modified: 14-Apr-97, M.J.Morley <mjm@scs.leeds.ac.uk>
+;; Added a few keywords to hilit-set-mode-patters.
+
+;; This file is not part of GNU Emacs, but it is distributed under the
+;; same conditions.
+
+;; ====================================================================
+
+;; This program is free software; you can redistribute it and/or
+;; modify it under the terms of the GNU General Public License as
+;; published by the Free Software Foundation; either version 2, or (at
+;; your option) any later version.
+
+;; This program is distributed in the hope that it will be useful, but
+;; WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+;; General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs; see the file COPYING. If not, write to the
+;; Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
+
+;; ====================================================================
+
+;; Put this code *after* the (require 'hilit19) in your .emacs.
+;; Alternatively, put it in an (eval-after-load "hilit19" ...).
+
+;; Better, use sml-load-hook like this:
+
+;; (setq sml-load-hook
+;; '(lambda() "Highlights." (require 'sml-hilite)))
+
+;; hilit19 does not currently appear to belong to XEmacs -- they
+;; favour `font-lock'. Font-lock patterns in sml-font.el
+
+;;; CODE
+
+(require 'hilit19)
+
+(cond ((and (x-display-color-p) (eq hilit-background-mode 'light))
+ ;; for SML
+ (hilit-translate sml-comment 'firebrick-italic)
+ (hilit-translate sml-string 'ForestGreen-italic)
+ (hilit-translate sml-keyword 'blue-bold))
+ ((and (x-display-color-p) (eq hilit-background-mode 'dark))
+ ;; for SML
+ (hilit-translate sml-comment 'moccasin-italic)
+ (hilit-translate sml-string 'green-italic)
+ (hilit-translate sml-keyword 'cyan-bold))
+ (t
+ ;; for SML
+ (hilit-translate sml-comment 'default-italic)
+ (hilit-translate sml-string 'default-bold-italic)
+ (hilit-translate sml-keyword 'default-bold)))
+
+(hilit-set-mode-patterns
+ 'sml-mode
+ '((kn-hilit-sml-string-find "" sml-string)
+ (kn-hilit-sml-comment-find "" sml-comment)
+ ;; The old patterns
+ ;;("\"" "[^\\]\"" sml-string)
+ ;;("(\\*" "\\*)" sml-comment)
+ ("\\(\\`\\|[^_']\\)\
+\\<\\(\
+a\\(bstype\\|nd\\(\\|also\\)\\|s\\)\\|case\\|d\\(atatype\\|o\\)\\|\
+e\\(lse\\|nd\\|qtype\\|xception\\)\\|f\\(n\\|un\\(\\|ctor\\)\\)\\|\handle\\|\
+i\\([fn]\\|n\\(clude\\|fixr?\\)\\)\\|l\\(et\\|ocal\\)\\|nonfix\\|\
+o\\([fp]\\|pen\\|relse\\|verload\\)\\|r\\(aise\\|ec\\)\\|\
+s\\(haring\\|ig\\(\\|nature\\)\\|truct\\(\\|ure\\)\\)\\|t\\(hen\\|ype\\)\\|\
+val\\|w\\(h\\(ere\\|ile\\)\\|ith\\(\\|type\\)\\)
+\\)\\>\
+\\(\\'\\|[^_']\\)" 2 sml-keyword)))
+
+(defun kn-hilit-sml-string-find (dummy)
+ "Find an SML string and return (START . END); if none, returns nil.
+Skips over potentially nested comments when searching for the start of the
+string. Skips over \f...f\ (where f is whitespace) sequences in strings."
+ (let ((nest 0)
+ (continue t)
+ st en)
+ (while (and continue
+ (re-search-forward "\\(\"\\)\\|\\((\\*\\)\\|\\(\\*)\\)" nil t))
+ (cond
+ ((match-beginning 1) (setq continue (> nest 0)))
+ ((match-beginning 2) (setq nest (+ nest 1)))
+ ((match-beginning 3) (setq nest (- nest 1)))))
+ (if (not continue)
+ (progn
+ (setq st (match-beginning 1))
+ (while (and (re-search-forward
+ "\\(\"\\)\\|\\(\\\\\\s-*\\\\\\)\\|\\(\\\\\"\\)" nil t)
+ (cond
+ ((match-beginning 1) (setq en (point)) nil)
+ ((match-beginning 2) t)
+ ((match-beginning 3) t))))
+ (and en (cons st en))))))
+
+(defun kn-hilit-sml-comment-find (dummy)
+ "Find an SML comment and return (START . END); if none, returns nil.
+Handles nested comments. Ensures that the comment starts outside of a string."
+ (let ((continue t)
+ (nest 1)
+ st en)
+ (while (and continue
+ (re-search-forward "\\(\"\\)\\|\\((\\*\\)" nil t))
+ (cond
+ ((match-beginning 1)
+ (while (and (re-search-forward
+ "\\(\"\\)\\|\\(\\\\\\s-*\\\\\\)\\|\\(\\\\\"\\)" nil t)
+ (cond
+ ((match-beginning 1) nil)
+ ((match-beginning 2) t)
+ ((match-beginning 3) t)))))
+ ((match-beginning 2) (setq continue nil))))
+ (if (not continue)
+ (progn
+ (setq st (match-beginning 2))
+ (setq continue t)
+ (while (and continue
+ (re-search-forward "\\((\\*\\)\\|\\(\\*)\\)" nil t))
+ (cond
+ ((match-beginning 1) (setq nest (+ nest 1)))
+ ((match-beginning 2)
+ (setq nest (- nest 1)) (setq continue (> nest 0)))))
+ (if (not continue)
+ (cons st (match-end 2)))))))
+
+(provide 'sml-hilite)
+
+;;; no more sml-hilite.el, it's finished.
--- /dev/null
+;;; sml-menus.el. Simple menus for sml-mode
+
+;; Copyright (C) 1994, Matthew J. Morley
+
+;; This file is not part of GNU Emacs, but it is distributed under the
+;; same conditions.
+
+;; ====================================================================
+
+;; This program is free software; you can redistribute it and/or
+;; modify it under the terms of the GNU General Public License as
+;; published by the Free Software Foundation; either version 2, or (at
+;; your option) any later version.
+
+;; This program is distributed in the hope that it will be useful, but
+;; WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+;; General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs; see the file COPYING. If not, write to the
+;; Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
+
+;; ====================================================================
+
+;;; DESCRIPTION
+
+;; You need auc-menu or easymenu on your lisp load-path.
+
+;; Menus appear only when the cursor is in an sml-mode buffer. They
+;; should appear automatically as long as sml-mode can find this file
+;; and easymenu.el (or auc-menu.el), but not otherwise.
+
+;; If you load sml-proc.el to run an inferior ML process -- or even a
+;; superior one, who knows? -- the "Process" submenu will become active.
+
+;;; CODE
+
+(condition-case () (require 'easymenu) (error (require 'auc-menu)))
+
+;; That's FSF easymenu, distributed with GNU Emacs 19, or Per
+;; Abrahamsen's auc-menu distributed with AUCTeX, or from the Emacs
+;; lisp archive, or the IESD (ftp://sunsite.auc.dk/packages/auctex/)
+;; lisp archive at Aalborg (auc-menu works with XEmacs too).
+
+(defconst sml-menu
+ (list ;"SML"
+ (list "Process"
+ ["Start default ML compiler" sml
+ :active (fboundp 'sml)]
+ ["-" nil nil]
+ ["load ML source file" sml-load-file
+ :active (featurep 'sml-proc)]
+ ["switch to ML buffer" switch-to-sml
+ :active (featurep 'sml-proc)]
+ ["--" nil nil]
+ ["send buffer contents" sml-send-buffer
+ :active (featurep 'sml-proc)]
+ ["send region" sml-send-region
+ :active (featurep 'sml-proc)]
+ ["send paragraph" sml-send-function
+ :active (featurep 'sml-proc)]
+ ["goto next error" sml-next-error
+ :active (featurep 'sml-proc)]
+ ["---" nil nil]
+ ["Standard ML of New Jersey" sml-smlnj
+ :active (fboundp 'sml-smlnj)]
+ ["Poly/ML" sml-poly-ml
+ :active (fboundp 'sml-poly-ml)]
+ ["Moscow ML" sml-mosml
+ :active (fboundp 'sml-mosml)]
+ ["Help for Inferior ML" (describe-function 'inferior-sml-mode)
+ :active (featurep 'sml-proc)]
+ )
+ ["electric pipe" sml-electric-pipe t]
+ ["insert SML form" sml-insert-form t]
+ (list "Forms"
+ ["abstype" sml-form-abstype t]
+ ["datatype" sml-form-datatype t]
+ ["-" nil nil]
+ ["let" sml-form-let t]
+ ["local" sml-form-local t]
+ ["case" sml-form-case t]
+ ["--" nil nil]
+ ["signature" sml-form-signature t]
+ ["functor" sml-form-functor t]
+ ["structure" sml-form-structure t])
+ (list "Format/Mode Variables"
+ ["indent region" sml-indent-region t]
+ ["outdent" sml-back-to-outer-indent t]
+ ["-" nil nil]
+ ["set indent-level" sml-indent-level t]
+ ["set pipe-indent" sml-pipe-indent t]
+ ["--" nil nil]
+ ["toggle type-of-indent" (sml-type-of-indent) t]
+ ["toggle nested-if-indent" (sml-nested-if-indent) t]
+ ["toggle case-indent" (sml-case-indent) t]
+ ["toggle electric-semi-mode" (sml-electric-semi-mode) t])
+ ["-----" nil nil]
+ ["SML mode help (brief)" describe-mode t]
+ ["SML mode *info*" sml-mode-info t]
+ ["SML mode version" sml-mode-version t]
+ ["-----" nil nil]
+ ["Fontify buffer" (sml-mode-fontify-buffer)
+ :active (or (featurep 'sml-font) (featurep 'sml-hilite))]
+ ["Remove overlay" (sml-error-overlay 'undo)
+ :active (sml-overlay-active-p)]
+ ))
+
+(defun sml-mode-fontify-buffer ()
+ "Just as it suggests."
+ (cond ((featurep 'sml-font)
+ (font-lock-fontify-buffer))
+ ((featurep 'sml-hilite)
+ (hilit-rehighlight-buffer))
+ (t
+ (message "No highlight scheme specified")))) ; belt & braces
+
+(easy-menu-define sml-mode-menu
+ sml-mode-map
+ "Menu used in sml-mode."
+ (cons "SML" sml-menu))
+
+;;; Make's sure they appear in the menu bar when sml-mode-map is active.
+
+;; On the hook for XEmacs only -- see easy-menu-add in auc-menu.el.
+
+(defun sml-mode-menu-bar ()
+ "Make sure menus appear in the menu bar as well as under mouse 3."
+ (and (eq major-mode 'sml-mode)
+ (easy-menu-add sml-mode-menu sml-mode-map)))
+
+(add-hook 'sml-mode-hook 'sml-mode-menu-bar)
+
+;; Autoload all the process code if these are selected.
+
+(autoload 'sml "sml-proc" sml-no-doc t)
+
+;; Not these two.
+;; (autoload 'sml-poly-ml "sml-poly-ml" sml-no-doc t)
+;; (autoload 'sml-mosml "sml-mosml" sml-no-doc t)
+
+(provide 'sml-menus)
+
+;;; sml-menu.el is over now.
--- /dev/null
+;;; sml-mode.el. Major mode for editing (Standard) ML. Version 3.3(beta)
+
+;; Copyright (C) 1989, Lars Bo Nielsen; 1994,1997, Matthew J. Morley
+
+;; $Revision$
+;; $Date$
+
+;; This file is not part of GNU Emacs, but it is distributed under the
+;; same conditions.
+
+;; ====================================================================
+
+;; This program is free software; you can redistribute it and/or
+;; modify it under the terms of the GNU General Public License as
+;; published by the Free Software Foundation; either version 2, or (at
+;; your option) any later version.
+
+;; This program is distributed in the hope that it will be useful, but
+;; WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+;; General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs; see the file COPYING. If not, write to the
+;; Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
+
+;; ====================================================================
+
+;;; HISTORY
+
+;; Still under construction: History obscure, needs a biographer as
+;; well as a M-x doctor. Change Log on request.
+
+;; Hacked by Olin Shivers for comint from Lars Bo Nielsen's sml.el.
+
+;; Hacked by Matthew Morley to incorporate Fritz Knabe's hilite and
+;; font-lock patterns, some of Steven Gilmore's (reduced) easy-menus,
+;; and numerous bugs and bug-fixes.
+
+;;; DESCRIPTION
+
+;; See accompanying info file: sml-mode.info
+
+;;; FOR YOUR .EMACS FILE
+
+;; If sml-mode.el lives in some non-standard directory, you must tell
+;; emacs where to get it. This may or may not be necessary:
+
+;; (setq load-path (cons (expand-file-name "~jones/lib/emacs") load-path))
+
+;; Then to access the commands autoload sml-mode with that command:
+
+;; (autoload 'sml-mode "sml-mode" "Major mode for editing ML programs." t)
+;;
+;; If files ending in ".sml" or ".ML" are hereafter considered to contain
+;; Standard ML source, put their buffers into sml-mode automatically:
+
+;; (setq auto-mode-alist
+;; (cons '(("\\.sml$" . sml-mode)
+;; ("\\.ML$" . sml-mode)) auto-mode-alist))
+
+;; Here's an example of setting things up in the sml-mode-hook:
+
+;; (setq sml-mode-hook
+;; '(lambda() "ML mode hacks"
+;; (setq sml-indent-level 2 ; conserve on horiz. space
+;; indent-tabs-mode nil))) ; whatever
+
+;; sml-mode-hook is run whenever a new sml-mode buffer is created.
+;; There is an sml-load-hook too, which is only run when this file is
+;; loaded. One use for this hook is to select your preferred
+;; highlighting scheme, like this:
+
+;; (setq sml-load-hook
+;; '(lambda() "Highlights." (require 'sml-hilite)))
+
+;; hilit19 is the magic that actually does the highlighting. My set up
+;; for hilit19 runs something like this:
+
+;; (if window-system
+;; (setq hilit-background-mode t ; monochrome (alt: 'dark or 'light)
+;; hilit-inhibit-hooks nil
+;; hilit-inhibit-rebinding nil
+;; hilit-quietly t))
+
+;; Alternatively, you can (require 'sml-font) which uses the font-lock
+;; package instead.
+
+;; Finally, there are inferior-sml-{mode,load}-hooks -- see comments
+;; in sml-proc.el. For much more information consult the mode's *info*
+;; tree.
+
+;;; VERSION STRING
+
+(defconst sml-mode-version-string
+ "sml-mode, version 3.3(beta)")
+
+(provide 'sml-mode)
+
+;;; VARIABLES CONTROLLING INDENTATION
+
+(defvar sml-indent-level 4
+ "*Indentation of blocks in ML (see also `sml-structure-indent').")
+
+(defvar sml-structure-indent 4 ; Not currently an option.
+ "Indentation of signature/structure/functor declarations.")
+
+(defvar sml-pipe-indent -2
+ "*Extra (usually negative) indentation for lines beginning with |.")
+
+(defvar sml-case-indent nil
+ "*How to indent case-of expressions.
+ If t: case expr If nil: case expr of
+ of exp1 => ... exp1 => ...
+ | exp2 => ... | exp2 => ...
+
+The first seems to be the standard in SML/NJ, but the second
+seems nicer...")
+
+(defvar sml-nested-if-indent nil
+ "*Determine how nested if-then-else will be formatted:
+ If t: if exp1 then exp2 If nil: if exp1 then exp2
+ else if exp3 then exp4 else if exp3 then exp4
+ else if exp5 then exp6 else if exp5 then exp6
+ else exp7 else exp7")
+
+(defvar sml-type-of-indent t
+ "*How to indent `let' `struct' etc.
+ If t: fun foo bar = let If nil: fun foo bar = let
+ val p = 4 val p = 4
+ in in
+ bar + p bar + p
+ end end
+
+Will not have any effect if the starting keyword is first on the line.")
+
+(defvar sml-electric-semi-mode nil
+ "*If t, `\;' will self insert, reindent the line, and do a newline.
+If nil, just insert a `\;'. (To insert while t, do: C-q \;).")
+
+(defvar sml-paren-lookback 1000
+ "*How far back (in chars) the indentation algorithm should look
+for open parenthesis. High value means slow indentation algorithm. A
+value of 1000 (being the equivalent of 20-30 lines) should suffice
+most uses. (A value of nil, means do not look at all)")
+
+;;; OTHER GENERIC MODE VARIABLES
+
+(defvar sml-mode-info "sml-mode"
+ "*Where to find Info file for sml-mode.
+The default assumes the info file \"sml-mode.info\" is on Emacs' info
+directory path. If it is not, either put the file on the standard path
+or set the variable sml-mode-info to the exact location of this file
+which is part of the sml-mode 3.2 (and later) distribution. E.g:
+
+ (setq sml-mode-info \"/usr/me/lib/info/sml-mode\")
+
+in your .emacs file. You can always set it interactively with the
+set-variable command.")
+
+(defvar sml-mode-hook nil
+ "*This hook is run when sml-mode is loaded, or a new sml-mode buffer created.
+This is a good place to put your preferred key bindings.")
+
+(defvar sml-load-hook nil
+ "*This hook is run when sml-mode (sml-mode.el) is loaded into Emacs.")
+
+(defvar sml-mode-abbrev-table nil "*SML mode abbrev table (default nil)")
+
+(defvar sml-error-overlay t
+ "*Non-nil means use an overlay to highlight errorful code in the buffer.
+
+This gets set when `sml-mode' is invoked\; if you don't like/want SML
+source errors to be highlighted in this way, do something like
+
+ \(setq-default sml-error-overlay nil\)
+
+in your `sml-load-hook', say.")
+
+(make-variable-buffer-local 'sml-error-overlay)
+
+;;; CODE FOR SML-MODE
+
+(defun sml-mode-info ()
+ "Command to access the TeXinfo documentation for sml-mode.
+See doc for the variable sml-mode-info."
+ (interactive)
+ (require 'info)
+ (condition-case nil
+ (funcall 'Info-goto-node (concat "(" sml-mode-info ")"))
+ (error (progn
+ (describe-variable 'sml-mode-info)
+ (message "Can't find it... set this variable first!")))))
+
+(defun sml-indent-level (&optional indent)
+ "Allow the user to change the block indentation level. Numeric prefix
+accepted in lieu of prompting."
+ (interactive "NIndentation level: ")
+ (setq sml-indent-level indent))
+
+(defun sml-pipe-indent (&optional indent)
+ "Allow to change pipe indentation level (usually negative). Numeric prefix
+accepted in lieu of prompting."
+ (interactive "NPipe Indentation level: ")
+ (setq sml-pipe-indent indent))
+
+(defun sml-case-indent (&optional of)
+ "Toggle sml-case-indent. Prefix means set it to nil."
+ (interactive "P")
+ (setq sml-case-indent (and (not of) (not sml-case-indent)))
+ (if sml-case-indent (message "%s" "true") (message "%s" nil)))
+
+(defun sml-nested-if-indent (&optional of)
+ "Toggle sml-nested-if-indent. Prefix means set it to nil."
+ (interactive "P")
+ (setq sml-nested-if-indent (and (not of) (not sml-nested-if-indent)))
+ (if sml-nested-if-indent (message "%s" "true") (message "%s" nil)))
+
+(defun sml-type-of-indent (&optional of)
+ "Toggle sml-type-of-indent. Prefix means set it to nil."
+ (interactive "P")
+ (setq sml-type-of-indent (and (not of) (not sml-type-of-indent)))
+ (if sml-type-of-indent (message "%s" "true") (message "%s" nil)))
+
+(defun sml-electric-semi-mode (&optional of)
+ "Toggle sml-electric-semi-mode. Prefix means set it to nil."
+ (interactive "P")
+ (setq sml-electric-semi-mode (and (not of) (not sml-electric-semi-mode)))
+ (message "%s" (concat "Electric semi mode is "
+ (if sml-electric-semi-mode "on" "off"))))
+
+;;; BINDINGS: these should be common to the source and process modes...
+
+(defun install-sml-keybindings (map)
+ ;; Text-formatting commands:
+ (define-key map "\C-c\C-m" 'sml-insert-form)
+ (define-key map "\C-c\C-i" 'sml-mode-info)
+ (define-key map "\M-|" 'sml-electric-pipe)
+ (define-key map "\;" 'sml-electric-semi)
+ (define-key map "\M-\t" 'sml-back-to-outer-indent)
+ (define-key map "\C-j" 'newline-and-indent)
+ (define-key map "\177" 'backward-delete-char-untabify)
+ (define-key map "\C-\M-\\" 'sml-indent-region)
+ (define-key map "\t" 'sml-indent-line) ; ...except this one
+ ;; Process commands added to sml-mode-map -- these should autoload
+ (define-key map "\C-c\C-l" 'sml-load-file)
+ (define-key map "\C-c`" 'sml-next-error))
+
+;;; Autoload functions -- no-doc is another idea cribbed from AucTeX!
+
+(defvar sml-no-doc
+ "This function is part of sml-proc, and has not yet been loaded.
+Full documentation will be available after autoloading the function."
+ "Documentation for autoloading functions.")
+
+(autoload 'sml "sml-proc" sml-no-doc t)
+(autoload 'sml-load-file "sml-proc" sml-no-doc t)
+
+(autoload 'switch-to-sml "sml-proc" sml-no-doc t)
+(autoload 'sml-send-region "sml-proc" sml-no-doc t)
+(autoload 'sml-send-buffer "sml-proc" sml-no-doc t)
+(autoload 'sml-next-error "sml-proc" sml-no-doc t)
+
+(defvar sml-mode-map nil "The keymap used in sml-mode.")
+(cond ((not sml-mode-map)
+ (setq sml-mode-map (make-sparse-keymap))
+ (install-sml-keybindings sml-mode-map)
+ (define-key sml-mode-map "\C-c\C-s" 'switch-to-sml)
+ (define-key sml-mode-map "\C-c\C-r" 'sml-send-region)
+ (define-key sml-mode-map "\C-c\C-b" 'sml-send-buffer)))
+
+;;; H A C K A T T A C K ! X E M A C S V E R S U S E M A C S
+
+(cond ((fboundp 'make-extent)
+ ;; suppose this is XEmacs
+
+ (defun sml-make-overlay ()
+ "Create a new text overlay (extent) for the SML buffer."
+ (let ((ex (make-extent 1 1)))
+ (set-extent-property ex 'face 'zmacs-region) ex))
+
+ (defalias 'sml-is-overlay 'extentp)
+
+ (defun sml-overlay-active-p ()
+ "Determine whether the current buffer's error overlay is visible."
+ (and (sml-is-overlay sml-error-overlay)
+ (not (zerop (extent-length sml-error-overlay)))))
+
+ (defalias 'sml-move-overlay 'set-extent-endpoints))
+
+ ((fboundp 'make-overlay)
+ ;; otherwise assume it's Emacs
+
+ (defun sml-make-overlay ()
+ "Create a new text overlay (extent) for the SML buffer."
+ (let ((ex (make-overlay 0 0)))
+ (overlay-put ex 'face 'region) ex))
+
+ (defalias 'sml-is-overlay 'overlayp)
+
+ (defun sml-overlay-active-p ()
+ "Determine whether the current buffer's error overlay is visible."
+ (and (sml-is-overlay sml-error-overlay)
+ (not (equal (overlay-start sml-error-overlay)
+ (overlay-end sml-error-overlay)))))
+
+ (defalias 'sml-move-overlay 'move-overlay))
+ (t
+ ;; what *is* this!?
+ (defalias 'sml-is-overlay 'ignore)
+ (defalias 'sml-overlay-active-p 'ignore)
+ (defalias 'sml-make-overlay 'ignore)
+ (defalias 'sml-move-overlay 'ignore)))
+
+;;; MORE CODE FOR SML-MODE
+
+(defun sml-mode-version ()
+ "This file's version number (sml-mode)."
+ (interactive)
+ (message sml-mode-version-string))
+
+(defvar sml-mode-syntax-table nil "The syntax table used in sml-mode.")
+(if sml-mode-syntax-table
+ ()
+ (setq sml-mode-syntax-table (make-syntax-table))
+ ;; Set everything to be "." (punctuation) except for [A-Za-z0-9],
+ ;; which will default to "w" (word-constituent).
+ (let ((i 0))
+ (while (< i ?0)
+ (modify-syntax-entry i "." sml-mode-syntax-table)
+ (setq i (1+ i)))
+ (setq i (1+ ?9))
+ (while (< i ?A)
+ (modify-syntax-entry i "." sml-mode-syntax-table)
+ (setq i (1+ i)))
+ (setq i (1+ ?Z))
+ (while (< i ?a)
+ (modify-syntax-entry i "." sml-mode-syntax-table)
+ (setq i (1+ i)))
+ (setq i (1+ ?z))
+ (while (< i 128)
+ (modify-syntax-entry i "." sml-mode-syntax-table)
+ (setq i (1+ i))))
+
+ ;; Now we change the characters that are meaningful to us.
+ (modify-syntax-entry ?\( "()1" sml-mode-syntax-table)
+ (modify-syntax-entry ?\) ")(4" sml-mode-syntax-table)
+ (modify-syntax-entry ?\[ "(]" sml-mode-syntax-table)
+ (modify-syntax-entry ?\] ")[" sml-mode-syntax-table)
+ (modify-syntax-entry ?{ "(}" sml-mode-syntax-table)
+ (modify-syntax-entry ?} "){" sml-mode-syntax-table)
+ (modify-syntax-entry ?\* ". 23" sml-mode-syntax-table)
+ (modify-syntax-entry ?\" "\"" sml-mode-syntax-table)
+ (modify-syntax-entry ? " " sml-mode-syntax-table)
+ (modify-syntax-entry ?\t " " sml-mode-syntax-table)
+ (modify-syntax-entry ?\n " " sml-mode-syntax-table)
+ (modify-syntax-entry ?\f " " sml-mode-syntax-table)
+ (modify-syntax-entry ?\' "w" sml-mode-syntax-table)
+ (modify-syntax-entry ?\_ "w" sml-mode-syntax-table))
+
+;;;###Autoload
+(defun sml-mode ()
+ "Major mode for editing ML code.
+Tab indents for ML code.
+Comments are delimited with (* ... *).
+Blank lines and form-feeds separate paragraphs.
+Delete converts tabs to spaces as it moves back.
+
+For information on running an inferior ML process, see the documentation
+for inferior-sml-mode (set this up with \\[sml]).
+
+Customisation: Entry to this mode runs the hooks on sml-mode-hook.
+
+Variables controlling the indentation
+=====================================
+
+Seek help (\\[describe-variable]) on individual variables to get current settings.
+
+sml-indent-level (default 4)
+ The indentation of a block of code.
+
+sml-pipe-indent (default -2)
+ Extra indentation of a line starting with \"|\".
+
+sml-case-indent (default nil)
+ Determine the way to indent case-of expression.
+
+sml-nested-if-indent (default nil)
+ Determine how nested if-then-else expressions are formatted.
+
+sml-type-of-indent (default t)
+ How to indent let, struct, local, etc.
+ Will not have any effect if the starting keyword is first on the line.
+
+sml-electric-semi-mode (default nil)
+ If t, a `\;' will reindent line, and perform a newline.
+
+sml-paren-lookback (default 1000)
+ Determines how far back (in chars) the indentation algorithm should
+ look to match parenthesis. A value of nil, means do not look at all.
+
+Mode map
+========
+\\{sml-mode-map}"
+
+ (interactive)
+ (kill-all-local-variables)
+ (sml-mode-variables)
+ (use-local-map sml-mode-map)
+ (setq major-mode 'sml-mode)
+ (setq mode-name "SML")
+ (run-hooks 'sml-mode-hook)) ; Run the hook last
+
+(defun sml-mode-variables ()
+ (set-syntax-table sml-mode-syntax-table)
+ (setq local-abbrev-table sml-mode-abbrev-table)
+ ;; A paragraph is separated by blank lines or ^L only.
+ (make-local-variable 'paragraph-start)
+ (setq paragraph-start (concat "^[\t ]*$\\|" page-delimiter))
+ (make-local-variable 'paragraph-separate)
+ (setq paragraph-separate paragraph-start)
+ (make-local-variable 'indent-line-function)
+ (setq indent-line-function 'sml-indent-line)
+ (make-local-variable 'comment-start)
+ (setq comment-start "(* ")
+ (make-local-variable 'comment-end)
+ (setq comment-end " *)")
+ (make-local-variable 'comment-column)
+ (setq comment-column 40)
+ (make-local-variable 'comment-start-skip)
+ (setq comment-start-skip "(\\*+[ \t]?")
+ (make-local-variable 'comment-indent-function)
+ (setq comment-indent-function 'sml-comment-indent)
+ (setq sml-error-overlay (and sml-error-overlay (sml-make-overlay))))
+
+ ;; Adding these will fool the matching of parens -- because of a
+ ;; bug in Emacs (in scan_lists, i think)... it would be nice to
+ ;; have comments treated as white-space.
+ ;;(make-local-variable 'parse-sexp-ignore-comments)
+ ;;(setq parse-sexp-ignore-comments t)
+
+(defun sml-error-overlay (undo &optional beg end buffer)
+ "Move `sml-error-overlay' so it surrounds the text region in the
+current buffer. If the buffer-local variable `sml-error-overlay' is
+non-nil it should be an overlay \(or extent, in XEmacs speak\)\; this
+function moves the overlay over the current region. If the optional
+BUFFER argument is given, move the overlay in that buffer instead of
+the current buffer.
+
+Called interactively, the optional prefix argument UNDO indicates that
+the overlay should simply be removed: \\[universal-argument] \
+\\[sml-error-overlay]."
+ (interactive "P")
+ (save-excursion
+ (set-buffer (or buffer (current-buffer)))
+ (if (sml-is-overlay sml-error-overlay)
+ (if undo
+ (sml-move-overlay sml-error-overlay 1 1)
+ ;; if active regions, signals mark not active if no region set
+ (let ((beg (or beg (region-beginning)))
+ (end (or end (region-end))))
+ (sml-move-overlay sml-error-overlay beg end))))))
+
+(defconst sml-pipe-matchers-reg
+ "\\bcase\\b\\|\\bfn\\b\\|\\bfun\\b\\|\\bhandle\\b\
+\\|\\bdatatype\\b\\|\\babstype\\b\\|\\band\\b"
+ "The keywords a `|' can follow.")
+
+(defun sml-electric-pipe ()
+ "Insert a \"|\".
+Depending on the context insert the name of function, a \"=>\" etc."
+ (interactive)
+ (let ((case-fold-search nil) ; Case sensitive
+ (here (point))
+ (match (save-excursion
+ (sml-find-matching-starter sml-pipe-matchers-reg)
+ (point)))
+ (tmp " => ")
+ (case-or-handle-exp t))
+ (if (/= (save-excursion (beginning-of-line) (point))
+ (save-excursion (skip-chars-backward "\t ") (point)))
+ (insert "\n"))
+ (insert "|")
+ (save-excursion
+ (goto-char match)
+ (cond
+ ;; It was a function, insert the function name
+ ((looking-at "fun\\b")
+ (setq tmp (concat " " (buffer-substring
+ (progn (forward-char 3)
+ (skip-chars-forward "\t\n ") (point))
+ (progn (forward-word 1) (point))) " "))
+ (setq case-or-handle-exp nil))
+ ;; It was a datatype, insert nothing
+ ((looking-at "datatype\\b\\|abstype\\b")
+ (setq tmp " ") (setq case-or-handle-exp nil))
+ ;; If it is an and, then we have to see what is was
+ ((looking-at "and\\b")
+ (let (isfun)
+ (save-excursion
+ (condition-case ()
+ (progn
+ (re-search-backward "datatype\\b\\|abstype\\b\\|fun\\b")
+ (setq isfun (looking-at "fun\\b")))
+ (error (setq isfun nil))))
+ (if isfun
+ (progn
+ (setq tmp
+ (concat " " (buffer-substring
+ (progn (forward-char 3)
+ (skip-chars-forward "\t\n ") (point))
+ (progn (forward-word 1) (point))) " "))
+ (setq case-or-handle-exp nil))
+ (setq tmp " ") (setq case-or-handle-exp nil))))))
+ (insert tmp)
+ (sml-indent-line)
+ (beginning-of-line)
+ (skip-chars-forward "\t ")
+ (forward-char (1+ (length tmp)))
+ (if case-or-handle-exp
+ (forward-char -4))))
+
+(defun sml-electric-semi ()
+ "Inserts a \;.
+If variable sml-electric-semi-mode is t, indent the current line, insert
+a newline, and indent."
+ (interactive)
+ (insert "\;")
+ (if sml-electric-semi-mode
+ (reindent-then-newline-and-indent)))
+
+;;; INDENTATION !!!
+
+(defun sml-mark-function ()
+ "Synonym for mark-paragraph -- sorry.
+If anyone has a good algorithm for this..."
+ (interactive)
+ (mark-paragraph))
+
+(defun sml-indent-region (begin end)
+ "Indent region of ML code."
+ (interactive "r")
+ (message "Indenting region...")
+ (save-excursion
+ (goto-char end) (setq end (point-marker)) (goto-char begin)
+ (while (< (point) end)
+ (skip-chars-forward "\t\n ")
+ (sml-indent-line)
+ (end-of-line))
+ (move-marker end nil))
+ (message "Indenting region... done"))
+
+(defun sml-indent-line ()
+ "Indent current line of ML code."
+ (interactive)
+ (let ((indent (sml-calculate-indentation)))
+ (if (/= (current-indentation) indent)
+ (save-excursion ;; Added 890601 (point now stays)
+ (let ((beg (progn (beginning-of-line) (point))))
+ (skip-chars-forward "\t ")
+ (delete-region beg (point))
+ (indent-to indent))))
+ ;; If point is before indentation, move point to indentation
+ (if (< (current-column) (current-indentation))
+ (skip-chars-forward "\t "))))
+
+(defun sml-back-to-outer-indent ()
+ "Unindents to the next outer level of indentation."
+ (interactive)
+ (save-excursion
+ (beginning-of-line)
+ (skip-chars-forward "\t ")
+ (let ((start-column (current-column))
+ (indent (current-column)))
+ (if (> start-column 0)
+ (progn
+ (save-excursion
+ (while (>= indent start-column)
+ (if (re-search-backward "^[^\n]" nil t)
+ (setq indent (current-indentation))
+ (setq indent 0))))
+ (backward-delete-char-untabify (- start-column indent)))))))
+
+(defconst sml-indent-starters-reg
+ "abstraction\\b\\|abstype\\b\\|and\\b\\|case\\b\\|datatype\\b\
+\\|else\\b\\|fun\\b\\|functor\\b\\|if\\b\\|sharing\\b\
+\\|in\\b\\|infix\\b\\|infixr\\b\\|let\\b\\|local\\b\
+\\|nonfix\\b\\|of\\b\\|open\\b\\|raise\\b\\|sig\\b\\|signature\\b\
+\\|struct\\b\\|structure\\b\\|then\\b\\|\\btype\\b\\|val\\b\
+\\|while\\b\\|with\\b\\|withtype\\b"
+ "The indentation starters. The next line will be indented.")
+
+(defconst sml-starters-reg
+ "\\babstraction\\b\\|\\babstype\\b\\|\\bdatatype\\b\
+\\|\\bexception\\b\\|\\bfun\\b\\|\\bfunctor\\b\\|\\blocal\\b\
+\\|\\binfix\\b\\|\\binfixr\\b\\|\\bsharing\\b\
+\\|\\bnonfix\\b\\|\\bopen\\b\\|\\bsignature\\b\\|\\bstructure\\b\
+\\|\\btype\\b\\|\\bval\\b\\|\\bwithtype\\b\\|\\bwith\\b"
+ "The starters of new expressions.")
+
+(defconst sml-end-starters-reg
+ "\\blet\\b\\|\\blocal\\b\\|\\bsig\\b\\|\\bstruct\\b\\|\\bwith\\b"
+ "Matching reg-expression for the \"end\" keyword.")
+
+(defconst sml-starters-indent-after
+ "let\\b\\|local\\b\\|struct\\b\\|in\\b\\|sig\\b\\|with\\b"
+ "Indent after these.")
+
+(defun sml-calculate-indentation ()
+ (save-excursion
+ (let ((case-fold-search nil))
+ (beginning-of-line)
+ (if (bobp) ; Beginning of buffer
+ 0 ; Indentation = 0
+ (skip-chars-forward "\t ")
+ (cond
+ ;; Indentation for comments alone on a line, matches the
+ ;; proper indentation of the next line. Search only for the
+ ;; next "*)", not for the matching.
+ ((looking-at "(\\*")
+ (if (not (search-forward "*)" nil t))
+ (error "Comment not ended."))
+ (end-of-line)
+ (skip-chars-forward "\n\t ")
+ ;; If we are at eob, just indent 0
+ (if (eobp) 0 (sml-calculate-indentation)))
+ ;; Continued string ? (Added 890113 lbn)
+ ((looking-at "\\\\")
+ (save-excursion
+ (if (save-excursion (previous-line 1)
+ (beginning-of-line)
+ (looking-at "[\t ]*\\\\"))
+ (progn (previous-line 1) (current-indentation))
+ (if (re-search-backward "[^\\\\]\"" nil t)
+ (1+ (current-indentation))
+ 0))))
+ ;; Are we looking at a case expression ?
+ ((looking-at "|.*=>")
+ (sml-skip-block)
+ (sml-re-search-backward "=>")
+ ;; Dont get fooled by fn _ => in case statements (890726)
+ ;; Changed the regexp a bit, so fn has to be first on line,
+ ;; in order to let the loop continue (Used to be ".*\bfn....")
+ ;; (900430).
+ (let ((loop t))
+ (while (and loop (save-excursion
+ (beginning-of-line)
+ (looking-at "[^ \t]+\\bfn\\b.*=>")))
+ (setq loop (sml-re-search-backward "=>"))))
+ (beginning-of-line)
+ (skip-chars-forward "\t ")
+ (cond
+ ((looking-at "|") (current-indentation))
+ ((and sml-case-indent (looking-at "of\\b"))
+ (1+ (current-indentation)))
+ ((looking-at "fn\\b") (1+ (current-indentation)))
+ ((looking-at "handle\\b") (+ (current-indentation) 5))
+ (t (+ (current-indentation) sml-pipe-indent))))
+ ((looking-at "and\\b")
+ (if (sml-find-matching-starter sml-starters-reg)
+ (current-column)
+ 0))
+ ((looking-at "in\\b") ; Match the beginning let/local
+ (sml-find-match-indent "in" "\\bin\\b" "\\blocal\\b\\|\\blet\\b"))
+ ((looking-at "end\\b") ; Match the beginning
+ (sml-find-match-indent "end" "\\bend\\b" sml-end-starters-reg))
+ ((and sml-nested-if-indent (looking-at "else[\t ]*if\\b"))
+ (sml-re-search-backward "\\bif\\b\\|\\belse\\b")
+ (current-indentation))
+ ((looking-at "else\\b") ; Match the if
+ (sml-find-match-indent "else" "\\belse\\b" "\\bif\\b" t))
+ ((looking-at "then\\b") ; Match the if + extra indentation
+ (+ (sml-find-match-indent "then" "\\bthen\\b" "\\bif\\b" t)
+ sml-indent-level))
+ ((and sml-case-indent (looking-at "of\\b"))
+ (sml-re-search-backward "\\bcase\\b")
+ (+ (current-column) 2))
+ ((looking-at sml-starters-reg)
+ (let ((start (point)))
+ (sml-backward-sexp)
+ (if (and (looking-at sml-starters-indent-after)
+ (/= start (point)))
+ (+ (if sml-type-of-indent
+ (current-column)
+ (if (progn (beginning-of-line)
+ (skip-chars-forward "\t ")
+ (looking-at "|"))
+ (- (current-indentation) sml-pipe-indent)
+ (current-indentation)))
+ sml-indent-level)
+ (beginning-of-line)
+ (skip-chars-forward "\t ")
+ (if (and (looking-at sml-starters-indent-after)
+ (/= start (point)))
+ (+ (if sml-type-of-indent
+ (current-column)
+ (current-indentation))
+ sml-indent-level)
+ (goto-char start)
+ (if (sml-find-matching-starter sml-starters-reg)
+ (current-column)
+ 0)))))
+ (t
+ (let ((indent (sml-get-indent)))
+ (cond
+ ((looking-at "|")
+ ;; Lets see if it is the follower of a function definition
+ (if (sml-find-matching-starter
+ "\\bfun\\b\\|\\bfn\\b\\|\\band\\b\\|\\bhandle\\b")
+ (cond
+ ((looking-at "fun\\b") (- (current-column) sml-pipe-indent))
+ ((looking-at "fn\\b") (1+ (current-column)))
+ ((looking-at "and\\b") (1+ (1+ (current-column))))
+ ((looking-at "handle\\b") (+ (current-column) 5)))
+ (+ indent sml-pipe-indent)))
+ (t
+ (if sml-paren-lookback ; Look for open parenthesis ?
+ (max indent (sml-get-paren-indent))
+ indent))))))))))
+
+(defun sml-get-indent ()
+ (save-excursion
+ (let ((case-fold-search nil))
+ (beginning-of-line)
+ (skip-chars-backward "\t\n; ")
+ (if (looking-at ";") (sml-backward-sexp))
+ (cond
+ ((save-excursion (sml-backward-sexp) (looking-at "end\\b"))
+ (- (current-indentation) sml-indent-level))
+ (t
+ (while (/= (current-column) (current-indentation))
+ (sml-backward-sexp))
+ (skip-chars-forward "\t |")
+ (let ((indent (current-column)))
+ (skip-chars-forward "\t (")
+ (cond
+ ;; Started val/fun/structure...
+ ((looking-at sml-indent-starters-reg)
+ (+ (current-column) sml-indent-level))
+ ;; Indent after "=>" pattern, but only if its not an fn _ =>
+ ;; (890726)
+ ((looking-at ".*=>")
+ (if (looking-at ".*\\bfn\\b.*=>")
+ indent
+ (+ indent sml-indent-level)))
+ ;; else keep the same indentation as previous line
+ (t indent))))))))
+
+(defun sml-get-paren-indent ()
+ (save-excursion
+ (let ((levelpar 0) ; Level of "()"
+ (levelcurl 0) ; Level of "{}"
+ (levelsqr 0) ; Level of "[]"
+ (backpoint (max (- (point) sml-paren-lookback) (point-min))))
+ (catch 'loop
+ (while (and (/= levelpar 1) (/= levelsqr 1) (/= levelcurl 1))
+ (if (re-search-backward "[][{}()]" backpoint t)
+ (if (not (sml-inside-comment-or-string-p))
+ (cond
+ ((looking-at "(") (setq levelpar (1+ levelpar)))
+ ((looking-at ")") (setq levelpar (1- levelpar)))
+ ((looking-at "\\[") (setq levelsqr (1+ levelsqr)))
+ ((looking-at "\\]") (setq levelsqr (1- levelsqr)))
+ ((looking-at "{") (setq levelcurl (1+ levelcurl)))
+ ((looking-at "}") (setq levelcurl (1- levelcurl)))))
+ (throw 'loop 0))) ; Exit with value 0
+ (if (save-excursion
+ (forward-char 1)
+ (looking-at sml-indent-starters-reg))
+ (1+ (+ (current-column) sml-indent-level))
+ (1+ (current-column)))))))
+
+(defun sml-inside-comment-or-string-p ()
+ (let ((start (point)))
+ (if (save-excursion
+ (condition-case ()
+ (progn
+ (search-backward "(*")
+ (search-forward "*)")
+ (forward-char -1) ; A "*)" is not inside the comment
+ (> (point) start))
+ (error nil)))
+ t
+ (let ((numb 0))
+ (save-excursion
+ (save-restriction
+ (narrow-to-region (progn (beginning-of-line) (point)) start)
+ (condition-case ()
+ (while t
+ (search-forward "\"")
+ (setq numb (1+ numb)))
+ (error (if (and (not (zerop numb))
+ (not (zerop (% numb 2))))
+ t nil)))))))))
+
+(defun sml-skip-block ()
+ (let ((case-fold-search nil))
+ (sml-backward-sexp)
+ (if (looking-at "end\\b")
+ (progn
+ (goto-char (sml-find-match-backward "end" "\\bend\\b"
+ sml-end-starters-reg))
+ (skip-chars-backward "\n\t "))
+ ;; Here we will need to skip backward past if-then-else
+ ;; and case-of expression. Please - tell me how !!
+ )))
+
+(defun sml-find-match-backward (unquoted-this this match &optional start)
+ (save-excursion
+ (let ((case-fold-search nil)
+ (level 1)
+ (pattern (concat this "\\|" match)))
+ (if start (goto-char start))
+ (while (not (zerop level))
+ (if (sml-re-search-backward pattern)
+ (setq level (cond
+ ((looking-at this) (1+ level))
+ ((looking-at match) (1- level))))
+ ;; The right match couldn't be found
+ (error (concat "Unbalanced: " unquoted-this))))
+ (point))))
+
+(defun sml-find-match-indent (unquoted-this this match &optional indented)
+ (save-excursion
+ (goto-char (sml-find-match-backward unquoted-this this match))
+ (if (or sml-type-of-indent indented)
+ (current-column)
+ (if (progn
+ (beginning-of-line)
+ (skip-chars-forward "\t ")
+ (looking-at "|"))
+ (- (current-indentation) sml-pipe-indent)
+ (current-indentation)))))
+
+(defun sml-find-matching-starter (regexp)
+ (let ((case-fold-search nil)
+ (start-let-point (sml-point-inside-let-etc))
+ (start-up-list (sml-up-list))
+ (found t))
+ (if (sml-re-search-backward regexp)
+ (progn
+ (condition-case ()
+ (while (or (/= start-up-list (sml-up-list))
+ (/= start-let-point (sml-point-inside-let-etc)))
+ (re-search-backward regexp))
+ (error (setq found nil)))
+ found)
+ nil)))
+
+(defun sml-point-inside-let-etc ()
+ (let ((case-fold-search nil) (last nil) (loop t) (found t) (start (point)))
+ (save-excursion
+ (while loop
+ (condition-case ()
+ (progn
+ (re-search-forward "\\bend\\b")
+ (while (sml-inside-comment-or-string-p)
+ (re-search-forward "\\bend\\b"))
+ (forward-char -3)
+ (setq last (sml-find-match-backward "end" "\\bend\\b"
+ sml-end-starters-reg last))
+ (if (< last start)
+ (setq loop nil)
+ (forward-char 3)))
+ (error (progn (setq found nil) (setq loop nil)))))
+ (if found
+ last
+ 0))))
+
+(defun sml-re-search-backward (regexpr)
+ (let ((case-fold-search nil) (found t))
+ (if (re-search-backward regexpr nil t)
+ (progn
+ (condition-case ()
+ (while (sml-inside-comment-or-string-p)
+ (re-search-backward regexpr))
+ (error (setq found nil)))
+ found)
+ nil)))
+
+(defun sml-up-list ()
+ (save-excursion
+ (condition-case ()
+ (progn
+ (up-list 1)
+ (point))
+ (error 0))))
+
+(defun sml-backward-sexp ()
+ (condition-case ()
+ (progn
+ (let ((start (point)))
+ (backward-sexp 1)
+ (while (and (/= start (point)) (looking-at "(\\*"))
+ (setq start (point))
+ (backward-sexp 1))))
+ (error (forward-char -1))))
+
+(defun sml-comment-indent ()
+ (if (looking-at "^(\\*") ; Existing comment at beginning
+ 0 ; of line stays there.
+ (save-excursion
+ (skip-chars-backward " \t")
+ (max (1+ (current-column)) ; Else indent at comment column
+ comment-column)))) ; except leave at least one space.
+
+;;; INSERTING PROFORMAS (COMMON SML-FORMS)
+
+(defvar sml-forms-alist
+ '(("let") ("local") ("case") ("abstype") ("datatype")
+ ("signature") ("structure") ("functor"))
+ "*The list of templates to auto-insert.
+
+You can extend this alist to your heart's content. For each additional
+template NAME in the list, declare a keyboard macro or function (or
+interactive command) called 'sml-form-NAME'.
+
+If 'sml-form-NAME' is a function it takes no arguments and should
+insert the template at point\; if this is a command it may accept any
+sensible interactive call arguments\; keyboard macros can't take
+arguments at all. Apropos keyboard macros, see `name-last-kbd-macro'
+and `sml-addto-forms-alist'.
+
+`sml-forms-alist' understands let, local, case, abstype, datatype,
+signature, structure, and functor by default.")
+
+;; See also macros.el in emacs lisp dir.
+
+(defun sml-addto-forms-alist (name)
+ "Assign a name to the last keyboard macro defined.
+Argument NAME is transmogrified to sml-form-NAME which is the symbol
+actually defined.
+
+The symbol's function definition becomes the keyboard macro string.
+
+If that works, NAME is added to `sml-forms-alist' so you'll be able to
+reinvoke the macro through \\[sml-insert-form]. You might want to save
+the macro to use in a later editing session -- see `insert-kbd-macro'
+and add these macros to your .emacs file.
+
+See also `edit-kbd-macro' which is bound to \\[edit-kbd-macro]."
+ (interactive "sName for last kbd macro (\"sml-form-\" will be added): ")
+ (if (string-equal name "")
+ (error "No command name given")
+ (name-last-kbd-macro (intern (concat "sml-form-" name)))
+ (message (concat "Macro bound to sml-form-" name))
+ (or (assoc name sml-forms-alist)
+ (setq sml-forms-alist (cons (list name) sml-forms-alist)))))
+
+;; at a pinch these could be added to SML/Forms menu through the good
+;; offices of activate-menubar-hook or something... but documentation
+;; of this and/or menu-bar-update-hook is sparse in 19.33. anyway, use
+;; completing read for sml-insert-form prompt...
+
+(defvar sml-last-form "let"
+ "The most recent sml form inserted.")
+
+(defun sml-insert-form (arg)
+ "Interactive short-cut to insert a common ML form.
+If a perfix argument is given insert a newline and indent first, or
+just move to the proper indentation if the line is blank\; otherwise
+insert at point (which forces indentation to current column).
+
+The default form to insert is 'whatever you inserted last time'
+\(just hit return when prompted\)\; otherwise the command reads with
+completion from `sml-forms-alist'."
+ (interactive "P")
+ (let ((name (completing-read
+ (format "Form to insert: (default %s) " sml-last-form)
+ sml-forms-alist nil t nil)))
+ ;; default is whatever the last insert was...
+ (if (string= name "") (setq name sml-last-form))
+ (setq sml-last-form name)
+ (if arg
+ (if (save-excursion (beginning-of-line) (looking-at "[ \t]*$"))
+ (sml-indent-line)
+ (newline-and-indent)))
+ (cond ((string= name "let") (sml-form-let))
+ ((string= name "local") (sml-form-local))
+ ((string= name "case") (sml-form-case))
+ ((string= name "abstype") (sml-form-abstype))
+ ((string= name "datatype") (sml-form-datatype))
+ ((string= name "functor") (sml-form-functor))
+ ((string= name "structure") (sml-form-structure))
+ ((string= name "signature") (sml-form-signature))
+ (t
+ (let ((template (intern (concat "sml-form-" name))))
+ (if (fboundp template)
+ (if (commandp template)
+ ;; it may be a named kbd macro too
+ (command-execute template)
+ (funcall template))
+ (error
+ (format "Undefined format function: %s" template))))))))
+
+(defun sml-form-let ()
+ "Insert a `let in end' template."
+ (interactive)
+ (sml-let-local "let"))
+
+(defun sml-form-local ()
+ "Insert a `local in end' template."
+ (interactive)
+ (sml-let-local "local"))
+
+(defun sml-let-local (starter)
+ "Insert a let or local template, depending on STARTER string."
+ (let ((indent (current-column)))
+ (insert starter)
+ (insert "\n") (indent-to (+ sml-indent-level indent))
+ (save-excursion ; so point returns here
+ (insert "\n")
+ (indent-to indent)
+ (insert "in\n")
+ (indent-to (+ sml-indent-level indent))
+ (insert "\n")
+ (indent-to indent)
+ (insert "end"))))
+
+(defun sml-form-case ()
+ "Insert a case expression template, prompting for the case-expresion."
+ (interactive)
+ (let ((expr (read-string "Case expr: "))
+ (indent (current-column)))
+ (insert (concat "case " expr))
+ (if sml-case-indent
+ (progn
+ (insert "\n")
+ (indent-to (+ 2 indent))
+ (insert "of "))
+ (insert " of\n")
+ (indent-to (+ indent sml-indent-level)))
+ (save-excursion (insert " => "))))
+
+(defun sml-form-signature ()
+ "Insert a generative signature binding, prompting for the name."
+ (interactive)
+ (let ((indent (current-column))
+ (name (read-string "Signature name: ")))
+ (insert (concat "signature " name " ="))
+ (insert "\n")
+ (indent-to (+ sml-structure-indent indent))
+ (insert "sig\n")
+ (indent-to (+ sml-structure-indent sml-indent-level indent))
+ (save-excursion
+ (insert "\n")
+ (indent-to (+ sml-structure-indent indent))
+ (insert "end"))))
+
+(defun sml-form-structure ()
+ "Insert a generative structure binding, prompting for the name.
+The command also prompts for any signature constraint -- you should
+specify \":\" or \":>\" and the constraining signature."
+ (interactive)
+ (let ((indent (current-column))
+ (name (read-string (concat "Structure name: ")))
+ (signame (read-string "Signature constraint (default none): ")))
+ (insert (concat "structure " name " "))
+ (insert (if (string= "" signame) "=" (concat signame " =")))
+ (insert "\n")
+ (indent-to (+ sml-structure-indent indent))
+ (insert "struct\n")
+ (indent-to (+ sml-structure-indent sml-indent-level indent))
+ (save-excursion
+ (insert "\n")
+ (indent-to (+ sml-structure-indent indent))
+ (insert "end"))))
+
+(defun sml-form-functor ()
+ "Insert a genarative functor binding, prompting for the name.
+The command also prompts for the required signature constraint -- you
+should specify \":\" or \":>\" and the constraining signature."
+ (interactive)
+ (let ((indent(current-indentation))
+ (name (read-string "Name of functor: "))
+ (signame (read-string "Signature constraint: " ":" )))
+ (insert (concat "functor " name " () " signame " ="))
+ (insert "\n")
+ (indent-to (+ sml-structure-indent indent))
+ (insert "struct\n")
+ (indent-to (+ sml-structure-indent sml-indent-level indent))
+ (save-excursion ; return to () instead?
+ (insert "\n")
+ (indent-to (+ sml-structure-indent indent))
+ (insert "end"))))
+
+(defun sml-form-datatype ()
+ "Insert a datatype declaration, prompting for name and type parameter."
+ (interactive)
+ (let ((indent (current-indentation))
+ (type (read-string "Datatype type parameter (default none): "))
+ (name (read-string (concat "Name of datatype: "))))
+ (insert (concat "datatype "
+ (if (string= type "") "" (concat type " "))
+ name " ="))
+ (insert "\n")
+ (indent-to (+ sml-indent-level indent))))
+
+(defun sml-form-abstype ()
+ "Insert an abstype declaration, prompting for name and type parameter."
+ (interactive)
+ (let ((indent(current-indentation))
+ (type (read-string "Abstype type parameter (default none): "))
+ (name (read-string "Name of abstype: ")))
+ (insert (concat "abstype "
+ (if (string= type "") "" (concat type " "))
+ name " ="))
+ (insert "\n")
+ (indent-to (+ sml-indent-level indent))
+ (save-excursion
+ (insert "\n")
+ (indent-to indent)
+ (insert "with\n")
+ (indent-to (+ sml-indent-level indent))
+ (insert "\n")
+ (indent-to indent)
+ (insert "end"))))
+
+;;; Load the menus, if they can be found on the load-path
+
+(condition-case nil
+ (require 'sml-menus)
+ (error (message "Sorry, not able to load SML mode menus.")))
+
+;;; & do the user's customisation
+
+(add-hook 'sml-load-hook 'sml-mode-version t)
+
+(run-hooks 'sml-load-hook)
+
+;;; sml-mode.el has just finished.
--- /dev/null
+;;; sml-mosml.el: Modifies inferior-sml-mode defaults for Moscow ML.
+
+;; Copyright (C) 1997, Matthew J. Morley
+
+;; $Revision: 1.5 $
+;; $Date: 1997/06/23 09:19:56 $
+
+;; This file is not part of GNU Emacs, but it is distributed under the
+;; same conditions.
+
+;; ====================================================================
+
+;; This program is free software; you can redistribute it and/or
+;; modify it under the terms of the GNU General Public License as
+;; published by the Free Software Foundation; either version 2, or (at
+;; your option) any later version.
+
+;; This program is distributed in the hope that it will be useful, but
+;; WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+;; General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs; see the file COPYING. If not, write to the
+;; Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
+
+;; ====================================================================
+
+;;; DESCRIPTION
+
+;; To use this library just put
+
+;;(autoload 'sml-mosml "sml-mosml" "Set up and run Moscow ML." t)
+
+;; in your .emacs file. If you only ever use Moscow ML then you might
+;; as well put something like
+
+;;(setq sml-mode-hook
+;; '(lambda() "SML mode defaults to Moscow ML"
+;; (define-key sml-mode-map "\C-cp" 'sml-mosml)))
+
+;; for your sml-mode-hook. The command prompts for the program name
+;; and any command line options.
+
+;; If you need to reset the default value of sml-program-name, or any
+;; of the other compiler variables, put something like
+
+;;(eval-after-load "sml-mosml" '(setq sml-program-name "whatever"))
+
+;; in your .emacs -- or you can use the inferior-sml-{load,mode}-hooks
+;; to achieve the same ends.
+
+;;; CODE
+
+(require 'sml-proc)
+
+;; The regular expression used when looking for errors. Moscow ML errors:
+
+(defconst sml-mosml-error-regexp
+ (concat "^File \"\\([^\"]+\\)\"," ;1
+ " line \\([0-9]+\\)-?\\([0-9]+\\)?," ;2-3?
+ " characters \\([0-9]+\\)-\\([0-9]+\\):") ;4-5
+ "Default regexp matching Moscow ML error messages.
+If you change this significantly you may also need to redefine
+`sml-mosml-error-parser' (qv).")
+
+;; File "puzz.ml", line 30-31, characters 10-70:
+;; ! ..........first 0 l = []
+;; ! | first n (h::t) = h::(first (n-1) t)
+;; ! Warning: pattern matching is not exhaustive
+
+;; ! Toplevel input:
+;; ditto
+
+(defconst sml-mosml-error-messages
+ (concat "^! \\("
+ (mapconcat 'identity
+ (list "\\(Warning: .*\\)"
+ "\\(Type clash\\):"
+ "\\(Ill-formed infix expression\\)"
+ "\\(Syntax error.*\\)")
+ "\\|")
+ "\\).*$")
+ "RE to match Moscow ML type-of-error reports. This regular expression
+must follow the whole line pattern \"^! \\\\(%s\\\\).*$\", and the %s
+stands for a \"\\\\|\" separated list of regular expressions each of
+which must, I repeat *must*, contain at least one \"\\\\(%s\\\\)\" group.
+The %s regexp in the first such group will be the actual error report
+echoed to the user.")
+
+(defun sml-mosml-error-parser (pt)
+ "This function looks for the next Moscow ML error message following PT
+and parses an error message into a list
+ \(file start-line start-col end-of-err msg\)
+where
+
+ FILE is the file in which the error occurs
+
+ START-LINE is the line number in the file where the error occurs
+
+ START-COL is the character position on START-LINE where the error occurs
+
+ END-OF-ERR is an Emacs Lisp expression that when evaluated at
+ \(start-line,start-col\) moves point to the end of the errorful text
+
+ MSG is the text of the error message given by the compiler, if such text
+ can be found.
+
+The first three are mandatory return values for `sml-next-error'.
+See also `sml-error-parser'."
+ (save-excursion
+ (goto-char pt)
+ (if (not (looking-at sml-mosml-error-regexp))
+ ;; the user loses big time.
+ (list nil nil nil)
+ (let* ((file (match-string 1)) ; the file
+ (slin (string-to-int (match-string 2))) ; the start line
+ ;; char range is (n,m], 0 is column 1 of slin
+ (scol (string-to-int (match-string 4))) ; the start col
+ ;; get to the end by doing "forward-char m - n"
+ (eoe `(forward-char ,(- (string-to-int (match-string 5)) scol)))
+ (msg))
+ ;; look for the error message at end of the chunk of "! " lines
+ (forward-line 1)
+ (while (and (looking-at "^! ")
+ (not (looking-at sml-mosml-error-messages)))
+ (forward-line 1))
+ ;; found one if match-beginning 1 is non-nil.
+ (if (match-beginning 1)
+ (progn
+ (setq msg (match-string 1))
+ ;; refine since m-begin 1 implies m-begin N for some N>1 as
+ ;; long as sml-mosml-error-messages is sane as advertised.
+ ;; match-data is a list N+1 of pairs, consecutive elts being
+ ;; beg and end markers for the \( \) in the match. 0 is the
+ ;; whole match.
+ (let ((matches (1- (/ (length (match-data)) 2))) ; ignore 0th
+ (group 2)) ; & ignore 1st
+ (while (and (not (match-beginning group))
+ (<= group matches))
+ (setq group (1+ group)))
+ (if (<= group matches)
+ (setq msg (match-string group))))))
+ ;; 1+ scol because char 0 means column 1 of slin.
+ (nconc (list file slin (1+ scol)) (list eoe) (list msg))))))
+
+;;;###autoload
+(defun sml-mosml (pfx)
+ "Set up and run Moscow ML.
+Prefix argument means accept the defaults below.
+
+Note: defaults set here will be clobbered if you setq them in the
+inferior-sml-mode-hook.
+
+ sml-program-name <option> \(default \"mosml\"\)
+ sml-default-arg <option> \(default \"\"\)
+ sml-use-command \"use \\\"%s\\\"\"
+ sml-cd-command \"load \"FileSys\"; FileSys.chDir \\\"%s\\\"\"
+ sml-prompt-regexp \"^- *\"
+ sml-error-regexp sml-mosml-error-regexp
+ sml-error-parser 'sml-mosml-error-parser"
+ (interactive "P")
+ (let ((cmd (if pfx "mosml"
+ (read-string "Command name: " sml-program-name)))
+ (arg (if pfx ""
+ (read-string "Any arguments or options (default none): " ""))))
+ ;; sml-mode global variables
+ (setq sml-program-name cmd)
+ (setq sml-default-arg arg)
+ ;; buffer-local (compiler-local) variables
+ (setq-default sml-use-command "use \"%s\""
+ sml-cd-command "load \"FileSys\"; FileSys.chDir \"%s\""
+ sml-prompt-regexp "^- *"
+ sml-error-regexp sml-mosml-error-regexp
+ sml-error-parser 'sml-mosml-error-parser)
+ (sml-run cmd sml-default-arg)))
+
+;;; Do the default setup on loading this file.
+
+;; setqing these two may override user's hooked defaults. users
+;; therefore need load this file before setting sml-program-name or
+;; sml-default-arg in their inferior-sml-load-hook. sorry.
+
+(setq sml-program-name "mosml"
+ sml-default-arg "")
+
+;; same sort of problem here too: users should to setq-default these
+;; after this file is loaded, on inferior-sml-load-hook. as these are
+;; buffer-local, users can instead set them on inferior-sml-mode-hook.
+
+(setq-default sml-use-command "use \"%s\""
+ sml-cd-command "load \"FileSys\"; FileSys.chDir \"%s\""
+ sml-prompt-regexp "^- *"
+ sml-error-regexp sml-mosml-error-regexp
+ sml-error-parser 'sml-mosml-error-parser)
+
+;;; sml-mosml.el endeded
--- /dev/null
+;;; sml-poly-ml.el: Modifies inferior-sml-mode defaults for Poly/ML.
+
+;; Copyright (C) 1994,1997 Matthew J. Morley
+
+;; $Revision: 3.9 $
+;; $Date: 1997/06/23 09:21:25 $
+
+;; This file is not part of GNU Emacs, but it is distributed under the
+;; same conditions.
+
+;; ====================================================================
+
+;; This program is free software; you can redistribute it and/or
+;; modify it under the terms of the GNU General Public License as
+;; published by the Free Software Foundation; either version 2, or (at
+;; your option) any later version.
+
+;; This program is distributed in the hope that it will be useful, but
+;; WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+;; General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs; see the file COPYING. If not, write to the
+;; Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
+
+;; ====================================================================
+
+;;; DESCRIPTION
+
+;; To use this library just put
+
+;;(autoload 'sml-poly-ml "sml-poly-ml" "Set up and run Poly/ML." t)
+
+;; in your .emacs file. If you only ever use Poly/ML then you might as
+;; well put something like
+
+;;(setq sml-mode-hook
+;; '(lambda() "SML mode defaults to Poly/ML"
+;; (define-key sml-mode-map "\C-cp" 'sml-poly-ml)))
+
+;; for your sml-load-hook. The command prompts for the program name
+;; and the database to use, if any.
+
+;; If you need to reset the default value of sml-program-name, or any
+;; of the other compiler variables, put something like
+
+;;(eval-after-load "sml-poly-ml" '(setq sml-program-name "whatever"))
+
+;; in your .emacs -- or you can use the inferior-sml-{load,mode}-hooks
+;; to achieve the same ends.
+
+;;; CODE
+
+(require 'sml-proc)
+
+(defconst sml-poly-ml-error-regexp
+ "^\\(Error\\|Warning:\\) in '\\(.*\\)', line \\([0-9]+\\)"
+ "Default regexp matching Poly/ML error messages.")
+
+;; The reg-expression used when looking for errors. Poly/ML errors:
+
+;; Warning: in 'puzz.sml', line 28
+;; Matches are not exhaustive.
+
+;; Error
+;; Value or constructor (tl) has not been declared
+;; Found near tl(tl(tl(tl(N))))
+
+;; (when input is from std_in -- i.e. entered directly at the prompt).
+
+(defun sml-poly-ml-error-parser (pt)
+ "This function parses a Poly/ML error message into a 3 element list.
+ (file start-line start-col) required by `sml-next-error'."
+ (save-excursion
+ (goto-char pt)
+ (if (not (looking-at sml-poly-ml-error-regexp))
+ ;; the user loses big time.
+ (list nil nil nil)
+ (list (match-string 2) ; the file
+ (string-to-int (match-string 3)) ; the start line
+ 1)))) ; the start col
+
+;;;###autoload
+(defun sml-poly-ml (pfx)
+ "Set up and run Poly/ML.
+Prefix argument means accept the defaults below.
+
+Note: defaults set here will be clobbered if you setq them in the
+inferior-sml-mode-hook.
+
+ sml-program-name <option> \(default \"poly\"\)
+ sml-default-arg <option dbase> \(default \"\"\)
+ sml-use-command \"PolyML.use \\\"%s\\\"\"
+ sml-cd-command \"PolyML.cd \\\"%s\\\"\"
+ sml-prompt-regexp \"^[>#] *\"
+ sml-error-regexp sml-poly-ml-error-regexp
+ sml-error-parser 'sml-poly-ml-error-parser"
+ (interactive "P")
+ (let ((cmd (if pfx "poly"
+ (read-string "Command name: " sml-program-name)))
+ (arg (if pfx ""
+ (read-file-name "Poly database? (default none): " "" ""))))
+ ;; sml-mode global variables
+ (setq sml-program-name cmd)
+ (setq sml-default-arg (if (equal arg "") "" (expand-file-name arg)))
+ ;; buffer-local (compiler-local) variables
+ (setq-default sml-use-command "PolyML.use \"%s\""
+ sml-cd-command "PolyML.cd \"%s\""
+ sml-prompt-regexp "^[>#] *"
+ sml-error-regexp sml-poly-ml-error-regexp
+ sml-error-parser 'sml-poly-ml-error-parser)
+ (sml-run cmd sml-default-arg)))
+
+;;; Do the default setup on loading this file.
+
+;; setqing these two may override user's hooked defaults. users
+;; therefore need load this file before setting sml-program-name or
+;; sml-default-arg in their inferior-sml-load-hook. sorry.
+
+(setq sml-program-name "poly"
+ sml-default-arg "")
+
+;; same sort of problem here too: users should to setq-default these
+;; after this file is loaded, on inferior-sml-load-hook. as these are
+;; buffer-local, users can instead set them on inferior-sml-mode-hook.
+
+(setq-default sml-use-command "PolyML.use \"%s\""
+ sml-cd-command "PolyML.cd \"%s\""
+ sml-prompt-regexp "^[>#] *"
+ sml-error-regexp sml-poly-ml-error-regexp
+ sml-error-parser 'sml-poly-ml-error-parser)
+
+;;; sml-poly-ml.el ended just there
--- /dev/null
+;;; sml-proc.el. Comint based interaction mode for Standard ML.
+
+;; Copyright (C) 1989, Lars Bo Nielsen, 1994,1997 Matthew J. Morley
+
+;; $Revision$
+;; $Date$
+
+;; ====================================================================
+
+;; This file is not part of GNU Emacs, but it is distributed under the
+;; same conditions.
+
+;; This program is free software; you can redistribute it and/or
+;; modify it under the terms of the GNU General Public License as
+;; published by the Free Software Foundation; either version 2, or (at
+;; your option) any later version.
+
+;; This program is distributed in the hope that it will be useful, but
+;; WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+;; General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs; see the file COPYING. If not, write to the
+;; Free Software Foundation, 675 Mass Ave, Cambridge, MA 0139, USA.
+;; (See sml-mode.el for HISTORY.)
+
+;; ====================================================================
+
+;; [MJM 10/94] Separating this from sml-mode means sml-mode will run
+;; under 18.59 (or anywhere without comint, if there are such places).
+;; See sml-mode.el for further information.
+
+;;; DESCRIPTION
+
+;; Inferior-sml-mode is for interacting with an ML process run under
+;; emacs. This uses the comint package so you get history, expansion,
+;; backup and all the other benefits of comint. Interaction is
+;; achieved by M-x sml which starts a sub-process under emacs. You may
+;; need to set this up for autoloading in your .emacs:
+
+;; (autoload 'sml "sml-proc" "Run an inferior ML process." t)
+
+;; Exactly what process is governed by the variable sml-program-name
+;; -- just "sml" by default. If you give a prefix argument (C-u M-x
+;; sml) you will be prompted for a different program to execute from
+;; the default -- if you just hit RETURN you get the default anyway --
+;; along with the option to specify any command line arguments. Once
+;; you select the ML program name in this manner, it remains the
+;; default (unless you set in a hook, or otherwise).
+
+;; NOTE: inferior-sml-mode-hook is run AFTER the ML program has been
+;; launched. inferior-sml-load-hook is run only when sml-proc.el is
+;; loaded into Emacs.
+
+;; When running an ML process some further key-bindings are effective
+;; in sml-mode buffer(s). C-c C-s (switch-to-sml) will split the
+;; screen into two windows if necessary and place you in the ML
+;; process buffer. In the interaction buffer, C-c C-s is bound to the
+;; `sml' command by default (in case you need to restart).
+
+;; C-c C-l (sml-load-file) will load an SML source file into the
+;; inferior process, C-c C-r (sml-send-region) will send the current
+;; region of text to the ML process, etc. Given a prefix argument to
+;; these commands will switch you from the SML buffer to the ML
+;; process buffer as well as sending the text. If you get errors
+;; reported by the compiler, C-c ` (sml-next-error) will step through
+;; the errors with you.
+
+;; NOTE. There is only limited support for this as it obviously
+;; depends on the compiler's error messages being recognised by the
+;; mode. Error reporting is currently only geared up for SML/NJ,
+;; Moscow ML, and Poly/ML (see file sml-{mosml,poly-ml}.el). Look at
+;; the documentation for sml-error-parser and sml-next-error -- you
+;; may only need to modify the former to recover this feature for some
+;; other ML systems, along with sml-error-regexp.
+
+;; While small pieces of text can be fed quite happily into the ML
+;; process directly, lager pieces should (probably) be sent via a
+;; temporary file making use of the compiler's "use" command.
+
+;; CURRENT RATIONALE: you get sense out of the error messages if
+;; there's a real file associated with a block of code, and XEmacs is
+;; less likely to hang. These are likely to change.
+
+;; For more information see the variable sml-temp-threshold. You
+;; should set the variable sml-use-command appropriately for your ML
+;; compiler. By default things are set up to work for the SML/NJ
+;; compiler.
+
+;;; FOR YOUR .EMACS
+
+;; Here are some ideas for inferior-sml-*-hooks:
+
+;; (setq inferior-sml-load-hook
+;; '(lambda() "Set global defaults for inferior-sml-mode"
+;; (define-key inferior-sml-mode-map "\C-cd" 'sml-cd)
+;; (define-key sml-mode-map "\C-cd" 'sml-cd)
+;; (define-key sml-mode-map "\C-c\C-f" 'sml-send-function)
+;; (setq sml-temp-threshold 0))) ; safe: always use tmp file
+
+;; (setq inferior-sml-mode-hook
+;; '(lambda() "Inferior SML mode defaults"
+;; (setq comint-scroll-show-maximum-output t
+;; comint-scroll-to-bottom-on-output t
+;; comint-input-autoexpand nil)))
+
+;; ===================================================================
+
+;;; INFERIOR ML MODE VARIABLES
+
+(require 'sml-mode)
+(require 'comint)
+(provide 'sml-proc)
+
+(defvar sml-program-name "sml"
+ "*Program to run as ML.")
+
+(defvar sml-default-arg ""
+ "*Default command line option to pass, if any.")
+
+(defvar sml-display-frame-alist
+ '((height . 24) (width . 80) (menu-bar-lines . 0))
+ "*Alist of frame parameters used in creating dedicated ML interaction frames.
+These supersede the values given in `default-frame-alist'.
+You might like a larger screen
+
+ \(setcdr \(assoc 'height sml-display-frame-alist\) 40\)
+
+or you might like a small font
+
+ \(setq sml-display-frame-alist
+ \(cons '\(font . \"7x14\"\) sml-display-frame-alist\)\)
+
+in your `inferior-sml-load-hook', say. The parameters
+
+ '\(\(unsplittable . t\) \(icon-name . \"*sml*\"\)\)
+
+are always added to sml-display-frame-alist by default, though the value of
+icon-name is actually culled from `sml-program-name'.
+
+See also the documentation for `modify-frame-parameters'.")
+
+(defvar sml-dedicated-frame (if window-system t nil)
+ "*If non-nil, interaction buffers display in their own frame.
+Default is equivalent to variable `window-system'.
+If you reset this variable after starting the compiler, you might have
+to reset the window-dedicated property of the window displaying the
+interaction buffer. See `set-window-dedicated-p'.")
+
+;;(defvar sml-raise-on-error nil
+;; "*When non-nil, `sml-next-error' will raise the ML process's frame.")
+
+(defvar sml-temp-threshold 0
+ "*Controls when emacs uses temporary files to communicate with ML.
+If not a number (e.g., NIL), then emacs always sends text directly to
+the subprocess. If an integer N, then emacs uses a temporary file
+whenever the text is longer than N chars. `sml-temp-file' contains the
+name of the temporary file for communicating. See variable
+`sml-use-command' and function `sml-send-region'.
+
+Sending regions directly through the pty (not using temp files)
+doesn't work very well -- e.g., SML/NJ nor Poly/ML incorrectly report
+the line # of errors occurring in std_in.")
+
+(defvar sml-temp-file (make-temp-name "/tmp/ml")
+ "*Temp file that emacs uses to communicate with the ML process.
+See `sml-temp-threshold'. Defaults to \(make-temp-name \"/tmp/ml\"\)")
+
+(defvar inferior-sml-mode-hook nil
+ "*This hook is run when the inferior ML process is started.
+All buffer local customisations for the interaction buffers go here.")
+
+(defvar inferior-sml-load-hook nil
+ "*Hook run when inferior-sml-mode (sml-proc.el) is loaded into Emacs.
+This is a good place to put your preferred key bindings.")
+
+(defvar sml-buffer nil
+ "*The current ML process buffer.
+
+MULTIPLE PROCESS SUPPORT (Whoever wants multi-process support anyway?)
+=====================================================================
+sml-mode supports, in a fairly simple fashion, running multiple ML
+processes. To run multiple ML processes, you start the first up with
+\\[sml]. It will be in a buffer named *sml*. Rename this buffer with
+\\[rename-buffer]. You may now start up a new process with another
+\\[sml]. It will be in a new buffer, named *sml*. You can switch
+between the different process buffers with \\[switch-to-buffer].
+
+NB *sml* is just the default name for the buffer. It actually gets
+it's name from the value of `sml-program-name' -- *poly*, *smld*,...
+
+If you have more than one ML process around, commands that send text
+from source buffers to ML processes -- like `sml-send-function' or
+`sml-send-region' -- have to choose a process to send it to. This is
+determined by the global variable `sml-buffer'. Suppose you have three
+inferior ML's running:
+ Buffer Process
+ sml #<process sml>
+ mosml #<process mosml>
+ *sml* #<process sml<2>>
+If you do a \\[sml-send-function] command on some ML source code,
+what process do you send it to?
+
+- If you're in a process buffer (sml, mosml, or *sml*), you send it to
+ that process (usually makes sense only to `sml-load-file').
+- If you're in some other buffer (e.g., a source file), you send it to
+ the process attached to buffer `sml-buffer'.
+
+This process selection is performed by function `sml-proc' which looks
+at the value of `sml-buffer' -- which must be a lisp buffer object, or
+a string \(or nil\).
+
+Whenever \\[sml] fires up a new process, it resets `sml-buffer' to be
+the new process's buffer. If you only run one process, this will do
+the right thing. If you run multiple processes, you can change
+`sml-buffer' to another process buffer with \\[set-variable], or
+use the command \\[sml-buffer] in the interaction buffer of choice.")
+
+
+;;; ALL STUFF THAT DEFAULTS TO THE SML/NJ COMPILER (0.93)
+
+(defvar sml-use-command "use \"%s\""
+ "*Template for loading a file into the inferior ML process.
+Set to \"use \\\"%s\\\"\" for SML/NJ or Edinburgh ML;
+set to \"PolyML.use \\\"%s\\\"\" for Poly/ML, etc.")
+
+(defvar sml-cd-command "System.Directory.cd \"%s\""
+ "*Command template for changing working directories under ML.
+Set this to nil if your compiler can't change directories.
+
+The format specifier \"%s\" will be converted into the directory name
+specified when running the command \\[sml-cd].")
+
+(defvar sml-prompt-regexp "^[\-=] *"
+ "*Regexp used to recognise prompts in the inferior ML process.")
+
+(defvar sml-error-parser 'sml-smlnj-error-parser
+ "*This function parses an error message into a 3-5 element list:
+
+ \(file start-line start-col end-line-col err-msg\).
+
+The first three components are required by `sml-next-error', but the other
+two are optional. If the file associated with the input is the standard
+input stream, this function should probably return
+
+ \(\"std_in\" start-line start-col\).
+
+This function will be called in a context in which the match data \(see
+`match-data'\) are current for `sml-error-regexp'. The mode sets the
+default value to the function `sml-smlnj-error-parser'.
+
+In a step towards greater sml-mode modularity END-LINE-COL can be either
+
+ - the symbol nil \(in which case it is ignored\)
+
+or
+
+ - an Emacs Lisp expression that when `eval'd at \(start-line,start-col\)
+ will move point to the end of the errorful text in the file.
+
+Note that the compiler should return the full path name of the errorful
+file, and that this might require you to fiddle with the compiler's
+prettyprinting switches.")
+
+;; std_in:2.1-4.3 Error: operator and operand don't agree (tycon mismatch)
+;; std_in:2.1 Error: operator and operand don't agree (tycon mismatch)
+
+(defconst sml-smlnj-error-regexp
+ (concat
+ "^[-= ]*\\(.+\\):" ;file name
+ "\\([0-9]+\\)\\.\\([0-9]+\\)" ;start line.column
+ "\\(-\\([0-9]+\\)\\.\\([0-9]+\\)\\)?" ;end line.colum
+ ".+\\(\\(Error\\|Warning\\): .*\\)") ;the message
+
+ "Default regexp matching SML/NJ error and warning messages.
+
+There should be no need to customise this, though you might decide
+that you aren't interested in Warnings -- my advice would be to modify
+`sml-error-regexp' explicitly to do that though.
+
+If you do customise `sml-smlnj-error-regexp' you may need to modify
+the function `sml-smlnj-error-parser' (qv).")
+
+(defvar sml-error-regexp sml-smlnj-error-regexp
+ "*Regexp for matching \(the start of\) an error message.")
+
+(defun sml-smlnj-error-parser (pt)
+ "This parses the SML/NJ error message at PT into a 5 element list
+
+ \(file start-line start-col end-of-err msg\)
+
+where FILE is the file in which the error occurs\; START-LINE is the line
+number in the file where the error occurs\; START-COL is the character
+position on that line where the error occurs.
+
+If present, the fourth return value is a simple Emacs Lisp expression that
+will move point to the end of the errorful text, assuming that point is at
+\(start-line,start-col\) to begin with\; and MSG is the text of the error
+message given by the compiler."
+
+ ;; This function uses `sml-smlnj-error-regexp' to do the parsing, and
+ ;; assumes that regexp groups 1, 2, and 3 correspond to the first three
+ ;; elements of the list returned\; and groups 5, 6 and 7 correspond to the
+ ;; optional elements in that order.
+
+ (save-excursion
+ (goto-char pt)
+ (if (not (looking-at sml-smlnj-error-regexp))
+ ;; the user loses big time.
+ (list nil nil nil)
+ (let ((file (match-string 1)) ; the file
+ (slin (string-to-int (match-string 2))) ; the start line
+ (scol (string-to-int (match-string 3))) ; the start col
+ (msg (if (match-beginning 7) (match-string 7))))
+ ;; another loss: buggy sml/nj's produce nonsense like file:0.0 Error
+ (if (zerop slin) (list file nil scol)
+ ;; ok, was a range of characters mentioned?
+ (if (match-beginning 4)
+ ;; assume m-b 4 implies m-b 5 and m-b 6 (sml-smlnj-error-regexp)
+ (let* ((elin (string-to-int (match-string 5))) ; end line
+ (ecol (string-to-int (match-string 6))) ; end col
+ (jump (if (= elin slin)
+ ;; move forward on the same line
+ `(forward-char ,(1+ (- ecol scol)))
+ ;; otherwise move down, and over to ecol
+ `(progn
+ (forward-line ,(- elin slin))
+ (forward-char ,ecol)))))
+ ;; nconc glues lists together. jump & msg aren't lists
+ (nconc (list file slin scol) (list jump) (list msg)))
+ (nconc (list file slin scol) (list nil) (list msg))))))))
+
+(defun sml-smlnj (pfx)
+ "Set up and run Standard ML of New Jersey.
+Prefix argument means accept the defaults below.
+
+Note: defaults set here will be clobbered if you setq them in the
+inferior-sml-mode-hook.
+
+ sml-program-name <option> \(default \"sml\"\)
+ sml-default-arg <option> \(default \"\"\)
+ sml-use-command \"use \\\"%s\\\"\"
+ sml-cd-command \"System.Directory.cd \\\"%s\\\"\"
+ sml-prompt-regexp \"^[\\-=] *\"
+ sml-error-regexp sml-sml-nj-error-regexp
+ sml-error-parser 'sml-sml-nj-error-parser"
+ (interactive "P")
+ (let ((cmd (if pfx "sml"
+ (read-string "Command name: " sml-program-name)))
+ (arg (if pfx ""
+ (read-string "Any arguments or options (default none): "))))
+ ;; sml-mode global variables
+ (setq sml-program-name cmd)
+ (setq sml-default-arg arg)
+ ;; buffer-local (compiler-local) variables
+ (setq-default sml-use-command "use \"%s\""
+ sml-cd-command "System.Directory.cd \"%s\""
+ sml-prompt-regexp "^[\-=] *"
+ sml-error-regexp sml-smlnj-error-regexp
+ sml-error-parser 'sml-smlnj-error-parser)
+ (sml-run cmd sml-default-arg)))
+
+
+;;; CODE
+
+(defvar inferior-sml-mode-map nil)
+
+;; buffer-local
+
+(defvar sml-error-file nil) ; file from which the last error came
+(defvar sml-real-file nil) ; used for finding source errors
+(defvar sml-error-cursor nil) ; ditto
+(defvar sml-error-barrier nil) ; ditto
+
+(defun sml-proc-buffer ()
+ "Returns the current ML process buffer,
+or the current buffer if it is in `inferior-sml-mode'. Raises an error
+if the variable `sml-buffer' does not appear to point to an existing
+buffer."
+ (let ((buffer
+ (cond ((eq major-mode 'inferior-sml-mode)
+ ;; default to current buffer if it's in inferior-sml-mode
+ (current-buffer))
+ ((bufferp sml-buffer)
+ ;; buffer-name returns nil if the buffer has been killed
+ (buffer-name sml-buffer))
+ ((stringp sml-buffer)
+ ;; get-buffer returns nil if there's no buffer of that name
+ (get-buffer sml-buffer)))))
+ (or buffer
+ (error "No current process buffer. See variable sml-buffer"))))
+
+(defun sml-proc ()
+ "Returns the current ML process. See variable `sml-buffer'."
+ (let ((proc (get-buffer-process (sml-proc-buffer))))
+ (or proc
+ (error "No current process. See variable sml-buffer"))))
+
+(defun sml-buffer (echo)
+ "Make the current buffer the current `sml-buffer' if that is sensible.
+Lookup variable `sml-buffer' to see why this might be useful."
+ (interactive "P")
+ (let ((current
+ (cond ((bufferp sml-buffer) (or (buffer-name sml-buffer) "undefined"))
+ ((stringp sml-buffer) sml-buffer)
+ (t "undefined"))))
+ (if echo (message (format "ML process buffer is %s." current))
+ (let ((buffer (if (eq major-mode 'inferior-sml-mode) (current-buffer))))
+ (if (not buffer) (message (format "ML process buffer is %s." current))
+ (setq sml-buffer buffer)
+ (message (format "ML process buffer is %s." (buffer-name buffer))))))))
+
+(defun sml-noproc ()
+ "Nil iff `sml-proc' returns a process."
+ (condition-case nil (progn (sml-proc) nil) (error t)))
+
+(defun sml-proc-tidy ()
+ "Something to add to `kill-emacs-hook' to tidy up tmp files on exit."
+ (if (file-readable-p sml-temp-file)
+ (delete-file sml-temp-file)))
+
+(defun inferior-sml-mode ()
+ "Major mode for interacting with an inferior ML process.
+
+The following commands are available:
+\\{inferior-sml-mode-map}
+
+An ML process can be fired up (again) with \\[sml].
+
+Customisation: Entry to this mode runs the hooks on `comint-mode-hook'
+and `inferior-sml-mode-hook' (in that order).
+
+Variables controlling behaviour of this mode are
+
+`sml-program-name' (default \"sml\")
+ Program to run as ML.
+
+`sml-use-command' (default \"use \\\"%s\\\"\")
+ Template for loading a file into the inferior ML process.
+
+`sml-cd-command' (default \"System.Directory.cd \\\"%s\\\"\")
+ ML command for changing directories in ML process (if possible).
+
+`sml-prompt-regexp' (default \"^[\\-=] *\")
+ Regexp used to recognise prompts in the inferior ML process.
+
+`sml-temp-threshold' (default 0)
+ Controls when emacs uses temporary files to communicate with ML.
+ If an integer N, then emacs uses a temporary file whenever the
+ text is longer than N chars.
+
+`sml-temp-file' (default (make-temp-name \"/tmp/ml\"))
+ Temp file that emacs uses to communicate with the ML process.
+
+`sml-error-regexp'
+ (default -- complicated)
+ Regexp for matching error messages from the compiler.
+
+`sml-error-parser' (default 'sml-smlnj-error-parser)
+ This function parses a error messages into a 3, 4 or 5 element list:
+ (file start-line start-col (end-line end-col) err-msg).
+
+You can send text to the inferior ML process from other buffers containing
+ML source.
+ `switch-to-sml' switches the current buffer to the ML process buffer.
+ `sml-send-function' sends the current *paragraph* to the ML process.
+ `sml-send-region' sends the current region to the ML process.
+
+ Prefixing the sml-send-<whatever> commands with \\[universal-argument]
+ causes a switch to the ML process buffer after sending the text.
+
+For information on running multiple processes in multiple buffers, see
+documentation for variable `sml-buffer'.
+
+Commands:
+RET after the end of the process' output sends the text from the
+ end of process to point.
+RET before the end of the process' output copies the current line
+ to the end of the process' output, and sends it.
+DEL converts tabs to spaces as it moves back.
+TAB file name completion, as in shell-mode, etc.."
+ (interactive)
+ (kill-all-local-variables)
+ (comint-mode)
+ (setq comint-prompt-regexp sml-prompt-regexp)
+ (sml-mode-variables)
+
+ ;; For sequencing through error messages:
+ (make-local-variable 'sml-error-cursor)
+ (setq sml-error-cursor (marker-position (point-max-marker)))
+ (make-local-variable 'sml-error-barrier)
+ (setq sml-error-barrier (marker-position (point-max-marker)))
+ (make-local-variable 'sml-real-file)
+ (setq sml-real-file (cons nil 0))
+
+ (make-local-variable 'sml-use-command)
+ (make-local-variable 'sml-cd-command)
+ (make-local-variable 'sml-prompt-regexp)
+ (make-local-variable 'sml-error-parser)
+ (make-local-variable 'sml-error-regexp)
+
+ (setq major-mode 'inferior-sml-mode)
+ (setq mode-name "Inferior ML")
+ (setq mode-line-process '(": %s"))
+ (use-local-map inferior-sml-mode-map)
+ (add-hook 'kill-emacs-hook 'sml-proc-tidy)
+
+ (run-hooks 'inferior-sml-mode-hook))
+
+;;; FOR RUNNING ML FROM EMACS
+
+;;;###autoload
+(defun sml (&optional pfx)
+ "Run an inferior ML process, input and output via buffer *sml*.
+With a prefix argument, this command allows you to specify any command
+line options to pass to the complier. The command runs hook functions
+on `comint-mode-hook' and `inferior-sml-mode-hook' in that order.
+
+If there is a process already running in *sml*, just switch to that
+buffer instead.
+
+In fact the name of the buffer created is chosen to reflect the name
+of the program name specified by `sml-program-name', or entered at the
+prompt. You can have several inferior ML process running, but only one
+current one -- given by `sml-buffer' (qv).
+
+\(Type \\[describe-mode] in the process buffer for a list of commands.)"
+ (interactive "P")
+ (let ((cmd (if pfx
+ (read-string "ML command: " sml-program-name)
+ sml-program-name))
+ (args (if pfx
+ (read-string "Any args: " sml-default-arg)
+ sml-default-arg)))
+ (sml-run cmd args)))
+
+(defun sml-run (cmd arg)
+ "Run the ML program CMD with given arguments ARGS.
+This usually updates `sml-buffer' to a buffer named *CMD*."
+ (let* ((pname (file-name-nondirectory cmd))
+ (bname (format "*%s*" pname))
+ (args (if (equal arg "") () (sml-args-to-list arg))))
+ (if (comint-check-proc bname)
+ (sml-pop-to-buffer t) ;do nothing but switch buffer
+ (setq sml-buffer
+ (if (null args)
+ ;; there is a good reason for this; to ensure
+ ;; *no* argument is sent, not even a "".
+ (set-buffer (apply 'make-comint pname cmd nil))
+ (set-buffer (apply 'make-comint pname cmd nil args))))
+ (message (format "Starting \"%s\" in background." pname))
+ (inferior-sml-mode)
+ (goto-char (point-max))
+ ;; and this -- to keep these as defaults even if
+ ;; they're set in the mode hooks.
+ (setq sml-program-name cmd)
+ (setq sml-default-arg arg))))
+
+(defun sml-args-to-list (string)
+ (let ((where (string-match "[ \t]" string)))
+ (cond ((null where) (list string))
+ ((not (= where 0))
+ (cons (substring string 0 where)
+ (sml-args-to-list (substring string (+ 1 where)
+ (length string)))))
+ (t (let ((pos (string-match "[^ \t]" string)))
+ (if (null pos)
+ nil
+ (sml-args-to-list (substring string pos
+ (length string)))))))))
+
+(defun sml-temp-threshold (&optional thold)
+ "Set the variable to the given prefix (nil, if no prefix given).
+This is really mainly here to help debugging sml-mode!"
+ (interactive "P")
+ (setq sml-temp-threshold
+ (if current-prefix-arg (prefix-numeric-value thold)))
+ (message "%s" sml-temp-threshold))
+
+;;;###autoload
+(defun switch-to-sml (eob-p)
+ "Switch to the ML process buffer.
+With prefix argument, positions cursor at point, otherwise at end of buffer."
+ (interactive "P")
+ (sml-pop-to-buffer t)
+ (cond ((not eob-p)
+ (push-mark (point) t)
+ (goto-char (point-max)))))
+
+;; Fakes it with a "use <temp-file>;" if necessary.
+
+;;;###autoload
+(defun sml-send-region (start end &optional and-go)
+ "Send current region to the inferior ML process.
+Prefix argument means switch-to-sml afterwards.
+
+If the region is longer than `sml-temp-threshold' and the variable
+`sml-use-command' is defined, the region is written out to a temporary file
+and a \"use <temp-file>\" command is sent to the compiler\; otherwise the
+text in the region is sent directly to the compiler. In either case a
+trailing \"\;\\n\" will be added automatically.
+
+See variables `sml-temp-threshold', `sml-temp-file' and `sml-use-command'."
+ (interactive "r\nP")
+ (if (sml-noproc) (save-excursion (sml t)))
+ (cond ((equal start end)
+ (message "The region is zero (ignored)"))
+ ((and sml-use-command
+ (numberp sml-temp-threshold)
+ (< sml-temp-threshold (- end start)))
+ ;; Just in case someone is still reading from sml-temp-file:
+ (if (file-exists-p sml-temp-file)
+ (delete-file sml-temp-file))
+ (write-region start end sml-temp-file nil 'silently)
+ (sml-update-barrier (buffer-file-name (current-buffer)) start)
+ (sml-update-cursor (sml-proc-buffer))
+ (comint-send-string (sml-proc)
+ (concat (format sml-use-command sml-temp-file) ";\n")))
+ (t
+ (comint-send-region (sml-proc) start end)
+ (comint-send-string (sml-proc) ";\n")))
+ (if and-go (switch-to-sml nil)))
+
+;; Update the buffer-local variables sml-real-file and sml-error-barrier
+;; in the process buffer:
+
+(defun sml-update-barrier (file pos)
+ (let ((buf (current-buffer)))
+ (unwind-protect
+ (let* ((proc (sml-proc))
+ (pmark (marker-position (process-mark proc))))
+ (set-buffer (process-buffer proc))
+ ;; update buffer local variables
+ (setq sml-real-file (and file (cons file pos)))
+ (setq sml-error-barrier pmark))
+ (set-buffer buf))))
+
+;; Update the buffer-local error-cursor in proc-buffer to be its
+;; current proc mark.
+
+(defun sml-update-cursor (proc-buffer) ;always= sml-proc-buffer
+ (let ((buf (current-buffer)))
+ (unwind-protect
+ (let* ((proc (sml-proc)) ;just in case?
+ (pmark (marker-position (process-mark proc))))
+ (set-buffer proc-buffer)
+ ;; update buffer local variable
+ (setq sml-error-cursor pmark))
+ (set-buffer buf))))
+
+;; This is quite bogus, so it isn't bound to a key by default.
+;; Anyone coming up with an algorithm to recognise fun & local
+;; declarations surrounding point will do everyone a favour!
+
+(defun sml-send-function (&optional and-go)
+ "Send current paragraph to the inferior ML process.
+With a prefix argument switch to the sml buffer as well
+\(cf. `sml-send-region'\)."
+ (interactive "P")
+ (save-excursion
+ (sml-mark-function)
+ (sml-send-region (point) (mark)))
+ (if and-go (switch-to-sml nil)))
+
+;;;###autoload
+(defun sml-send-buffer (&optional and-go)
+ "Send buffer to inferior shell running ML process.
+With a prefix argument switch to the sml buffer as well
+\(cf. `sml-send-region'\)."
+ (interactive "P")
+ (if (memq major-mode sml-source-modes)
+ (sml-send-region (point-min) (point-max) and-go)))
+
+;; Since sml-send-function/region take an optional prefix arg, these
+;; commands are redundant. But they are kept around for the user to
+;; bind if she wishes, since its easier to type C-c r than C-u C-c C-r.
+
+(defun sml-send-region-and-go (start end)
+ "Send current region to the inferior ML process, and go there."
+ (interactive "r")
+ (sml-send-region start end t))
+
+(defun sml-send-function-and-go ()
+ "Send current paragraph to the inferior ML process, and go there."
+ (interactive)
+ (sml-send-function t))
+
+
+;;; Mouse control and handling dedicated frames for Inferior ML
+
+;; simplified from frame.el in Emacs: special-display-popup-frame...
+
+;; Display BUFFER in its own frame, reusing an existing window if any.
+;; Return the window chosen.
+
+(defun sml-display-popup-frame (buffer &optional args)
+ (let ((window (get-buffer-window buffer t)))
+ (if window
+ ;; If we have a window already, make it visible.
+ (let ((frame (window-frame window)))
+ (make-frame-visible frame)
+ (raise-frame frame)
+ window)
+ ;; otherwise no window yet, make one in a new frame.
+ (let* ((frame (make-frame (append args sml-display-frame-alist)))
+ (window (frame-selected-window frame)))
+ (set-window-buffer window buffer)
+ ;; XEmacs mostly ignores this
+ (set-window-dedicated-p window t)
+ window))))
+
+(defun sml-proc-frame ()
+ "Returns the current ML process buffer's frame, or creates one first."
+ (let ((buffer (sml-proc-buffer)))
+ (window-frame
+ (or
+ ;; if its already displayed on some frame, take that as default...
+ (get-buffer-window buffer t)
+ ;; ...irrespective of what sml-dedicated-frame says, otherwise
+ ;; create a new frame (or raise an old one) perhaps...
+ (and sml-dedicated-frame
+ (sml-display-popup-frame buffer
+ (list (cons 'icon-name buffer)
+ '(unsplittable . t))))
+ ;; ...or default to the current frame anyway.
+ (frame-selected-window)))))
+
+(defun sml-pop-to-buffer (warp)
+ "(Towards) handling multiple frames properly.
+Raises the frame, and warps the mouse over there, only if WARP is non-nil."
+ (let ((current (window-frame (selected-window)))
+ (buffer (sml-proc-buffer)))
+ (let ((frame (sml-proc-frame)))
+ (if (eq current frame)
+ (pop-to-buffer buffer) ; stay on the same frame.
+ (select-frame frame) ; XEmacs sometimes moves focus.
+ (select-window (get-buffer-window buffer)) ; necc. for XEmacs
+ ;; (raise-frame frame)
+ (if warp (sml-warp-mouse frame))))))
+
+
+;;; H A C K A T T A C K ! X E M A C S V E R S U S E M A C S
+
+;; Only these two functions have to dance around the inane differences
+;; between Emacs and XEmacs (fortunately)
+
+(defun sml-warp-mouse (frame)
+ "Warp the pointer across the screen to upper right corner of FRAME."
+ (raise-frame frame)
+ (cond ((string-match "\\(Lucid\\|XEmacs\\)" emacs-version)
+ ;; LUCID (19.10) or later... set-m-pos needs a WINDOW
+ (set-mouse-position (frame-root-window frame) (1- (frame-width)) 0))
+ (t
+ ;; GNU, post circa 19.19... set-m-pos needs a FRAME
+ (set-mouse-position frame (1- (frame-width)) 0)
+ ;; probably not needed post 19.29
+ (if (fboundp 'unfocus-frame) (unfocus-frame)))))
+
+(defun sml-drag-region (event)
+ "Highlight the text the mouse is dragged over, and send it to ML.
+This must be bound to a button-down mouse event, currently \\[sml-drag-region].
+
+If you drag the mouse (ie, keep the mouse button depressed) the
+program text sent to the complier is delimited by where you started
+dragging the mouse, and where you release the mouse button.
+
+If you only click the mouse, the program text sent to the compiler is
+delimited by the current position of point and the place where you
+click the mouse.
+
+In either event, the values of both point and mark are left
+undisturbed once this operation is completed."
+ (interactive "e")
+ (let ((mark-ring) ;BAD: selection start gets cons'd
+ (pmark (point))) ;where point is now
+ (if (fboundp 'mouse-track-default)
+ ;; Assume this is XEmacs, otherwise assume its Emacs
+ (save-excursion
+ (let ((zmacs-regions))
+ (set-marker (mark-marker) nil)
+ (mouse-track-default event)
+ (if (not (region-exists-p)) (push-mark pmark nil t))
+ (call-interactively 'sml-send-region)))
+ ;; Emacs: making this buffer-local ought to happen in sml-mode
+ (make-local-variable 'transient-mark-mode)
+ (save-excursion
+ (let ((transient-mark-mode 1))
+ (mouse-drag-region event)
+ (if (not mark-active) (push-mark pmark nil t))
+ (call-interactively 'sml-send-region))))))
+
+
+;;; LOADING AND IMPORTING SOURCE FILES:
+
+(defvar sml-source-modes '(sml-mode)
+ "*Used to determine if a buffer contains ML source code.
+If it's loaded into a buffer that is in one of these major modes, it's
+considered an ML source file by `sml-load-file'. Used by these commands
+to determine defaults.")
+
+(defvar sml-prev-l/c-dir/file nil
+ "Caches the (directory . file) pair used in the last `sml-load-file'
+or `sml-cd' command. Used for determining the default in the next one.")
+
+;;;###autoload
+(defun sml-load-file (&optional and-go)
+ "Load an ML file into the current inferior ML process.
+With a prefix argument switch to sml buffer as well.
+
+This command uses the ML command template `sml-use-command' to construct
+the command to send to the ML process\; a trailing \"\;\\n\" will be added
+automatically."
+ (interactive "P")
+ (if (sml-noproc) (save-excursion (sml t)))
+ (if sml-use-command
+ (let ((file
+ (car (comint-get-source "Load ML file: " sml-prev-l/c-dir/file
+ sml-source-modes t))))
+ ;; Check if buffer needs saved. Should (save-some-buffers) instead?
+ (comint-check-source file)
+ (setq sml-prev-l/c-dir/file
+ (cons (file-name-directory file) (file-name-nondirectory file)))
+ (sml-update-cursor (sml-proc-buffer))
+ (comint-send-string
+ (sml-proc) (concat (format sml-use-command file) ";\n")))
+ (message "Can't load files if `sml-use-command' is undefined!"))
+ (if and-go (switch-to-sml nil)))
+
+(defun sml-cd (dir)
+ "Change the working directory of the inferior ML process.
+The default directory of the process buffer is changed to DIR. If the
+variable `sml-cd-command' is non-nil it should be an ML command that will
+be executed to change the compiler's working directory\; a trailing
+\"\;\\n\" will be added automatically."
+ (interactive "DSML Directory: ")
+ (let* ((buf (sml-proc-buffer))
+ (proc (get-buffer-process buf))
+ (dir (expand-file-name dir)))
+ (save-excursion
+ (set-buffer buf)
+ (if sml-cd-command
+ (process-send-string proc
+ (concat (format sml-cd-command dir) ";\n")))
+ (cd dir))
+ (setq sml-prev-l/c-dir/file (cons dir nil))))
+
+;;; PARSING ERROR MESSAGES
+
+;; to a very large extent "find-file-other-window" works admirably when the
+;; compiler is running in a dedicated, *unsplittable* window, and so all
+;; the goop in sml-file-other-frame-or-window is of questionable worth.
+;; unhappily, XEmacs doesn't (yet, will it ever?) implement the window
+;; unsplittable property, hence this nonsense...
+
+(defun sml-file-other-frame-or-window (file &optional window)
+ "Find or make another frame on which to display FILE.
+Start in ML interaction buffer, by hypothesis, and try not to use
+this window to display the file (with bugs in it). FILE may already
+be on display somewhere, so use that frame by default; otherwise,
+try to find a window that is displaying an sml buffer; if there is
+no such frame/window, find the nearest non-dedicated buffer or,
+in the last resort, create a whole new frame.
+
+If optional WINDOW is supplied, just use that window to display FILE."
+ (if window
+ (progn ; just reuse it
+ (set-window-buffer window (find-file-noselect file))
+ (select-window window)) ; assume "this" frame's selected)
+ (let* ((buf (find-file-noselect file))
+ (win (get-buffer-window buf t))
+ (frm (if win (window-frame win))))
+ (if frm
+ ;; buf is displayed in win on some frame: select frame & window
+ (progn (select-window win) (raise-frame (select-frame frm)))
+ (let* ((frame (selected-frame)) ;current frame & window
+ (window (selected-window)))
+ ;; look through all (but minibuffer) windows for an sml buffer
+ (while (and (not (eq window
+ (select-window
+ (previous-window (selected-window) 'mini t))))
+ (not (memq major-mode sml-source-modes))))
+ (if (not (eq window (selected-window)))
+ ;; found window displaying an sml buffer: use that window & frame
+ (raise-frame (select-frame (window-frame (selected-window))))
+ ;; otherwise, cycle through frames looking for a spare one
+ ;; select-frame also selects the top (or root) window
+ (while (and (not (eq frame (select-frame (previous-frame
+ (selected-frame) nil))))
+ (window-dedicated-p (selected-window))))
+ ;; if no suitable frame, create one and (belt & braces) select it
+ (if (eq frame (selected-frame))
+ ;; sml-dedicated-frame iff window-dedicated-p (selected-window)
+ (if sml-dedicated-frame
+ (progn
+ (sml-warp-mouse (select-frame (make-frame)))
+ (set-window-buffer
+ (frame-selected-window (selected-frame)) buf))
+ (switch-to-buffer-other-window buf))
+ (raise-frame (selected-frame))))
+ (switch-to-buffer buf))))))
+
+;; This should need no modification to support other compilers.
+
+;;;###autoload
+(defun sml-next-error (skip)
+ "Find the next error by parsing the inferior ML buffer.
+A prefix argument means `sml-skip-errors' (qv) instead.
+
+Move the error message on the top line of the window\; put the cursor
+\(point\) at the beginning of the error source.
+
+If the error message specifies a range, and `sml-error-parser' returns
+the range, the mark is placed at the end of the range. If the variable
+`sml-error-overlay' is non-nil, the region will also be highlighted.
+
+If `sml-error-parser' returns a fifth component this is assumed to be
+a string to indicate the nature of the error: this will be echoed in
+the minibuffer.
+
+Error interaction only works if there is a real file associated with
+the input -- though of course it also depends on the compiler's error
+messages \(also see documantation for `sml-error-parser'\).
+
+However: if the last text sent went via `sml-load-file' (or the temp
+file mechanism), the next error reported will be relative to the start
+of the region sent, any error reports in the previous output being
+forgotten. If the text went directly to the compiler the succeeding
+error reported will be the next error relative to the location \(in
+the output\) of the last error. This odd behaviour may have a use...?"
+ (interactive "P")
+ (if skip (sml-skip-errors) (sml-do-next-error)))
+
+(defun sml-bottle (msg)
+ "Function to let `sml-next-error' give up gracefully."
+ (sml-warp-mouse (selected-frame))
+ (error msg))
+
+(defun sml-do-next-error ()
+ "The buisiness end of `sml-next-error' (qv)"
+ (let ((case-fold-search nil)
+ ;; set this variable iff we called sml-next-error in a SML buffer
+ (sml-window (if (memq major-mode sml-source-modes) (selected-window)))
+ (proc-buffer (sml-proc-buffer)))
+ ;; undo (don't destroy) the previous overlay to be tidy
+ (sml-error-overlay 'undo 1 1
+ (and sml-error-file (get-file-buffer sml-error-file)))
+ ;; go to interaction buffer but don't raise it's frame
+ (sml-pop-to-buffer nil)
+ ;; go to the last remembered error, and search for the next one.
+ (goto-char sml-error-cursor)
+ (if (not (re-search-forward sml-error-regexp (point-max) t))
+ ;; no more errors -- move point to the sml prompt at the end
+ (progn
+ (goto-char (point-max))
+ (if sml-window (select-window sml-window)) ;return there, perhaps
+ (message "No error message(s) found."))
+ ;; error found: point is at end of last match; set the cursor posn.
+ (setq sml-error-cursor (point))
+ ;; move the SML window's text up to this line
+ (set-window-start (get-buffer-window proc-buffer) (match-beginning 0))
+ (let* ((pos)
+ (parse (funcall sml-error-parser (match-beginning 0)))
+ (file (nth 0 parse))
+ (line0 (nth 1 parse))
+ (col0 (nth 2 parse))
+ (line/col1 (nth 3 parse))
+ (msg (nth 4 parse)))
+ ;; Give up immediately if the error report is scribble
+ (if (or (null file) (null line0))
+ (sml-bottle "Failed to parse/locate this error properly!"))
+ ;; decide what to do depending on the file returned
+ (if (string= file "std_in")
+ ;; presently a fundamental limitation i'm afraid.
+ (sml-bottle "Sorry, can't locate errors on std_in.")
+ (if (string= file sml-temp-file)
+ ;; errors found in tmp file; seek the real file
+ (if (< (point) sml-error-barrier)
+ ;; weird. user cleared *sml* and use'd the tmp file?
+ (sml-bottle "Temp file error report is not current.")
+ (if (not (car sml-real-file))
+ ;; sent from a buffer w/o a file attached.
+ ;; DEAL WITH THIS EVENTUALLY.
+ (sml-bottle "No real file associated with the temp file.")
+ ;; real file and error-barrier
+ (setq file (car sml-real-file))
+ (setq pos (cdr sml-real-file))))))
+ (if (not (file-readable-p file))
+ (sml-bottle (concat "Can't read " file))
+ ;; instead of (find-file-other-window file) to lookup the file
+ (sml-file-other-frame-or-window file sml-window)
+ ;; no good if the buffer's narrowed, still...
+ (goto-char (or pos 1)) ; line 1 if no tmp file
+ (forward-line (1- line0))
+ (forward-char (1- col0))
+ ;; point is at start of error text; seek the end.
+ (let ((start (point))
+ (end (and line/col1
+ (condition-case nil
+ (progn (eval line/col1) (point))
+ (error nil)))))
+ ;; return to start anyway
+ (goto-char start)
+ ;; if point went to end, put mark there, and maybe highlight
+ (if end (progn (push-mark end t)
+ (sml-error-overlay nil start end)))
+ (setq sml-error-file file) ; remember this for next time
+ (if msg (message msg)))))))) ; echo the error/warning message
+
+(defun sml-skip-errors ()
+ "Skip past the rest of the errors."
+ (interactive)
+ (if (memq major-mode sml-source-modes) (sml-error-overlay 'undo))
+ (sml-update-cursor (sml-proc-buffer))
+ (if (eq major-mode 'sml-inferior-mode) (goto-char (point-max))))
+
+;;; Set up the inferior mode keymap, using sml-mode bindings...
+
+(cond ((not inferior-sml-mode-map)
+ (setq inferior-sml-mode-map
+ (copy-keymap comint-mode-map))
+ (install-sml-keybindings inferior-sml-mode-map)
+ (define-key inferior-sml-mode-map "\C-c\C-s" 'sml)
+ (define-key inferior-sml-mode-map "\t" 'comint-dynamic-complete)))
+
+;;; H A C K A T T A C K ! X E M A C S / E M A C S K E Y S
+
+(if window-system
+ (cond ((string-match "\\(Lucid\\|XEmacs\\)" emacs-version)
+ ;; LUCID (19.10) or later...
+ (define-key sml-mode-map '(meta shift button1) 'sml-drag-region))
+ (t
+ ;; GNU, post circa 19.19
+ (define-key sml-mode-map [M-S-down-mouse-1] 'sml-drag-region))))
+
+;;; ...and do the user's customisations.
+
+(run-hooks 'inferior-sml-load-hook)
+
+;;; Here is where sml-proc.el ends
--- /dev/null
+;;; sml-site.el. Site initialisation for sml-mode
+
+;; Copyright (C) 1997, Matthew J. Morley
+;; Thanks to Ken Larsen <kla@it.dtu.dk> for his suggestions.
+
+;; This file is not part of GNU Emacs, but it is distributed under the
+;; same conditions.
+
+;; ====================================================================
+
+;; This program is free software; you can redistribute it and/or
+;; modify it under the terms of the GNU General Public License as
+;; published by the Free Software Foundation; either version 2, or (at
+;; your option) any later version.
+
+;; This program is distributed in the hope that it will be useful, but
+;; WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+;; General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs; see the file COPYING. If not, write to the
+;; Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
+
+;; ====================================================================
+
+;;; DESCRIPTION
+
+;; This file is provided for site administrators to install and
+;; configure sml-mode for the convenience of all their users. Even if
+;; you only install sml-mode for your private use, this is still a
+;; good place to do the necessary configuration.
+
+;; Follow the comments below to set the (few) necessary defaults; add
+;; any other configurations to the end of the file. Users just need to
+;; put
+
+;; (require 'sml-site)
+
+;; in their .emacs files (along with any personal customisations).
+;; Make sure this file is on the user's *default* load-path!
+
+;;; CODE
+
+;; *******************
+;; sml-lisp-directory:
+;; *******************
+
+;; This is where the sml-mode lisp (.el and/or .elc) files are to be
+;; kept. It is used for no purpose other than resetting the load-path
+;; variable. Site administrators might consider setqing this in their
+;; site-init.el file instead.
+
+;; A subdirectory of site-lisp directory seems a reasonable place...
+
+(defvar sml-lisp-directory "/usr/local/share/emacs/site-lisp/sml-mode"
+ "*The directory where sml-mode lisp files are located.
+Used in sml-site.el in resetting the Emacs lisp `load-path' (qv).")
+
+(if (member sml-lisp-directory load-path)
+ () ;take no prisoners
+ (setq load-path (cons sml-lisp-directory load-path)))
+
+;; ****************
+;; auto-mode-alist:
+;; ****************
+
+;; Buffers for files that end with these extensions will be placed in
+;; sml-mode automatically.
+
+(if (rassoc 'sml-mode auto-mode-alist)
+ () ;assume user has her own ideas
+ (setq auto-mode-alist
+ (append '(("\\.sml$" . sml-mode)
+ ("\\.ML$" . sml-mode)
+ ("\\.sig$" . sml-mode)) auto-mode-alist)))
+
+;; **************
+;; sml-mode-info:
+;; **************
+
+;; This is where sml-mode will look for it's online documentation.
+
+;; The default value in sml-mode.el is "sml-mode" which is correct if
+;; sml-mode.info is placed somewhere on Emacs' default info directory
+;; path. If you move sml-mode.info to the root of the site's info
+;; hierarchy don't forget to add a `dir' file menu entry like
+
+;; * SML: (sml-mode). Editing & Running Standard ML from Emacs
+
+;; If you can't (or won't) move the .info file onto the default info
+;; directory path, uncomment this defvar and set the full name here.
+
+;;(defvar sml-mode-info "/usr/???/sml-mode" "*Where to find sml-mode Info.")
+
+;; *****************
+;; sml-program-name:
+;; *****************
+
+;; sml-mode (sml-proc.el) defaults all its complier settings to SML/NJ
+;; (0.93, in this release of sml-mode). If the New Jersey compiler is
+;; called anything other than "sml" at your site, uncomment this
+;; defvar and set the correct name here.
+
+;;(defvar sml-program-name "sml" "*Program to run as ML.")
+
+;; The info file (Configuration) explains how to set up sml-mode for
+;; use with other ML compilers. Point users in that direction.
+
+;;; AUTOLOADS
+
+(autoload 'sml-mode "sml-mode" "Major mode for editing Standard ML." t)
+(autoload 'sml "sml-proc" "Run an inferior ML process." t)
+
+;; By all means set up Moscow ML and/or Poly/ML to autoload, but first
+;; check that "mosml" and/or "poly" appear on the user's default PATH.
+
+(autoload 'sml-mosml "sml-mosml" "Set up and run Moscow ML." t)
+(autoload 'sml-poly-ml "sml-poly-ml" "Set up and run Poly/ML." t)
+
+;; If they don't, users will winge until they discover how to change
+;; their PATH, or redefine sml-program-name, for themselves.
+
+;; Then
+
+(provide 'sml-site)
+
+;; and tell users to (require 'sml-site) in their .emacs files for the
+;; above to take effect. Byte compile this file or not, as you wish.
+
+;;; sml-site.el endeth.
+