Path: utzoo!utgpu!watmath!uunet!tut.cis.ohio-state.edu!mailrus!rutgers!deimos!ksuvax1!lbn
From: lbn@ksuvax1.cis.ksu.edu (Lars Bo Nielsen)
Newsgroups: gnu.emacs
Subject: Major mode for editing and running (Standard) ML. (Code incl.)
Message-ID: <1356@ksuvax1.cis.ksu.edu>
Date: 16 Dec 88 02:23:07 GMT
Reply-To: lbn@ksuvax1.cis.ksu.edu (Lars Bo Nielsen)
Organization: Kansas State University, Dept of Computing & Information Sciences
Lines: 697

Here is my Christmas Present for emacs and (Standard) ML users. A
major mode for editing and running (Standard) ML.

This is a first release.

Please keep me informed if you find any bugs, make any fixes, have
some idears or suggestions, or just want to thank me.

---
 Lars Bo Nielsen
 Internet: lbn@ksuvax1.cis.ksu.edu
 UUCP: ..!rutgers!ksuvax1!lbn -or- ..!{pyramid,ucsd}!ncr-sd!ncrwic!ksuvax1!lbn
------------------------------------------------------------------------------
;; sml-mode.el. Major mode for editing Standard ML.
;; Copyright (C) 1988 Free Software Foundation, Inc. and Lars Bo Nielsen

;; This file is not officially part of GNU Emacs.

;; GNU Emacs is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY.  No author or distributor
;; accepts responsibility to anyone for the consequences of using it
;; or for whether it serves any particular purpose or works at all,
;; unless he says so in writing.  Refer to the GNU Emacs General Public
;; License for full details.

