1 ;;; sml-proc.el. Comint based interaction mode for Standard ML.
3 (defconst rcsid-sml-proc "@(#)$Name$:$Id$")
5 ;; Copyright (C) 1989, Lars Bo Nielsen, 1994,1997 Matthew J. Morley
10 ;; ====================================================================
12 ;; This file is not part of GNU Emacs, but it is distributed under the
15 ;; This program is free software; you can redistribute it and/or
16 ;; modify it under the terms of the GNU General Public License as
17 ;; published by the Free Software Foundation; either version 2, or (at
18 ;; your option) any later version.
20 ;; This program is distributed in the hope that it will be useful, but
21 ;; WITHOUT ANY WARRANTY; without even the implied warranty of
22 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
23 ;; General Public License for more details.
25 ;; You should have received a copy of the GNU General Public License
26 ;; along with GNU Emacs; see the file COPYING. If not, write to the
27 ;; Free Software Foundation, 675 Mass Ave, Cambridge, MA 0139, USA.
28 ;; (See sml-mode.el for HISTORY.)
30 ;; ====================================================================
32 ;; [MJM 10/94] Separating this from sml-mode means sml-mode will run
33 ;; under 18.59 (or anywhere without comint, if there are such places).
34 ;; See sml-mode.el for further information.
38 ;; Inferior-sml-mode is for interacting with an ML process run under
39 ;; emacs. This uses the comint package so you get history, expansion,
40 ;; backup and all the other benefits of comint. Interaction is
41 ;; achieved by M-x run-sml which starts a sub-process under emacs. You may
42 ;; need to set this up for autoloading in your .emacs:
44 ;; (autoload 'run-sml "sml-proc" "Run an inferior ML process." t)
46 ;; Exactly what process is governed by the variable sml-program-name
47 ;; -- just "sml" by default. If you give a prefix argument (C-u M-x
48 ;; run-sml) you will be prompted for a different program to execute from
49 ;; the default -- if you just hit RETURN you get the default anyway --
50 ;; along with the option to specify any command line arguments. Once
51 ;; you select the ML program name in this manner, it remains the
52 ;; default (unless you set in a hook, or otherwise).
54 ;; NOTE: inferior-sml-mode-hook is run AFTER the ML program has been
55 ;; launched. inferior-sml-load-hook is run only when sml-proc.el is
58 ;; When running an ML process some further key-bindings are effective
59 ;; in sml-mode buffer(s). C-c C-s (switch-to-sml) will split the
60 ;; screen into two windows if necessary and place you in the ML
61 ;; process buffer. In the interaction buffer, C-c C-s is bound to the
62 ;; `sml' command by default (in case you need to restart).
64 ;; C-c C-l (sml-load-file) will load an SML source file into the
65 ;; inferior process, C-c C-r (sml-send-region) will send the current
66 ;; region of text to the ML process, etc. Given a prefix argument to
67 ;; these commands will switch you from the SML buffer to the ML
68 ;; process buffer as well as sending the text. If you get errors
69 ;; reported by the compiler, C-x ` (next-error) will step through
70 ;; the errors with you.
72 ;; NOTE. There is only limited support for this as it obviously
73 ;; depends on the compiler's error messages being recognised by the
74 ;; mode. Error reporting is currently only geared up for SML/NJ,
75 ;; Moscow ML, and Poly/ML. For other compilers, add the relevant
76 ;; regexp to sml-error-regexp-alist and send it to me.
78 ;; To send pieces of code to the underlying compiler, we never send the text
79 ;; directly but use a temporary file instead. This breaks if the compiler
80 ;; does not understand `use', but has the benefit of allowing better error
83 ;; ===================================================================
85 ;;; INFERIOR ML MODE VARIABLES
93 "Interacting with an SML process."
96 (defcustom sml-program-name "sml"
97 "*Program to run as ML."
101 (defcustom sml-default-arg ""
102 "*Default command line option to pass, if any."
106 (defvar sml-compile-command "CM.make()"
107 "The command used by default by `sml-make'.")
109 (defvar sml-make-file-name "sources.cm"
110 "The name of the makefile that `sml-make' will look for (if non-nil).")
112 ;;(defvar sml-raise-on-error nil
113 ;; "*When non-nil, `sml-next-error' will raise the ML process's frame.")
115 (defvar inferior-sml-mode-hook nil
116 "*This hook is run when the inferior ML process is started.
117 All buffer local customisations for the interaction buffers go here.")
119 (defvar inferior-sml-load-hook nil
120 "*Hook run when inferior-sml-mode (sml-proc.el) is loaded into Emacs.
121 This is a good place to put your preferred key bindings.")
123 (defvar sml-error-overlay nil
124 "*Non-nil means use an overlay to highlight errorful code in the buffer.
125 The actual value is the name of a face to use for the overlay.
126 Instead of setting this variable to 'region, you can also simply keep
127 it NIL and use (transient-mark-mode) which will provide similar
128 benefits (but with several side effects).")
130 (defvar sml-buffer nil
131 "*The current ML process buffer.
133 MULTIPLE PROCESS SUPPORT (Whoever wants multi-process support anyway?)
134 =====================================================================
135 sml-mode supports, in a fairly simple fashion, running multiple ML
136 processes. To run multiple ML processes, you start the first up with
137 \\[sml]. It will be in a buffer named *sml*. Rename this buffer with
138 \\[rename-buffer]. You may now start up a new process with another
139 \\[sml]. It will be in a new buffer, named *sml*. You can switch
140 between the different process buffers with \\[switch-to-buffer].
142 NB *sml* is just the default name for the buffer. It actually gets
143 it's name from the value of `sml-program-name' -- *poly*, *smld*,...
145 If you have more than one ML process around, commands that send text
146 from source buffers to ML processes -- like `sml-send-function' or
147 `sml-send-region' -- have to choose a process to send it to. This is
148 determined by the global variable `sml-buffer'. Suppose you have three
149 inferior ML's running:
152 mosml #<process mosml>
153 *sml* #<process sml<2>>
154 If you do a \\[sml-send-function] command on some ML source code,
155 what process do you send it to?
157 - If you're in a process buffer (sml, mosml, or *sml*), you send it to
158 that process (usually makes sense only to `sml-load-file').
159 - If you're in some other buffer (e.g., a source file), you send it to
160 the process attached to buffer `sml-buffer'.
162 This process selection is performed by function `sml-proc' which looks
163 at the value of `sml-buffer' -- which must be a lisp buffer object, or
166 Whenever \\[sml] fires up a new process, it resets `sml-buffer' to be
167 the new process's buffer. If you only run one process, this will do
168 the right thing. If you run multiple processes, you can change
169 `sml-buffer' to another process buffer with \\[set-variable], or
170 use the command \\[sml-buffer] in the interaction buffer of choice.")
173 ;;; ALL STUFF THAT DEFAULTS TO THE SML/NJ COMPILER (0.93)
175 (defvar sml-use-command "use \"%s\""
176 "*Template for loading a file into the inferior ML process.
177 Set to \"use \\\"%s\\\"\" for SML/NJ or Edinburgh ML;
178 set to \"PolyML.use \\\"%s\\\"\" for Poly/ML, etc.")
180 (defvar sml-cd-command "OS.FileSys.chDir \"%s\""
181 "*Command template for changing working directories under ML.
182 Set this to nil if your compiler can't change directories.
184 The format specifier \"%s\" will be converted into the directory name
185 specified when running the command \\[sml-cd].")
187 (defcustom sml-prompt-regexp "^[-=>#] *"
188 "*Regexp used to recognise prompts in the inferior ML process."
192 (defvar sml-error-regexp-alist
193 '(;; Poly/ML messages
194 ("\\(Error\\|Warning:\\) in '\\(.+\\)', line \\([0-9]+\\)" 2 3)
196 ("File \"\\([^\"]+\\)\", line \\([0-9]+\\)\\(-\\([0-9]+\\)\\)?, characters \\([0-9]+\\)-\\([0-9]+\\):" 1 2 5)
197 ;; SML/NJ: the file-pattern is anchored to avoid
198 ;; pathological behavior with very long lines.
199 ("^[-= ]*\\(.+\\):\\([0-9]+\\)\\.\\([0-9]+\\)\\(-\\([0-9]+\\)\\.\\([0-9]+\\)\\)? \\(Error\\|Warning\\): .*" 1 sml-make-error 2 3 5 6)
200 ;; SML/NJ's exceptions: see above.
201 ("^ +\\(raised at: \\)?\\(.+\\):\\([0-9]+\\)\\.\\([0-9]+\\)\\(-\\([0-9]+\\)\\.\\([0-9]+\\)\\)" 2 sml-make-error 3 4 6 7))
202 "Alist that specifies how to match errors in compiler output.
203 See `compilation-error-regexp-alist' for a description of the format.")
206 (defconst inferior-sml-font-lock-keywords
207 `(;; prompt and following interactive command
208 (,(concat "\\(" sml-prompt-regexp "\\)\\(.*\\)")
209 (1 font-lock-prompt-face)
210 (2 font-lock-command-face keep))
212 ("^\\[\\(.*GC #.*\n\\)*.*\\]" . font-lock-comment-face)
213 ;; SML/NJ's irritating GC messages
214 ("^GC #.*" . font-lock-comment-face)
216 ,@(mapcar (lambda (ra) (cons (car ra) 'font-lock-warning-face))
217 sml-error-regexp-alist))
218 "Font-locking specification for inferior SML mode.")
220 (defface font-lock-prompt-face
222 "Font Lock mode face used to highlight prompts."
223 :group 'font-lock-highlighting-faces)
224 (defvar font-lock-prompt-face 'font-lock-prompt-face
225 "Face name to use for prompts.")
227 (defface font-lock-command-face
229 "Font Lock mode face used to highlight interactive commands."
230 :group 'font-lock-highlighting-faces)
231 (defvar font-lock-command-face 'font-lock-command-face
232 "Face name to use for interactive commands.")
234 (defconst inferior-sml-font-lock-defaults
235 '(inferior-sml-font-lock-keywords nil nil nil nil))
239 (defmap inferior-sml-mode-map
240 '(("\C-c\C-s" . run-sml)
241 ("\t" . comint-dynamic-complete))
242 "Keymap for inferior-sml mode"
243 :inherit (list sml-bindings comint-mode-map)
249 (defvar sml-temp-file nil)
250 ;;(defvar sml-error-file nil) ; file from which the last error came
251 (defvar sml-error-cursor nil) ; ditto
253 (defun sml-proc-buffer ()
254 "Returns the current ML process buffer,
255 or the current buffer if it is in `inferior-sml-mode'. Raises an error
256 if the variable `sml-buffer' does not appear to point to an existing
258 (or (and (eq major-mode 'inferior-sml-mode) (current-buffer))
260 (let ((buf (get-buffer sml-buffer)))
261 ;; buffer-name returns nil if the buffer has been killed
262 (and buf (buffer-name buf) buf)))
263 ;; no buffer found, make a new one
267 "Returns the current ML process. See variable `sml-buffer'."
268 (assert (eq major-mode 'inferior-sml-mode))
269 (or (get-buffer-process (current-buffer))
270 (progn (run-sml t) (get-buffer-process (current-buffer)))))
272 (defun sml-buffer (echo)
273 "Make the current buffer the current `sml-buffer' if that is sensible.
274 Lookup variable `sml-buffer' to see why this might be useful."
276 (when (and (not echo) (eq major-mode 'inferior-sml-mode))
277 (setq sml-buffer (current-buffer)))
278 (message "ML process buffer is %s."
279 (or (ignore-errors (buffer-name (get-buffer sml-buffer)))
282 (defun inferior-sml-mode ()
283 "Major mode for interacting with an inferior ML process.
285 The following commands are available:
286 \\{inferior-sml-mode-map}
288 An ML process can be fired up (again) with \\[sml].
290 Customisation: Entry to this mode runs the hooks on `comint-mode-hook'
291 and `inferior-sml-mode-hook' (in that order).
293 Variables controlling behaviour of this mode are
295 `sml-program-name' (default \"sml\")
296 Program to run as ML.
298 `sml-use-command' (default \"use \\\"%s\\\"\")
299 Template for loading a file into the inferior ML process.
301 `sml-cd-command' (default \"System.Directory.cd \\\"%s\\\"\")
302 ML command for changing directories in ML process (if possible).
304 `sml-prompt-regexp' (default \"^[\\-=] *\")
305 Regexp used to recognise prompts in the inferior ML process.
307 You can send text to the inferior ML process from other buffers containing
309 `switch-to-sml' switches the current buffer to the ML process buffer.
310 `sml-send-function' sends the current *paragraph* to the ML process.
311 `sml-send-region' sends the current region to the ML process.
313 Prefixing the sml-send-<whatever> commands with \\[universal-argument]
314 causes a switch to the ML process buffer after sending the text.
316 For information on running multiple processes in multiple buffers, see
317 documentation for variable `sml-buffer'.
320 RET after the end of the process' output sends the text from the
321 end of process to point.
322 RET before the end of the process' output copies the current line
323 to the end of the process' output, and sends it.
324 DEL converts tabs to spaces as it moves back.
325 TAB file name completion, as in shell-mode, etc.."
327 (kill-all-local-variables)
329 (setq comint-prompt-regexp sml-prompt-regexp)
332 ;; For sequencing through error messages:
333 (set (make-local-variable 'sml-error-cursor) (point-max-marker))
334 (set-marker-insertion-type sml-error-cursor nil)
335 (set (make-local-variable 'font-lock-defaults)
336 inferior-sml-font-lock-defaults)
338 ;; compilation support (used for next-error)
339 (set (make-local-variable 'compilation-error-regexp-alist)
340 sml-error-regexp-alist)
341 (compilation-shell-minor-mode 1)
342 ;; I'm sure people might kill me for that
343 (setq compilation-error-screen-columns nil)
344 (make-local-variable 'sml-endof-error-alist)
345 ;;(make-local-variable 'sml-error-overlay)
347 (setq major-mode 'inferior-sml-mode)
348 (setq mode-name "Inferior ML")
349 (setq mode-line-process '(": %s"))
350 (use-local-map inferior-sml-mode-map)
351 ;;(add-hook 'kill-emacs-hook 'sml-temp-tidy)
353 (run-hooks 'inferior-sml-mode-hook))
355 ;;; FOR RUNNING ML FROM EMACS
358 (defun run-sml (&optional pfx)
359 "Run an inferior ML process, input and output via buffer *sml*.
360 With a prefix argument, this command allows you to specify any command
361 line options to pass to the complier. The command runs hook functions
362 on `comint-mode-hook' and `inferior-sml-mode-hook' in that order.
364 If there is a process already running in *sml*, just switch to that
367 In fact the name of the buffer created is chosen to reflect the name
368 of the program name specified by `sml-program-name', or entered at the
369 prompt. You can have several inferior ML process running, but only one
370 current one -- given by `sml-buffer' (qv).
372 \(Type \\[describe-mode] in the process buffer for a list of commands.)"
375 (read-string "ML command: " sml-program-name)
378 (read-string "Any args: " sml-default-arg)
382 (defun sml-run (cmd arg)
383 "Run the ML program CMD with given arguments ARGS.
384 This usually updates `sml-buffer' to a buffer named *CMD*."
385 (let* ((pname (file-name-nondirectory cmd))
386 (args (if (equal arg "") () (sml-args-to-list arg))))
387 ;; and this -- to keep these as defaults even if
388 ;; they're set in the mode hooks.
389 (setq sml-program-name cmd)
390 (setq sml-default-arg arg)
391 (setq sml-buffer (apply 'make-comint pname cmd nil args))
393 (set-buffer sml-buffer)
394 (message (format "Starting \"%s\" in background." pname))
396 (goto-char (point-max))
399 (defun sml-args-to-list (string)
400 (let ((where (string-match "[ \t]" string)))
401 (cond ((null where) (list string))
403 (cons (substring string 0 where)
404 (sml-args-to-list (substring string (+ 1 where)
406 (t (let ((pos (string-match "[^ \t]" string)))
409 (sml-args-to-list (substring string pos
410 (length string)))))))))
412 (defun switch-to-sml (eob-p)
413 "Switch to the ML process buffer.
414 With prefix argument, positions cursor at point, otherwise at end of buffer."
416 (pop-to-buffer (sml-proc-buffer))
418 (push-mark (point) t)
419 (goto-char (point-max)))))
421 ;; Fakes it with a "use <temp-file>;" if necessary.
423 (defun sml-send-region (start end &optional and-go)
424 "Send current region to the inferior ML process.
425 Prefix argument means switch-to-sml afterwards.
427 The region is written out to a temporary file and a \"use <temp-file>\" command
428 is sent to the compiler.
429 See variables `sml-use-command'."
432 (message "The region is zero (ignored)")
433 (let* ((buf (sml-proc-buffer))
434 (file (buffer-file-name))
435 (marker (copy-marker start))
436 (tmp (make-temp-file "sml")))
437 (write-region start end tmp nil 'silently)
438 (with-current-buffer buf
440 (ignore-errors (delete-file (car sml-temp-file)))
441 (set-marker (cdr sml-temp-file) nil))
442 (setq sml-temp-file (cons tmp marker))
443 (sml-send-string (format sml-use-command tmp) nil and-go)))))
445 ;; This is quite bogus, so it isn't bound to a key by default.
446 ;; Anyone coming up with an algorithm to recognise fun & local
447 ;; declarations surrounding point will do everyone a favour!
449 (defun sml-send-function (&optional and-go)
450 "Send current paragraph to the inferior ML process.
451 With a prefix argument switch to the sml buffer as well
452 \(cf. `sml-send-region'\)."
456 (sml-send-region (point) (mark)))
457 (if and-go (switch-to-sml nil)))
459 (defvar sml-source-modes '(sml-mode)
460 "*Used to determine if a buffer contains ML source code.
461 If it's loaded into a buffer that is in one of these major modes, it's
462 considered an ML source file by `sml-load-file'. Used by these commands
463 to determine defaults.")
465 (defun sml-send-buffer (&optional and-go)
466 "Send buffer to inferior shell running ML process.
467 With a prefix argument switch to the sml buffer as well
468 \(cf. `sml-send-region'\)."
470 (if (memq major-mode sml-source-modes)
471 (sml-send-region (point-min) (point-max) and-go)))
473 ;; Since sml-send-function/region take an optional prefix arg, these
474 ;; commands are redundant. But they are kept around for the user to
475 ;; bind if she wishes, since its easier to type C-c r than C-u C-c C-r.
477 (defun sml-send-region-and-go (start end)
478 "Send current region to the inferior ML process, and go there."
480 (sml-send-region start end t))
482 (defun sml-send-function-and-go ()
483 "Send current paragraph to the inferior ML process, and go there."
485 (sml-send-function t))
487 ;;; 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
489 (defun sml-drag-region (event)
490 "Highlight the text the mouse is dragged over, and send it to ML.
491 This must be bound to a button-down mouse event, currently \\[sml-drag-region].
493 If you drag the mouse (ie, keep the mouse button depressed) the
494 program text sent to the complier is delimited by where you started
495 dragging the mouse, and where you release the mouse button.
497 If you only click the mouse, the program text sent to the compiler is
498 delimited by the current position of point and the place where you
501 In either event, the values of both point and mark are left
502 undisturbed once this operation is completed."
504 (let ((mark-ring) ;BAD: selection start gets cons'd
505 (pmark (point))) ;where point is now
506 (if (fboundp 'mouse-track-default)
507 ;; Assume this is XEmacs, otherwise assume its Emacs
509 (let ((zmacs-regions))
510 (set-marker (mark-marker) nil)
511 (mouse-track-default event)
512 (if (not (region-exists-p)) (push-mark pmark nil t))
513 (call-interactively 'sml-send-region)))
514 ;; Emacs: making this buffer-local ought to happen in sml-mode
515 (make-local-variable 'transient-mark-mode)
517 (let ((transient-mark-mode 1))
518 (mouse-drag-region event)
519 (if (not mark-active) (push-mark pmark nil t))
520 (call-interactively 'sml-send-region))))))
523 ;;; LOADING AND IMPORTING SOURCE FILES:
525 (defvar sml-prev-dir/file nil
526 "Caches the (directory . file) pair used in the last `sml-load-file'
527 or `sml-cd' command. Used for determining the default in the next one.")
529 (defun sml-load-file (&optional and-go)
530 "Load an ML file into the current inferior ML process.
531 With a prefix argument switch to sml buffer as well.
533 This command uses the ML command template `sml-use-command' to construct
534 the command to send to the ML process\; a trailing \"\;\\n\" will be added
537 (let ((file (car (comint-get-source
538 "Load ML file: " sml-prev-dir/file sml-source-modes t))))
539 (with-current-buffer (sml-proc-buffer)
540 ;; Check if buffer needs saved. Should (save-some-buffers) instead?
541 (comint-check-source file)
542 (setq sml-prev-dir/file
543 (cons (file-name-directory file) (file-name-nondirectory file)))
544 (sml-send-string (format sml-use-command file) nil and-go))))
547 "Change the working directory of the inferior ML process.
548 The default directory of the process buffer is changed to DIR. If the
549 variable `sml-cd-command' is non-nil it should be an ML command that will
550 be executed to change the compiler's working directory\; a trailing
551 \"\;\\n\" will be added automatically."
552 (interactive "DSML Directory: ")
553 (let ((dir (expand-file-name dir)))
554 (with-current-buffer (sml-proc-buffer)
555 (sml-send-string (format sml-cd-command dir) t)
556 (setq default-directory dir))
557 (setq sml-prev-dir/file (cons dir nil))))
559 (defun sml-send-string (str &optional print and-go)
560 (let ((proc (sml-proc))
561 (str (concat str ";\n"))
562 (win (get-buffer-window (current-buffer) 'visible)))
563 (when win (select-window win))
564 (goto-char (point-max))
565 (when print (insert str))
567 (set-marker (process-mark proc) (point-max))
568 (setq compilation-last-buffer (current-buffer))
569 (comint-send-string proc str)
570 (when and-go (switch-to-sml nil))))
572 (defun sml-compile (command)
573 "re-make a system using (by default) CM.
574 The exact command used can be specified by providing a prefix argument."
576 ;; code taken straight from compile.el
577 (if (or compilation-read-command current-prefix-arg)
578 (list (read-from-minibuffer "Compile command: "
579 sml-compile-command nil nil
580 '(compile-history . 1)))
581 (list sml-compile-command)))
582 (setq sml-compile-command command)
583 (save-some-buffers (not compilation-ask-about-save) nil)
584 ;; try to find a makefile up the directory tree
585 (let ((dir (when sml-make-file-name default-directory)))
586 (while (and dir (not (file-exists-p (concat dir sml-make-file-name))))
587 (let ((newdir (file-name-directory (directory-file-name dir))))
588 (setq dir (unless (equal newdir dir) newdir))))
589 (unless dir (setq dir default-directory))
590 (with-current-buffer (sml-proc-buffer)
591 (setq default-directory dir)
592 (sml-send-string (concat (format sml-cd-command dir) "; " command) t t))))
594 ;;; PARSING ERROR MESSAGES
596 ;; This should need no modification to support other compilers.
598 ;; Update the buffer-local error-cursor in proc-buffer to be its
599 ;; current proc mark.
601 (defvar sml-endof-error-alist nil)
603 (defun sml-update-cursor ()
604 ;; update buffer local variable
605 (set-marker sml-error-cursor (1- (process-mark (sml-proc))))
606 (setq sml-endof-error-alist nil)
607 (compilation-forget-errors)
608 (if (markerp compilation-parsing-end)
609 (set-marker compilation-parsing-end sml-error-cursor)
610 (setq compilation-parsing-end sml-error-cursor)))
612 (defun sml-make-error (f c)
613 (let ((err (point-marker))
614 (linenum (string-to-number c))
615 (filename (list (first f) (second f)))
616 (column (string-to-number (compile-buffer-substring (third f)))))
617 ;; record the end of error, if any
619 (let* ((endline (string-to-number (compile-buffer-substring (fourth f))))
620 (endcol (string-to-number (compile-buffer-substring (fifth f))))
621 (linediff (- endline linenum)))
622 (push (list err linediff (if (= 0 linediff) (- endcol column) endcol))
623 sml-endof-error-alist)))
624 ;; build the error descriptor
625 (if (string= (car sml-temp-file) (first f))
626 ;; special case for code sent via sml-send-region
627 (let ((marker (cdr sml-temp-file)))
628 (with-current-buffer (marker-buffer marker)
630 (forward-line (1- linenum))
631 (forward-char (1- column))
632 (cons err (point-marker))))
633 ;; taken from compile.el
634 (list err filename linenum column))))
636 (defadvice compilation-goto-locus (after sml-endof-error activate)
637 (let* ((next-error (ad-get-arg 0))
638 (err (car next-error))
639 (pos (cdr next-error))
640 (endof (with-current-buffer (marker-buffer err)
641 (assq err sml-endof-error-alist))))
642 (if (not endof) (sml-error-overlay 'undo)
643 (with-current-buffer (marker-buffer pos)
645 (let ((linediff (second endof))
646 (coldiff (third endof)))
647 (when (> 0 linediff) (forward-line linediff))
648 (forward-char coldiff))
649 (sml-error-overlay nil pos (point))
650 (push-mark nil t (not sml-error-overlay))
653 (defun sml-error-overlay (undo &optional beg end)
654 "Move `sml-error-overlay' so it surrounds the text region in the
655 current buffer. If the buffer-local variable `sml-error-overlay' is
656 non-nil it should be an overlay \(or extent, in XEmacs speak\)\; this
657 function moves the overlay over the current region. If the optional
658 BUFFER argument is given, move the overlay in that buffer instead of
661 Called interactively, the optional prefix argument UNDO indicates that
662 the overlay should simply be removed: \\[universal-argument] \
663 \\[sml-error-overlay]."
665 (when sml-error-overlay
666 (unless (overlayp sml-error-overlay)
667 (let ((ol sml-error-overlay))
668 (setq sml-error-overlay (make-overlay 0 0))
669 (overlay-put sml-error-overlay 'face (if (symbolp ol) ol 'region))))
670 (if undo (move-overlay sml-error-overlay 1 1 (current-buffer))
671 ;; if active regions, signals mark not active if no region set
672 (let ((beg (or beg (region-beginning)))
673 (end (or end (region-end))))
674 (move-overlay sml-error-overlay beg end (current-buffer))))))
676 ;;; 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
679 (cond ((string-match "\\(Lucid\\|XEmacs\\)" emacs-version)
680 ;; LUCID (19.10) or later...
681 (define-key sml-mode-map '(meta shift button1) 'sml-drag-region))
683 ;; GNU, post circa 19.19
684 (define-key sml-mode-map [M-S-down-mouse-1] 'sml-drag-region))))
686 ;;; ...and do the user's customisations.
688 (run-hooks 'inferior-sml-load-hook)
690 ;;; Here is where sml-proc.el ends