;; Everyone is granted permission to copy, modify and redistribute
;; GNU Emacs, but only under the conditions described in the
;; GNU Emacs General Public License.   A copy of this license is
;; supposed to have been given to you along with GNU Emacs so you
;; can know your rights and responsibilities.  It should be in a
;; file named COPYING.  Among other things, the copyright notice
;; and this notice must be preserved on all copies.

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; 
;;     SML Mode. A major mode for editing and running Standard ML.
;;     ===========================================================
;; 
;; 
;; HOW TO USE THE SML-MODE
;; 
;; To use the sml-mode, insert this in your "~/.emacs" file:
;; 
;;   (setq auto-mode-alist (cons '("\\.sml$" . sml-mode) 
;;                          auto-mode-alist)) 
;;   (autoload 'sml-mode "sml-mode" "Major mode for editing SML." t)
;; 
;; After specifying the correct path for emacs to look for the file. Now
;; every time a file with the extension `.sml' is found, it is
;; automaticly started up in sml-mode (You may also want to byte-compile
;; the file (M-x byte-compile-file) for speed).
;; 
;; You are now ready to start using sml-mode. If you have tried other
;; language modes (like lisp-mode or C-mode), you should have no
;; problems. There are only a few extra functions in this mode.
;; 
;; M-| (sml-electric-pipe).  In the case you are typing in a case
;; expression, a function with patterns etc., this function will give you
;; some help. First of all it will put the `|' on a line by it self. If
;; it is used in the definition of a function it inserts the functions
;; name, else it inserts `=>'.  Just try it, you will like it.
;; 
;; C-RET (reindent-then-newline-and-indent).  This is probably the
;; function you will be using the most (press CTRL while you press
;; Return). It will reindent the line, then make a new line and perform a
;; new indentation.
;; 
;; TAB (sml-indent-line).  This function indents the current line.
;; 
;; C-c C-s (sml-shell). This command starts up an inferior shell running
;; sml. If the shell is running, it will just pop up the shell window.
;; (See INFERIOR SHELL).
;; 
;; C-c C-r (sml-send-region). Will send region, from point to mark, to
;; the inferior shell running sml. (See INFERIOR SHELL).
;; 
;; C-c C-f (sml-run-on-file).  Will send a "use file" to the inferior
;; shell running sml. (See INFERIOR SHELL).
;; 
;; C-c C-c (sml-send-function). Will send function to the inferior shell
;; running sml. (This only sends the paragraph, so you might prefer the
;; sml-send-region instead. Paragraphs are seperated by blank lines
;; only). (See INFERIOR SHELL)
;; 
;; C-c C-b (sml-send-buffer). Will send whole buffer to inferior shell
;; running sml.
;;
;; C-c C-v (sml-mode-version). Get the current version of sml-mode.
;; 
;; 
;; INDENTATION
;; 
;; It is very difficult to calculate the correct indentation for sml
;; code, as the language isn't stricktly block oriented (In Lisp
;; forexample all blocks is surrounded by `(' and `)', while in C blocks
;; are surrounded by `{' and `}') So trying to determine the indentation
;; for a line of sml-code can be a tricky problem. And then again, people
;; tend to have different ways to indent their code.  All in all, I
;; decided the proper way to indent sml-code, and if you want another
;; kind of indentation, you would have to patch the code.  To give you a
;; ide of how the indentation is performed, I will give you some of the
;; rules I have used.
;; 
;;   - If a line appears after one of the starting keywords (ex. `fun',
;; `local', `let', `if', `sig' etc.), it is indented (The starting
;; keywords is found in the constant `sml-indent-starters-reg').  Except
;; if it starts a new function, value, signature etc. Then the line is
;; indented according to other starters (these keywords is found in
;; `sml-starters-reg').
;; 
;;   - The `end' keyword is lined up with its matching keyword 
;; (`let', `local', `sig' or `struct').  The `in' keywords is lined up
;; with its matching keywords (being either `local' or `let'). The
;; `else' and `then' keywords is lined up with the matching `if'
;; keyword. (To find the matching keyword can take some time if you
;; are editing a large file, so be patient)
;; 
;; The amount of indentation is found in the constant `sml-indent-level'.
;; The default value is 4.  Another constant, `sml-pipe-indent', is the
;; extra amount to indent a line starting with `|' (ex.  in case
;; patterns).  The default value is -2. (See CUSTOMIZING YOUR SML-MODE)
;; 
;; If the indentation algorithm should take into account all the
;; variations one could write a piece of sml-code, the algorithm would be
;; so large and slow that it would be of no use.  So what I am trying to
;; say is: "The indentation algorithm can be fooled."  But if you just
;; write your code as if it was to be read by another human being, you
;; should not be in trouble.  As I have mentioned, I have picked "the
;; right way" to indent sml code. Here are some small rules to follow:
;; 
;;  - Have `let', `local', `if', `fun' etc. at the beginning of a line.
;; And have `case-exp-of' on one line by itself.
;; 
;;  - The "proper" way to write functions is with the `=' at the end of
;; the line, and the body following on a new line.
;; 
;; If you would like the code to be indented differently, please send me
;; your suggestions/fixes/comments, and I will try to please everybody.
;; As you might know, this is not easy.
;; 
;; 
;; INFERIOR SHELL.
;; 
;; The mode for Standard ML also contains a mode for an inferior shell
;; running sml. The mode is the same as the shell-mode, with just one
;; extra command:
;; 
;; C-c C-f (sml-run-on-file).  Send a `use file' to the process running
;; sml.
;; 
;; Because sml is called differently on various machines, and the
;; sml-systems have their own command for reading in a file, a set of
;; constants controls the behavior of the inferior shell running sml (to
;; change these constants: See CUSTOMIZING YOUR SML-MODE below).
;; 
;; sml-prog-name (default "sml").
;; This constant is a string, containing the command to invoke Standard
;; ML on your system.
;; 
;; sml-use-right-delim (default "\"")
;; sml-use-left-delim  (default "\"")
;; The left and right delimitter uses by your version of sml, for `use
;; file-name'.
;; 
;; sml-process-name (default "SML"). 
;; The name of the process running sml. (This will be the name appearing
;; on the mode line of the buffer)
;;
;; NOTE: The sml-mode functions: sml-send-buffer, sml-send-function
;; and sml-send-region, creates temporary files. I could not figure
;; out how to send large amounts of data to a process
;; 
;; 
;; CUSTOMIZING YOUR SML-MODE
;; 
;; If you have to change some of the constants, you will have to add a
;; `hook' to the sml-mode. Insert this in your "~/.emacs" file.
;; 
;;   (setq sml-mode-hook 'my-sml-constants)
;; 
;; Your function `my-sml-constants' will be executed every time
;; `sml-mode' is invoked.  Now you only have to write the emacs-lisp
;; function `my-sml-constants', and put it in your "~/.emacs" file.
;; 
;; Say you are running a version of sml that uses the syntax
;; `use ["file"]' and is invoked by the command `OurSML', your
;; function should look like this:
;; 
;;   (defun my-sml-constants ()
;;      (setq sml-prog-name "OurSML")
;;      (setq sml-use-right-delim "]\"")
;;      (setq sml-use-left-delim "\"]"))
;; 
;; Other things could be added to this function. As an example:
;; 
;;   (defun my-sml-constants ()
;;      (setq sml-prog-name "OurSML")
;;      (setq sml-use-right-delim "]\"")
;;      (setq sml-use-left-delim "\"]")
;;      (turn-on-auto-fill)		; Turn on auto-fill
;;      (setq sml-indent-level 8))	; change the indentation to 8
;; 
;; The sml-shell also runs a `hook' (sml-shell-hook) when it is invoked.
;; 
;; 
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;
;; AUTHOR
;;         Lars Bo Nielsen
;;         Aalborg University
;;         Computer Science Dept.
;;         9000 Aalborg
;;         Denmark
;;         lbn@iesd.dk  (...!mcvax!diku!iesd!lbn)
;;
;; NOTE:   Current email-address (until May 1. 1989):
;;
;;         lbn@ksuvax1.cis.ksu.edu
;;         (..!rutgers!ksuvax1!lbn 
;;          or:   ..!{pyramid,ucsd}!ncr-sd!ncrwic!ksuvax1!lbn)
;; 
;; Please let me know if you come up with any ideas, bugs, or fixes.
;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;


(defconst sml-mode-version-string
  "SML-MODE, Version 1.0. 1988 - Lars Bo Nielsen.")

(defvar sml-mode-syntax-table nil "The syntax table used in sml-mode.")

(defvar sml-mode-map nil "The mode map used in sml-mode.")

(defun sml-mode ()
  "Major mode for editing SML code.

Tab indents for SML code.
Comments are delimited with (* ... *).
Paragraphs are separated by blank lines only.
Delete converts tabs to spaces as it moves back.
\\{sml-mode-map}
Variables controlling the indentation:

 sml-indent-level (default 4)
    The indentation of a block of code.

 sml-pipe-indent (default -2)
    Extra indentation of a line starting with \"|\".

Runs sml-mode-hook if non nil."
  (interactive)
  (kill-all-local-variables)
  (if sml-mode-map
      ()
    (setq sml-mode-map (make-sparse-keymap))
    (define-key sml-mode-map "\C-c\C-v" 'sml-mode-version)
    (define-key sml-mode-map "\C-c\C-s" 'sml-shell)
    (define-key sml-mode-map "\C-c\C-r" 'sml-send-region)
    (define-key sml-mode-map "\C-c\C-f" 'sml-run-on-file)
    (define-key sml-mode-map "\C-c\C-c" 'sml-send-function)
    (define-key sml-mode-map "\C-c\C-b" 'sml-send-buffer)
    (define-key sml-mode-map "\e|" 'sml-electric-pipe)
    (define-key sml-mode-map "\C-j" 'reindent-then-newline-and-indent)
    (define-key sml-mode-map "\177" 'backward-delete-char-untabify)
    (define-key sml-mode-map "\t" 'sml-indent-line))
  (use-local-map sml-mode-map)
  (setq major-mode 'sml-mode)
  (setq mode-name "SML")
  (define-abbrev-table 'sml-mode-abbrev-table ())
  (setq local-abbrev-table sml-mode-abbrev-table)
  (if sml-mode-syntax-table
      ()
    (setq sml-mode-syntax-table (make-syntax-table))
    ;; Adding these will fool the matching of parans. I really don't
    ;; know why.
    ;; (modify-syntax-entry ?\( "()1" sml-mode-syntax-table)
    ;; (modify-syntax-entry ?\) ")(4" sml-mode-syntax-table)
    ;; 
    ;; Maybe we will nead some more modifications to the syntax table.
    ;; (like the symbols that can be used in identifiers).
    (modify-syntax-entry ?\\ "\\" sml-mode-syntax-table)
    (modify-syntax-entry ?* ". 23" sml-mode-syntax-table))
  (set-syntax-table sml-mode-syntax-table)
  (make-local-variable 'paragraph-start)
  (setq paragraph-start (concat "^$\\|" 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 'require-final-newline)
  (setq require-final-newline t)
  (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-hook)
  (setq comment-indent-hook 'sml-comment-indent)
  (make-local-variable 'parse-sexp-ignore-comments)
  (setq parse-sexp-ignore-comments t)
  (run-hooks 'sml-mode-hook))

(defconst sml-pipe-matchers-reg
  "\\bcase\\b\\|\\bfn\\b\\|\\bfun\\b\\|\\bhandle\\b\
\\|\\bdatatype\\b\\|\\babstype\\b")

(defun sml-electric-pipe ()
  (interactive)
  (let ((here (point))
	(match (save-excursion
		 (sml-backward-sexp 1)
		 (sml-re-search-backward 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 
				 (re-search-forward "[\t\n ]" nil t)
				 (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))))
    (insert tmp)
    (sml-indent-line)
    (forward-char (1+ (length tmp)))
    (if case-or-handle-exp
	(forward-char -4))))

(defun sml-mode-version ()
  (interactive)
  (message sml-mode-version-string))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; Indentation
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(defconst sml-indent-level 4
  "Indentation of begin-end blocks in sml.")

(defconst sml-pipe-indent -2
  "Ekstra (negative) indentation for lines beginning with |.")

(defun sml-indent-line ()
  "Indent current line. If line was properly indented do nothing, if
lines indentation is corrected, place cursor at first letter on line."
  (interactive)
    (let ((indent (sml-calculate-indentation)))
      (if (/= (current-indentation) indent)
	  (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 ")))))

;;; THE RESERVED WORDS in SML:
;;; abstraction abstype and andalso
;;; as case datatype else end exception do fn fun functor handle if in 
;;; infix infixr let local nonfix of op open raise rec sharing sig signature
;;; struct structure then type val while withtype orelse

(defconst sml-indent-starters-reg
  "abstraction\\b\\|abstype\\b\\|and\\b\\|case\\b\\|datatype\\b\
\\|else\\b\\|fun\\b\\|functor\\b\\|if\\b\
\\|in\\b\\|infix\\(\\|r\\)\\b\\|let\\b\\|local\\b\
\\|nonfix\\b\\|of\\b\\|open\\b\\|sig\\b\\|signature\\b\
\\|struct\\b\\|structure\\b\\|then\\b\\|val\\b\
\\|while\\b\\|with\\b\\|withtype\\b"
  "The indentation starters. The next line, after one starting with
one of these, will be indented.")

(defconst sml-starters-reg
  "\\babstraction\\b\\|\\babstype\\b\\|\\bdatatype\\b\
\\|\\bexception\\b\\|\\bfun\\b\\|\\bfunctor\\b\\|\\blocal\\b\
\\|\\bopen\\b\\|\\bsignature\\b\\|\\bstructure\\b\
\\|\\btype\\b\\|\\bval\\b\\|\\bwithtype\\b"
  "The starters of new expressions.")

(defconst sml-end-starters-reg
  "\\blet\\b\\|\\blocal\\b\\|\\bsig\\b\\|\\bstruct\\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")

(defun sml-calculate-indentation ()
  (let (tmp)
    (save-excursion
      (beginning-of-line)
      (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 "(\\*") (progn
			     (if (not (search-forward "*)" nil t))
			       (error "Comment not ended."))
			     (skip-chars-forward "\n\t ")
			     (sml-calculate-indentation)))
       ;; Are we looking at a case expression ?
       ((looking-at "|.*\\(\\|\n.*\\)=>")
	(progn
	  (sml-skip-block)
	  (sml-re-search-backward "=>")
	  (beginning-of-line)
	  (skip-chars-forward "\t ")
	  (if (looking-at "|")
	      (current-indentation)
	    (+ (current-indentation) sml-pipe-indent))))
       ((looking-at "and\\b")
	(sml-skip-block)
	(sml-re-search-backward sml-starters-reg)
	(current-indentation))
       ((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))
       ((looking-at "else\\b")	; Match the if
	(sml-find-match-indent "else" "\\belse\\b" "\\bif\\b"))
       ((looking-at "then\\b")	; Match the if + extra indentation
	(+ (sml-find-match-indent "then" "\\bthen\\b" "\\bif\\b")
	   sml-indent-level))
       (t
	(let ((indent (sml-get-indent)))
	  (cond
	   ((looking-at sml-starters-reg)
	    (let ((start (point)))
	      (sml-backward-sexp 1)
	      (if (looking-at sml-starters-indent-after)
		  indent
		(beginning-of-line)
		(skip-chars-forward "\t ")
		(if (looking-at sml-starters-indent-after)
		    indent
		  (goto-char start)
		  (sml-skip-block)
		  (if (sml-re-search-backward sml-starters-reg)
		      (current-column)
		    indent)))))
	   ((looking-at "|")
	    ;; Lets see if it is the follower of a function definition
	    (sml-skip-block)
	    (if (sml-re-search-backward "\\bfun\\b\\|\\bfn\\b")
		(- (current-column) sml-pipe-indent)
	      (+ indent sml-pipe-indent)))
	   (t indent))))))))

(defun sml-get-indent ()
  (save-excursion
    (beginning-of-line)
    (sml-skip-block)
    ;; Go to the beginning of the line and place by first
    ;; non-whitespace, but pass over starting parenthesis
    (beginning-of-line)		
    (skip-chars-forward "\t (")
    (let ((indent (current-indentation)))
      (cond
       ;; Started val/fun/structure...
       ((looking-at sml-indent-starters-reg) (+ indent sml-indent-level))
       ;; Indent after patter but ...
       ((looking-at "|.*\\(\\|\n.*\\)=>")
	(+ indent (- sml-indent-level sml-pipe-indent)))
       ;; ... not as much, if line doesn't start with "|"
       ((looking-at ".*=>.*") (+ indent sml-indent-level))
       ;; function with pattern
       ((looking-at "|") (- indent sml-pipe-indent))
       ;; else just indent
       (t indent)))))

(defun sml-skip-block ()
  (sml-backward-sexp 1)
  (let ((here (point)) (loop t))
    (while loop
      (cond 
       ;; If what we just passed was a comment, then go backward to
       ;; some code, as code is indented according to other code and
       ;; not according to comments.
       ((looking-at "(\\*")
	(skip-chars-backward "\t\n ")
	(if (>= here (point))		; So we won't end up in a loop
	    (setq loop nil)))
       ;; Skip over let-in-end/local-in-end etc...
       ((looking-at "end\\b")
	(goto-char (sml-find-match-backward "end" "\\bend\\b"
					    sml-end-starters-reg))
	(skip-chars-backward "\n\t ")
	(if (>= here (point))		; So we won't end up in a loop
	    (setq loop nil)))
       ;; Here we will need too skip backward past if-then-else
       ;; and case-of expression. Please - tell me how !!

       ;; Default, stop while-loop
       (t (setq loop nil))))))


(defun sml-find-match-backward (unquoted-this this match)
  "Find the match for a word, like end in:
    let ... let ... in ... end in ... end
   The last end will match the first let."
  (save-excursion
    (let ((level 1) (loop t) (here (point))
	  (pattern (concat this "\\|" match)))
      (while (and (/= level 0) loop)
	(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 "Unballanced: " unquoted-this))))
      (if loop
	  (point)
	here))))

(defun sml-find-match-indent (unquoted-this this match)
  "Find the column for the match."
  (save-excursion
    (goto-char (sml-find-match-backward unquoted-this this match))
    (current-column)))			; Give the column

(defun sml-re-search-backward (regexp)
  "Search backward for reg-exp. Regexp has to be in the same
list-level (that is inside points level, and not inside a comment"
  (let ((start-end-list (save-excursion (if (sml-up-list 1) (point) -1)))
	(loop t)
	(found nil))
    (while loop
      (if (re-search-backward regexp nil t)
	  (if (and (= (save-excursion (if (sml-up-list 1) (point) -1))
		      start-end-list)
		   (not (sml-inside-comment-p)))
	      (progn (setq loop nil) (setq found t)))
	(setq loop nil)))
    found))

(defun sml-inside-comment-p ()
  "Is point inside a comment ?"
  (let ((start (point)))
    (save-excursion
      (condition-case ()
	  (and (> start (progn (search-backward "(*") (point)))
	       (< start (progn (search-forward "*)") (point))))
	(error nil)))))

(defun sml-up-list (arg)
  "Performs up-list. Returns t if ok, nil if error"
  (condition-case () (progn (up-list arg) t) (error nil)))

(defun sml-backward-sexp (arg)
  "Performs backward-sexp. Returns t if ok, nil if error"
  (condition-case () (progn (backward-sexp arg) t) (error nil)))

(defun sml-comment-indent ()
  (if (looking-at "^(\\*")
      0					;Existing comment at bol stays there.
    (save-excursion
      (skip-chars-backward " \t")
      (max (current-column)		;Else indent at comment column
	   comment-column))))		; except leave at least one space.

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; Inferior shell
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(defconst sml-prog-name "sml"
  "*Name of program to run as sml in \"run-sml\".")

(defconst sml-use-left-delim "\""
  "*The left delimiter for the filename when using \"use\".
 To be set to `[\"' for Edinburough SML, and `\"' for New Jersey.
 Correspondes to `sml-use-right-delim'.")

(defconst sml-use-right-delim "\""
  "*The right delimiter for the filename when using \"use\".
 To be set to `\"]' for Edinburough SML, and `\"' for New Jersey.
 Correspondes to `sml-use-left-delim'.")

(defconst sml-process-name "SML" "*The name of the SML-process")

(defconst sml-process-buffer-name (concat "*" sml-process-name "*")
  "Do NOT alter this.")

(defvar sml-shell-map nil "The mode map for sml-shell.")

(defun sml-shell ()
  "Inferior shell invoking SML.
Like the shell mode with the additional command:

  \\[sml-run-on-file] (sml-run-on-file) Runs sml on the file.
\\{sml-shell-map}
Variables controlling the mode:

 sml-prog-name (default \"sml\")
    The string used to invoke the sml program.

 sml-use-right-delim (default \"\\\"\")
 sml-use-left-delim  (default \"\\\"\")
    The left and right delimitter uses by your version of sml, for
    \"use file-name\".

 sml-process-name (default \"SML\")
    The name of the process running sml.

Runs sml-shell-hook if not nil."
  (interactive)
  (if (process-status sml-process-name)
      (progn				; Process is running
	(pop-to-buffer sml-process-buffer-name)
	(goto-char (point-max)))
    (progn				; start up a new process
      (message "Starting SML ...")
      (require 'shell)
      (pop-to-buffer (make-shell sml-process-name sml-prog-name))
      (erase-buffer)			; Erase the buffer
      (if sml-shell-map
	  ()
	(progn
	  (setq sml-shell-map (copy-sequence shell-mode-map))
	  (define-key sml-shell-map "\C-c\C-f" 'sml-run-on-file)
	  ))
      (use-local-map sml-shell-map)
      (setq major-mode 'sml-shell)
      (setq mode-name "SML Shell")
      (setq mode-line-format 
	    "-----Emacs: %17b   %M   %[(%m: %s)%]----%3p--%-")
      (message "Starting SML ... done.")
      (run-hooks 'sml-shell-hook))))

(defun sml-run-on-file (fil)
  (interactive "FRun SML on : ")
  (sml-shell)
  (send-string sml-process-name
	       (concat "use " sml-use-left-delim (expand-file-name fil)
		       sml-use-right-delim ";\n")))

(defun sml-simulate-send-region (point1 point2)
  "Simulate send region. As send-region only can handle what ever the
system sets as the default, we have to make a temporary file."
  (let ((file (make-temp-name "/tmp/sml.tmp.")))
    (write-region point1 point2 file nil 'dummy)
    (message "Using temporary file: %s" file)
    (sml-shell)
    (send-string
     sml-process-name
     ;; string to send: use file; system "rm file"
     (concat "use " sml-use-left-delim file sml-use-right-delim
	     ";\n"))
    (send-string sml-process-name
		 (concat "system \"rm " file "\";\n"))))

(defun sml-send-region ()
  "Send region."
  (interactive)
  (let (start end)
    (save-excursion
      (setq end (point))
      (exchange-point-and-mark)
      (setq start (point)))
    (sml-simulate-send-region start end)))

(defun sml-send-function ()
  "Does NOT send the function, but the paragraph."
  (interactive)
  (let (start end)
    (save-excursion
      (backward-paragraph)
      (setq start (point))
      (forward-paragraph)
      (setq end (point)))
    (sml-simulate-send-region start end)))

(defun sml-send-buffer ()
  "Send the buffer."
  (interactive)
  (sml-simulate-send-region (point-min) (point-max)))



-- 
 Lars Bo Nielsen                    |@| Wise words in latin:
 Internet: lbn@ksuvax1.cis.ksu.edu  |@|  Vir prudens non contra ventum mingit
 UUCP: ..!rutgers!ksuvax1!lbn -or- ..!{pyramid,ucsd}!ncr-sd!ncrwic!ksuvax1!lbn