| 1 : |
monnier |
535 |
;;; sml-proc.el --- Comint based interaction mode for Standard ML.
|
| 2 : |
monnier |
32 |
|
| 3 : |
monnier |
541 |
;; Copyright (C) 1989 Lars Bo Nielsen
|
| 4 : |
|
|
;; Copyright (C) 1994-1997 Matthew J. Morley
|
| 5 : |
|
|
;; Copyright (C) 1999-2000 Stefan Monnier
|
| 6 : |
monnier |
32 |
|
| 7 : |
|
|
;; $Revision$
|
| 8 : |
|
|
;; $Date$
|
| 9 : |
|
|
|
| 10 : |
|
|
;; ====================================================================
|
| 11 : |
|
|
|
| 12 : |
|
|
;; This file is not part of GNU Emacs, but it is distributed under the
|
| 13 : |
|
|
;; same conditions.
|
| 14 : |
|
|
|
| 15 : |
|
|
;; This program is free software; you can redistribute it and/or
|
| 16 : |
|
|
;; modify it under the terms of the GNU General Public License as
|
| 17 : |
|
|
;; published by the Free Software Foundation; either version 2, or (at
|
| 18 : |
|
|
;; your option) any later version.
|
| 19 : |
|
|
|
| 20 : |
|
|
;; This program is distributed in the hope that it will be useful, but
|
| 21 : |
|
|
;; WITHOUT ANY WARRANTY; without even the implied warranty of
|
| 22 : |
|
|
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
|
| 23 : |
|
|
;; General Public License for more details.
|
| 24 : |
|
|
|
| 25 : |
|
|
;; You should have received a copy of the GNU General Public License
|
| 26 : |
|
|
;; along with GNU Emacs; see the file COPYING. If not, write to the
|
| 27 : |
|
|
;; Free Software Foundation, 675 Mass Ave, Cambridge, MA 0139, USA.
|
| 28 : |
|
|
;; (See sml-mode.el for HISTORY.)
|
| 29 : |
|
|
|
| 30 : |
|
|
;; ====================================================================
|
| 31 : |
|
|
|
| 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.
|
| 35 : |
|
|
|
| 36 : |
monnier |
535 |
;;; Commentary:
|
| 37 : |
monnier |
32 |
|
| 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 : |
monnier |
394 |
;; achieved by M-x run-sml which starts a sub-process under emacs. You may
|
| 42 : |
monnier |
32 |
;; need to set this up for autoloading in your .emacs:
|
| 43 : |
|
|
|
| 44 : |
monnier |
394 |
;; (autoload 'run-sml "sml-proc" "Run an inferior ML process." t)
|
| 45 : |
monnier |
32 |
|
| 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 : |
monnier |
394 |
;; run-sml) you will be prompted for a different program to execute from
|
| 49 : |
monnier |
32 |
;; 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).
|
| 53 : |
|
|
|
| 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
|
| 56 : |
|
|
;; loaded into Emacs.
|
| 57 : |
|
|
|
| 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).
|
| 63 : |
|
|
|
| 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 : |
monnier |
394 |
;; reported by the compiler, C-x ` (next-error) will step through
|
| 70 : |
monnier |
32 |
;; the errors with you.
|
| 71 : |
|
|
|
| 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 : |
monnier |
394 |
;; Moscow ML, and Poly/ML. For other compilers, add the relevant
|
| 76 : |
|
|
;; regexp to sml-error-regexp-alist and send it to me.
|
| 77 : |
monnier |
32 |
|
| 78 : |
monnier |
394 |
;; 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
|
| 81 : |
|
|
;; reporting.
|
| 82 : |
monnier |
32 |
|
| 83 : |
monnier |
535 |
;; Bugs:
|
| 84 : |
monnier |
32 |
|
| 85 : |
monnier |
535 |
;; Todo:
|
| 86 : |
monnier |
32 |
|
| 87 : |
monnier |
535 |
;; - Keep improving `sml-compile'.
|
| 88 : |
|
|
;; - ignore warnings (if requested) for next-error
|
| 89 : |
|
|
|
| 90 : |
|
|
;;; Code:
|
| 91 : |
|
|
|
| 92 : |
monnier |
541 |
(eval-when-compile (require 'cl))
|
| 93 : |
monnier |
32 |
(require 'sml-mode)
|
| 94 : |
monnier |
332 |
(require 'sml-util)
|
| 95 : |
monnier |
32 |
(require 'comint)
|
| 96 : |
monnier |
332 |
(require 'compile)
|
| 97 : |
monnier |
32 |
|
| 98 : |
monnier |
394 |
(defgroup sml-proc ()
|
| 99 : |
|
|
"Interacting with an SML process."
|
| 100 : |
|
|
:group 'sml)
|
| 101 : |
monnier |
32 |
|
| 102 : |
monnier |
394 |
(defcustom sml-program-name "sml"
|
| 103 : |
|
|
"*Program to run as ML."
|
| 104 : |
|
|
:group 'sml-proc
|
| 105 : |
|
|
:type '(string))
|
| 106 : |
monnier |
32 |
|
| 107 : |
monnier |
394 |
(defcustom sml-default-arg ""
|
| 108 : |
|
|
"*Default command line option to pass, if any."
|
| 109 : |
|
|
:group 'sml-proc
|
| 110 : |
|
|
:type '(string))
|
| 111 : |
|
|
|
| 112 : |
monnier |
535 |
(defcustom sml-host-name ""
|
| 113 : |
|
|
"*Host on which to run ML."
|
| 114 : |
|
|
:group 'sml-proc
|
| 115 : |
|
|
:type '(string))
|
| 116 : |
monnier |
32 |
|
| 117 : |
monnier |
535 |
(defcustom sml-config-file "~/.smlproc.sml"
|
| 118 : |
|
|
"*File that should be fed to the ML process when started."
|
| 119 : |
|
|
:group 'sml-proc
|
| 120 : |
|
|
:type '(string))
|
| 121 : |
monnier |
32 |
|
| 122 : |
monnier |
535 |
(defcustom sml-compile-command "CM.make()"
|
| 123 : |
|
|
"The command used by default by `sml-compile'.
|
| 124 : |
|
|
See also `sml-compile-commands-alist'.")
|
| 125 : |
monnier |
32 |
|
| 126 : |
monnier |
535 |
(defcustom sml-compile-commands-alist
|
| 127 : |
|
|
'(("CMB.make()" . "all-files.cm")
|
| 128 : |
|
|
("CMB.make()" . "pathconfig")
|
| 129 : |
|
|
("CM.make()" . "sources.cm")
|
| 130 : |
|
|
("use \"load-all\"" . "load-all"))
|
| 131 : |
|
|
"*Commands used by default by `sml-compile'.
|
| 132 : |
|
|
Each command is associated with its \"main\" file.
|
| 133 : |
|
|
It is perfectly OK to associate several files with a command or several
|
| 134 : |
|
|
commands with the same file.")
|
| 135 : |
|
|
|
| 136 : |
monnier |
32 |
(defvar inferior-sml-mode-hook nil
|
| 137 : |
|
|
"*This hook is run when the inferior ML process is started.
|
| 138 : |
|
|
All buffer local customisations for the interaction buffers go here.")
|
| 139 : |
|
|
|
| 140 : |
monnier |
332 |
(defvar sml-error-overlay nil
|
| 141 : |
|
|
"*Non-nil means use an overlay to highlight errorful code in the buffer.
|
| 142 : |
|
|
The actual value is the name of a face to use for the overlay.
|
| 143 : |
|
|
Instead of setting this variable to 'region, you can also simply keep
|
| 144 : |
|
|
it NIL and use (transient-mark-mode) which will provide similar
|
| 145 : |
|
|
benefits (but with several side effects).")
|
| 146 : |
|
|
|
| 147 : |
monnier |
32 |
(defvar sml-buffer nil
|
| 148 : |
|
|
"*The current ML process buffer.
|
| 149 : |
|
|
|
| 150 : |
|
|
MULTIPLE PROCESS SUPPORT (Whoever wants multi-process support anyway?)
|
| 151 : |
|
|
=====================================================================
|
| 152 : |
monnier |
535 |
`sml-mode' supports, in a fairly simple fashion, running multiple ML
|
| 153 : |
|
|
processes. To run multiple ML processes, you start the first up with
|
| 154 : |
|
|
\\[sml]. It will be in a buffer named *sml*. Rename this buffer with
|
| 155 : |
|
|
\\[rename-buffer]. You may now start up a new process with another
|
| 156 : |
|
|
\\[sml]. It will be in a new buffer, named *sml*. You can switch
|
| 157 : |
monnier |
32 |
between the different process buffers with \\[switch-to-buffer].
|
| 158 : |
|
|
|
| 159 : |
monnier |
535 |
NB *sml* is just the default name for the buffer. It actually gets
|
| 160 : |
monnier |
32 |
it's name from the value of `sml-program-name' -- *poly*, *smld*,...
|
| 161 : |
|
|
|
| 162 : |
|
|
If you have more than one ML process around, commands that send text
|
| 163 : |
|
|
from source buffers to ML processes -- like `sml-send-function' or
|
| 164 : |
monnier |
535 |
`sml-send-region' -- have to choose a process to send it to. This is
|
| 165 : |
|
|
determined by the global variable `sml-buffer'. Suppose you have three
|
| 166 : |
monnier |
32 |
inferior ML's running:
|
| 167 : |
|
|
Buffer Process
|
| 168 : |
|
|
sml #<process sml>
|
| 169 : |
|
|
mosml #<process mosml>
|
| 170 : |
|
|
*sml* #<process sml<2>>
|
| 171 : |
|
|
If you do a \\[sml-send-function] command on some ML source code,
|
| 172 : |
|
|
what process do you send it to?
|
| 173 : |
|
|
|
| 174 : |
|
|
- If you're in a process buffer (sml, mosml, or *sml*), you send it to
|
| 175 : |
|
|
that process (usually makes sense only to `sml-load-file').
|
| 176 : |
|
|
- If you're in some other buffer (e.g., a source file), you send it to
|
| 177 : |
|
|
the process attached to buffer `sml-buffer'.
|
| 178 : |
|
|
|
| 179 : |
|
|
This process selection is performed by function `sml-proc' which looks
|
| 180 : |
monnier |
535 |
at the value of `sml-buffer' -- which must be a Lisp buffer object, or
|
| 181 : |
monnier |
32 |
a string \(or nil\).
|
| 182 : |
|
|
|
| 183 : |
|
|
Whenever \\[sml] fires up a new process, it resets `sml-buffer' to be
|
| 184 : |
monnier |
535 |
the new process's buffer. If you only run one process, this will do
|
| 185 : |
|
|
the right thing. If you run multiple processes, you can change
|
| 186 : |
monnier |
32 |
`sml-buffer' to another process buffer with \\[set-variable], or
|
| 187 : |
|
|
use the command \\[sml-buffer] in the interaction buffer of choice.")
|
| 188 : |
|
|
|
| 189 : |
|
|
|
| 190 : |
|
|
;;; ALL STUFF THAT DEFAULTS TO THE SML/NJ COMPILER (0.93)
|
| 191 : |
|
|
|
| 192 : |
|
|
(defvar sml-use-command "use \"%s\""
|
| 193 : |
|
|
"*Template for loading a file into the inferior ML process.
|
| 194 : |
|
|
Set to \"use \\\"%s\\\"\" for SML/NJ or Edinburgh ML;
|
| 195 : |
|
|
set to \"PolyML.use \\\"%s\\\"\" for Poly/ML, etc.")
|
| 196 : |
|
|
|
| 197 : |
monnier |
33 |
(defvar sml-cd-command "OS.FileSys.chDir \"%s\""
|
| 198 : |
monnier |
32 |
"*Command template for changing working directories under ML.
|
| 199 : |
|
|
Set this to nil if your compiler can't change directories.
|
| 200 : |
|
|
|
| 201 : |
|
|
The format specifier \"%s\" will be converted into the directory name
|
| 202 : |
|
|
specified when running the command \\[sml-cd].")
|
| 203 : |
|
|
|
| 204 : |
monnier |
394 |
(defcustom sml-prompt-regexp "^[-=>#] *"
|
| 205 : |
|
|
"*Regexp used to recognise prompts in the inferior ML process."
|
| 206 : |
|
|
:group 'sml-proc
|
| 207 : |
|
|
:type '(regexp))
|
| 208 : |
monnier |
32 |
|
| 209 : |
monnier |
395 |
(defvar sml-error-regexp-alist
|
| 210 : |
monnier |
332 |
'(;; Poly/ML messages
|
| 211 : |
|
|
("\\(Error\\|Warning:\\) in '\\(.+\\)', line \\([0-9]+\\)" 2 3)
|
| 212 : |
|
|
;; Moscow ML
|
| 213 : |
|
|
("File \"\\([^\"]+\\)\", line \\([0-9]+\\)\\(-\\([0-9]+\\)\\)?, characters \\([0-9]+\\)-\\([0-9]+\\):" 1 2 5)
|
| 214 : |
monnier |
378 |
;; SML/NJ: the file-pattern is anchored to avoid
|
| 215 : |
monnier |
342 |
;; pathological behavior with very long lines.
|
| 216 : |
monnier |
378 |
("^[-= ]*\\(.+\\):\\([0-9]+\\)\\.\\([0-9]+\\)\\(-\\([0-9]+\\)\\.\\([0-9]+\\)\\)? \\(Error\\|Warning\\): .*" 1 sml-make-error 2 3 5 6)
|
| 217 : |
monnier |
342 |
;; SML/NJ's exceptions: see above.
|
| 218 : |
monnier |
395 |
("^ +\\(raised at: \\)?\\(.+\\):\\([0-9]+\\)\\.\\([0-9]+\\)\\(-\\([0-9]+\\)\\.\\([0-9]+\\)\\)" 2 sml-make-error 3 4 6 7))
|
| 219 : |
|
|
"Alist that specifies how to match errors in compiler output.
|
| 220 : |
|
|
See `compilation-error-regexp-alist' for a description of the format.")
|
| 221 : |
monnier |
32 |
|
| 222 : |
monnier |
33 |
;; font-lock support
|
| 223 : |
monnier |
332 |
(defconst inferior-sml-font-lock-keywords
|
| 224 : |
|
|
`(;; prompt and following interactive command
|
| 225 : |
|
|
(,(concat "\\(" sml-prompt-regexp "\\)\\(.*\\)")
|
| 226 : |
monnier |
33 |
(1 font-lock-prompt-face)
|
| 227 : |
|
|
(2 font-lock-command-face keep))
|
| 228 : |
monnier |
332 |
;; CM's messages
|
| 229 : |
monnier |
39 |
("^\\[\\(.*GC #.*\n\\)*.*\\]" . font-lock-comment-face)
|
| 230 : |
monnier |
332 |
;; SML/NJ's irritating GC messages
|
| 231 : |
|
|
("^GC #.*" . font-lock-comment-face)
|
| 232 : |
|
|
;; error messages
|
| 233 : |
|
|
,@(mapcar (lambda (ra) (cons (car ra) 'font-lock-warning-face))
|
| 234 : |
|
|
sml-error-regexp-alist))
|
| 235 : |
|
|
"Font-locking specification for inferior SML mode.")
|
| 236 : |
monnier |
33 |
|
| 237 : |
monnier |
394 |
(defface font-lock-prompt-face
|
| 238 : |
|
|
'((t (:bold t)))
|
| 239 : |
|
|
"Font Lock mode face used to highlight prompts."
|
| 240 : |
|
|
:group 'font-lock-highlighting-faces)
|
| 241 : |
|
|
(defvar font-lock-prompt-face 'font-lock-prompt-face
|
| 242 : |
|
|
"Face name to use for prompts.")
|
| 243 : |
monnier |
33 |
|
| 244 : |
monnier |
394 |
(defface font-lock-command-face
|
| 245 : |
|
|
'((t (:bold t)))
|
| 246 : |
|
|
"Font Lock mode face used to highlight interactive commands."
|
| 247 : |
|
|
:group 'font-lock-highlighting-faces)
|
| 248 : |
|
|
(defvar font-lock-command-face 'font-lock-command-face
|
| 249 : |
|
|
"Face name to use for interactive commands.")
|
| 250 : |
|
|
|
| 251 : |
|
|
(defconst inferior-sml-font-lock-defaults
|
| 252 : |
monnier |
33 |
'(inferior-sml-font-lock-keywords nil nil nil nil))
|
| 253 : |
|
|
|
| 254 : |
monnier |
535 |
|
| 255 : |
monnier |
32 |
;;; CODE
|
| 256 : |
|
|
|
| 257 : |
monnier |
319 |
(defmap inferior-sml-mode-map
|
| 258 : |
|
|
'(("\C-c\C-s" . run-sml)
|
| 259 : |
|
|
("\t" . comint-dynamic-complete))
|
| 260 : |
|
|
"Keymap for inferior-sml mode"
|
| 261 : |
monnier |
394 |
:inherit (list sml-bindings comint-mode-map)
|
| 262 : |
|
|
:group 'sml-proc)
|
| 263 : |
monnier |
32 |
|
| 264 : |
monnier |
319 |
|
| 265 : |
monnier |
32 |
;; buffer-local
|
| 266 : |
|
|
|
| 267 : |
monnier |
332 |
(defvar sml-temp-file nil)
|
| 268 : |
monnier |
378 |
;;(defvar sml-error-file nil) ; file from which the last error came
|
| 269 : |
monnier |
32 |
(defvar sml-error-cursor nil) ; ditto
|
| 270 : |
|
|
|
| 271 : |
|
|
(defun sml-proc-buffer ()
|
| 272 : |
monnier |
535 |
"Return the current ML process buffer.
|
| 273 : |
|
|
or the current buffer if it is in `inferior-sml-mode'. Raises an error
|
| 274 : |
monnier |
32 |
if the variable `sml-buffer' does not appear to point to an existing
|
| 275 : |
|
|
buffer."
|
| 276 : |
monnier |
332 |
(or (and (eq major-mode 'inferior-sml-mode) (current-buffer))
|
| 277 : |
|
|
(and sml-buffer
|
| 278 : |
|
|
(let ((buf (get-buffer sml-buffer)))
|
| 279 : |
|
|
;; buffer-name returns nil if the buffer has been killed
|
| 280 : |
|
|
(and buf (buffer-name buf) buf)))
|
| 281 : |
|
|
;; no buffer found, make a new one
|
| 282 : |
monnier |
535 |
(call-interactively 'run-sml)))
|
| 283 : |
monnier |
32 |
|
| 284 : |
|
|
(defun sml-buffer (echo)
|
| 285 : |
|
|
"Make the current buffer the current `sml-buffer' if that is sensible.
|
| 286 : |
monnier |
535 |
Lookup variable `sml-buffer' to see why this might be useful.
|
| 287 : |
|
|
If prefix argument ECHO is set, then it only reports on the current state."
|
| 288 : |
monnier |
32 |
(interactive "P")
|
| 289 : |
monnier |
535 |
(when (not echo)
|
| 290 : |
|
|
(setq sml-buffer
|
| 291 : |
|
|
(if (eq major-mode 'inferior-sml-mode) (current-buffer)
|
| 292 : |
|
|
(read-buffer "Set ML process buffer to: " nil t))))
|
| 293 : |
|
|
(message "ML process buffer is now %s."
|
| 294 : |
monnier |
332 |
(or (ignore-errors (buffer-name (get-buffer sml-buffer)))
|
| 295 : |
|
|
"undefined")))
|
| 296 : |
monnier |
32 |
|
| 297 : |
monnier |
535 |
(defun sml-proc ()
|
| 298 : |
|
|
"Return the current ML process. See variable `sml-buffer'."
|
| 299 : |
|
|
(assert (eq major-mode 'inferior-sml-mode))
|
| 300 : |
|
|
(or (get-buffer-process (current-buffer))
|
| 301 : |
|
|
(progn (call-interactively 'run-sml)
|
| 302 : |
|
|
(get-buffer-process (current-buffer)))))
|
| 303 : |
|
|
|
| 304 : |
|
|
(define-derived-mode inferior-sml-mode comint-mode "Inferior-SML"
|
| 305 : |
monnier |
32 |
"Major mode for interacting with an inferior ML process.
|
| 306 : |
|
|
|
| 307 : |
|
|
The following commands are available:
|
| 308 : |
|
|
\\{inferior-sml-mode-map}
|
| 309 : |
|
|
|
| 310 : |
|
|
An ML process can be fired up (again) with \\[sml].
|
| 311 : |
|
|
|
| 312 : |
|
|
Customisation: Entry to this mode runs the hooks on `comint-mode-hook'
|
| 313 : |
|
|
and `inferior-sml-mode-hook' (in that order).
|
| 314 : |
|
|
|
| 315 : |
|
|
Variables controlling behaviour of this mode are
|
| 316 : |
|
|
|
| 317 : |
|
|
`sml-program-name' (default \"sml\")
|
| 318 : |
|
|
Program to run as ML.
|
| 319 : |
|
|
|
| 320 : |
|
|
`sml-use-command' (default \"use \\\"%s\\\"\")
|
| 321 : |
|
|
Template for loading a file into the inferior ML process.
|
| 322 : |
|
|
|
| 323 : |
|
|
`sml-cd-command' (default \"System.Directory.cd \\\"%s\\\"\")
|
| 324 : |
|
|
ML command for changing directories in ML process (if possible).
|
| 325 : |
|
|
|
| 326 : |
|
|
`sml-prompt-regexp' (default \"^[\\-=] *\")
|
| 327 : |
|
|
Regexp used to recognise prompts in the inferior ML process.
|
| 328 : |
|
|
|
| 329 : |
|
|
You can send text to the inferior ML process from other buffers containing
|
| 330 : |
monnier |
535 |
ML source.
|
| 331 : |
monnier |
32 |
`switch-to-sml' switches the current buffer to the ML process buffer.
|
| 332 : |
|
|
`sml-send-function' sends the current *paragraph* to the ML process.
|
| 333 : |
|
|
`sml-send-region' sends the current region to the ML process.
|
| 334 : |
|
|
|
| 335 : |
|
|
Prefixing the sml-send-<whatever> commands with \\[universal-argument]
|
| 336 : |
|
|
causes a switch to the ML process buffer after sending the text.
|
| 337 : |
|
|
|
| 338 : |
|
|
For information on running multiple processes in multiple buffers, see
|
| 339 : |
|
|
documentation for variable `sml-buffer'.
|
| 340 : |
|
|
|
| 341 : |
|
|
Commands:
|
| 342 : |
monnier |
535 |
RET after the end of the process' output sends the text from the
|
| 343 : |
monnier |
32 |
end of process to point.
|
| 344 : |
|
|
RET before the end of the process' output copies the current line
|
| 345 : |
|
|
to the end of the process' output, and sends it.
|
| 346 : |
|
|
DEL converts tabs to spaces as it moves back.
|
| 347 : |
|
|
TAB file name completion, as in shell-mode, etc.."
|
| 348 : |
|
|
(setq comint-prompt-regexp sml-prompt-regexp)
|
| 349 : |
|
|
(sml-mode-variables)
|
| 350 : |
|
|
|
| 351 : |
|
|
;; For sequencing through error messages:
|
| 352 : |
monnier |
300 |
(set (make-local-variable 'sml-error-cursor) (point-max-marker))
|
| 353 : |
monnier |
332 |
(set-marker-insertion-type sml-error-cursor nil)
|
| 354 : |
monnier |
33 |
(set (make-local-variable 'font-lock-defaults)
|
| 355 : |
|
|
inferior-sml-font-lock-defaults)
|
| 356 : |
monnier |
32 |
|
| 357 : |
monnier |
332 |
;; compilation support (used for next-error)
|
| 358 : |
|
|
(set (make-local-variable 'compilation-error-regexp-alist)
|
| 359 : |
|
|
sml-error-regexp-alist)
|
| 360 : |
monnier |
535 |
(compilation-minor-mode 1)
|
| 361 : |
|
|
;; eliminate compilation-minor-mode's map since its Mouse-2 binding
|
| 362 : |
|
|
;; is just too unbearable.
|
| 363 : |
|
|
(add-to-list 'minor-mode-overriding-map-alist
|
| 364 : |
|
|
(cons 'compilation-minor-mode (make-sparse-keymap)))
|
| 365 : |
monnier |
332 |
;; I'm sure people might kill me for that
|
| 366 : |
|
|
(setq compilation-error-screen-columns nil)
|
| 367 : |
|
|
(make-local-variable 'sml-endof-error-alist)
|
| 368 : |
|
|
;;(make-local-variable 'sml-error-overlay)
|
| 369 : |
monnier |
32 |
|
| 370 : |
monnier |
535 |
(setq mode-line-process '(": %s")))
|
| 371 : |
monnier |
32 |
|
| 372 : |
|
|
;;; FOR RUNNING ML FROM EMACS
|
| 373 : |
|
|
|
| 374 : |
monnier |
33 |
;;;###autoload
|
| 375 : |
monnier |
535 |
(autoload 'run-sml "sml-proc" nil t)
|
| 376 : |
|
|
(defalias 'run-sml 'sml-run)
|
| 377 : |
|
|
(defun sml-run (cmd arg &optional host)
|
| 378 : |
|
|
"Run the program CMD with given arguments ARG.
|
| 379 : |
|
|
The command is run in buffer *CMD* using mode `inferior-sml-mode'.
|
| 380 : |
|
|
If the buffer already exists and has a running process, then
|
| 381 : |
|
|
just go to this buffer.
|
| 382 : |
monnier |
32 |
|
| 383 : |
monnier |
535 |
This updates `sml-buffer' to the new buffer.
|
| 384 : |
|
|
You can have several inferior M(or L process running, but only one (> s
|
| 385 : |
monnier |
32 |
current one -- given by `sml-buffer' (qv).
|
| 386 : |
|
|
|
| 387 : |
monnier |
535 |
If a prefix argument is used, the user is also prompted for a HOST
|
| 388 : |
|
|
on which to run CMD using `remote-shell-program'.
|
| 389 : |
|
|
|
| 390 : |
monnier |
32 |
\(Type \\[describe-mode] in the process buffer for a list of commands.)"
|
| 391 : |
monnier |
535 |
(interactive
|
| 392 : |
|
|
(list
|
| 393 : |
|
|
(read-string "ML command: " sml-program-name)
|
| 394 : |
|
|
(if (or current-prefix-arg (> (length sml-default-arg) 0))
|
| 395 : |
|
|
(read-string "Any args: " sml-default-arg)
|
| 396 : |
|
|
sml-default-arg)
|
| 397 : |
|
|
(if (or current-prefix-arg (> (length sml-host-name) 0))
|
| 398 : |
|
|
(read-string "On host: " sml-host-name)
|
| 399 : |
|
|
sml-host-name)))
|
| 400 : |
monnier |
32 |
(let* ((pname (file-name-nondirectory cmd))
|
| 401 : |
monnier |
535 |
(args (if (equal arg "") () (split-string arg)))
|
| 402 : |
|
|
(file (when (and sml-config-file (file-exists-p sml-config-file))
|
| 403 : |
|
|
sml-config-file)))
|
| 404 : |
monnier |
332 |
;; and this -- to keep these as defaults even if
|
| 405 : |
|
|
;; they're set in the mode hooks.
|
| 406 : |
|
|
(setq sml-program-name cmd)
|
| 407 : |
|
|
(setq sml-default-arg arg)
|
| 408 : |
monnier |
535 |
(setq sml-host-name host)
|
| 409 : |
|
|
;; For remote execution, use `remote-shell-program'
|
| 410 : |
|
|
(when (> (length host) 0)
|
| 411 : |
|
|
(setq args (list* host "cd" default-directory ";" cmd args))
|
| 412 : |
|
|
(setq cmd remote-shell-program))
|
| 413 : |
|
|
;; go for it
|
| 414 : |
|
|
(setq sml-buffer (apply 'make-comint pname cmd file args))
|
| 415 : |
monnier |
32 |
|
| 416 : |
monnier |
535 |
(pop-to-buffer sml-buffer)
|
| 417 : |
|
|
;;(message (format "Starting \"%s\" in background." pname))
|
| 418 : |
monnier |
332 |
(inferior-sml-mode)
|
| 419 : |
|
|
(goto-char (point-max))
|
| 420 : |
|
|
sml-buffer))
|
| 421 : |
|
|
|
| 422 : |
monnier |
535 |
(defun switch-to-sml (eobp)
|
| 423 : |
monnier |
32 |
"Switch to the ML process buffer.
|
| 424 : |
monnier |
535 |
Move point to the end of buffer unless prefix argument EOBP is set."
|
| 425 : |
monnier |
32 |
(interactive "P")
|
| 426 : |
monnier |
33 |
(pop-to-buffer (sml-proc-buffer))
|
| 427 : |
monnier |
535 |
(unless eobp
|
| 428 : |
|
|
(push-mark (point) t)
|
| 429 : |
|
|
(goto-char (point-max))))
|
| 430 : |
monnier |
32 |
|
| 431 : |
|
|
;; Fakes it with a "use <temp-file>;" if necessary.
|
| 432 : |
|
|
|
| 433 : |
|
|
(defun sml-send-region (start end &optional and-go)
|
| 434 : |
monnier |
535 |
"Send current region START..END to the inferior ML process.
|
| 435 : |
|
|
Prefix AND-GO argument means switch-to-sml afterwards.
|
| 436 : |
monnier |
32 |
|
| 437 : |
monnier |
332 |
The region is written out to a temporary file and a \"use <temp-file>\" command
|
| 438 : |
|
|
is sent to the compiler.
|
| 439 : |
|
|
See variables `sml-use-command'."
|
| 440 : |
monnier |
32 |
(interactive "r\nP")
|
| 441 : |
monnier |
332 |
(if (= start end)
|
| 442 : |
|
|
(message "The region is zero (ignored)")
|
| 443 : |
|
|
(let* ((buf (sml-proc-buffer))
|
| 444 : |
|
|
(file (buffer-file-name))
|
| 445 : |
|
|
(marker (copy-marker start))
|
| 446 : |
|
|
(tmp (make-temp-file "sml")))
|
| 447 : |
|
|
(write-region start end tmp nil 'silently)
|
| 448 : |
|
|
(with-current-buffer buf
|
| 449 : |
|
|
(when sml-temp-file
|
| 450 : |
|
|
(ignore-errors (delete-file (car sml-temp-file)))
|
| 451 : |
|
|
(set-marker (cdr sml-temp-file) nil))
|
| 452 : |
|
|
(setq sml-temp-file (cons tmp marker))
|
| 453 : |
|
|
(sml-send-string (format sml-use-command tmp) nil and-go)))))
|
| 454 : |
monnier |
32 |
|
| 455 : |
|
|
;; This is quite bogus, so it isn't bound to a key by default.
|
| 456 : |
|
|
;; Anyone coming up with an algorithm to recognise fun & local
|
| 457 : |
|
|
;; declarations surrounding point will do everyone a favour!
|
| 458 : |
|
|
|
| 459 : |
|
|
(defun sml-send-function (&optional and-go)
|
| 460 : |
|
|
"Send current paragraph to the inferior ML process.
|
| 461 : |
monnier |
535 |
With a prefix argument AND-GO switch to the sml buffer as well
|
| 462 : |
monnier |
32 |
\(cf. `sml-send-region'\)."
|
| 463 : |
|
|
(interactive "P")
|
| 464 : |
|
|
(save-excursion
|
| 465 : |
|
|
(sml-mark-function)
|
| 466 : |
|
|
(sml-send-region (point) (mark)))
|
| 467 : |
|
|
(if and-go (switch-to-sml nil)))
|
| 468 : |
|
|
|
| 469 : |
monnier |
332 |
(defvar sml-source-modes '(sml-mode)
|
| 470 : |
|
|
"*Used to determine if a buffer contains ML source code.
|
| 471 : |
monnier |
319 |
If it's loaded into a buffer that is in one of these major modes, it's
|
| 472 : |
monnier |
535 |
considered an ML source file by `sml-load-file'. Used by these commands
|
| 473 : |
monnier |
319 |
to determine defaults.")
|
| 474 : |
|
|
|
| 475 : |
monnier |
32 |
(defun sml-send-buffer (&optional and-go)
|
| 476 : |
|
|
"Send buffer to inferior shell running ML process.
|
| 477 : |
monnier |
535 |
With a prefix argument AND-GO switch to the sml buffer as well
|
| 478 : |
monnier |
32 |
\(cf. `sml-send-region'\)."
|
| 479 : |
|
|
(interactive "P")
|
| 480 : |
|
|
(if (memq major-mode sml-source-modes)
|
| 481 : |
|
|
(sml-send-region (point-min) (point-max) and-go)))
|
| 482 : |
|
|
|
| 483 : |
|
|
;; Since sml-send-function/region take an optional prefix arg, these
|
| 484 : |
|
|
;; commands are redundant. But they are kept around for the user to
|
| 485 : |
|
|
;; bind if she wishes, since its easier to type C-c r than C-u C-c C-r.
|
| 486 : |
|
|
|
| 487 : |
|
|
(defun sml-send-region-and-go (start end)
|
| 488 : |
monnier |
535 |
"Send current region START..END to the inferior ML process, and go there."
|
| 489 : |
monnier |
32 |
(interactive "r")
|
| 490 : |
|
|
(sml-send-region start end t))
|
| 491 : |
|
|
|
| 492 : |
|
|
(defun sml-send-function-and-go ()
|
| 493 : |
|
|
"Send current paragraph to the inferior ML process, and go there."
|
| 494 : |
|
|
(interactive)
|
| 495 : |
|
|
(sml-send-function t))
|
| 496 : |
|
|
|
| 497 : |
|
|
;;; 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
|
| 498 : |
|
|
|
| 499 : |
|
|
(defun sml-drag-region (event)
|
| 500 : |
|
|
"Highlight the text the mouse is dragged over, and send it to ML.
|
| 501 : |
monnier |
535 |
This must be bound to a button-down mouse EVENT, currently \\[sml-drag-region].
|
| 502 : |
monnier |
32 |
|
| 503 : |
|
|
If you drag the mouse (ie, keep the mouse button depressed) the
|
| 504 : |
|
|
program text sent to the complier is delimited by where you started
|
| 505 : |
|
|
dragging the mouse, and where you release the mouse button.
|
| 506 : |
|
|
|
| 507 : |
|
|
If you only click the mouse, the program text sent to the compiler is
|
| 508 : |
|
|
delimited by the current position of point and the place where you
|
| 509 : |
|
|
click the mouse.
|
| 510 : |
|
|
|
| 511 : |
|
|
In either event, the values of both point and mark are left
|
| 512 : |
|
|
undisturbed once this operation is completed."
|
| 513 : |
|
|
(interactive "e")
|
| 514 : |
|
|
(let ((mark-ring) ;BAD: selection start gets cons'd
|
| 515 : |
|
|
(pmark (point))) ;where point is now
|
| 516 : |
|
|
(if (fboundp 'mouse-track-default)
|
| 517 : |
|
|
;; Assume this is XEmacs, otherwise assume its Emacs
|
| 518 : |
|
|
(save-excursion
|
| 519 : |
|
|
(let ((zmacs-regions))
|
| 520 : |
|
|
(set-marker (mark-marker) nil)
|
| 521 : |
|
|
(mouse-track-default event)
|
| 522 : |
|
|
(if (not (region-exists-p)) (push-mark pmark nil t))
|
| 523 : |
|
|
(call-interactively 'sml-send-region)))
|
| 524 : |
|
|
;; Emacs: making this buffer-local ought to happen in sml-mode
|
| 525 : |
|
|
(make-local-variable 'transient-mark-mode)
|
| 526 : |
|
|
(save-excursion
|
| 527 : |
|
|
(let ((transient-mark-mode 1))
|
| 528 : |
|
|
(mouse-drag-region event)
|
| 529 : |
|
|
(if (not mark-active) (push-mark pmark nil t))
|
| 530 : |
|
|
(call-interactively 'sml-send-region))))))
|
| 531 : |
|
|
|
| 532 : |
|
|
|
| 533 : |
|
|
;;; LOADING AND IMPORTING SOURCE FILES:
|
| 534 : |
|
|
|
| 535 : |
monnier |
332 |
(defvar sml-prev-dir/file nil
|
| 536 : |
monnier |
535 |
"Cache for (DIRECTORY . FILE) pair last.
|
| 537 : |
|
|
Set in `sml-load-file' and `sml-cd' commands.
|
| 538 : |
|
|
Used to determine the default in the next `ml-load-file'.")
|
| 539 : |
monnier |
32 |
|
| 540 : |
|
|
(defun sml-load-file (&optional and-go)
|
| 541 : |
|
|
"Load an ML file into the current inferior ML process.
|
| 542 : |
monnier |
535 |
With a prefix argument AND-GO switch to sml buffer as well.
|
| 543 : |
monnier |
32 |
|
| 544 : |
|
|
This command uses the ML command template `sml-use-command' to construct
|
| 545 : |
|
|
the command to send to the ML process\; a trailing \"\;\\n\" will be added
|
| 546 : |
|
|
automatically."
|
| 547 : |
|
|
(interactive "P")
|
| 548 : |
monnier |
332 |
(let ((file (car (comint-get-source
|
| 549 : |
|
|
"Load ML file: " sml-prev-dir/file sml-source-modes t))))
|
| 550 : |
|
|
(with-current-buffer (sml-proc-buffer)
|
| 551 : |
|
|
;; Check if buffer needs saved. Should (save-some-buffers) instead?
|
| 552 : |
|
|
(comint-check-source file)
|
| 553 : |
|
|
(setq sml-prev-dir/file
|
| 554 : |
|
|
(cons (file-name-directory file) (file-name-nondirectory file)))
|
| 555 : |
|
|
(sml-send-string (format sml-use-command file) nil and-go))))
|
| 556 : |
monnier |
32 |
|
| 557 : |
|
|
(defun sml-cd (dir)
|
| 558 : |
|
|
"Change the working directory of the inferior ML process.
|
| 559 : |
monnier |
535 |
The default directory of the process buffer is changed to DIR. If the
|
| 560 : |
monnier |
32 |
variable `sml-cd-command' is non-nil it should be an ML command that will
|
| 561 : |
|
|
be executed to change the compiler's working directory\; a trailing
|
| 562 : |
|
|
\"\;\\n\" will be added automatically."
|
| 563 : |
|
|
(interactive "DSML Directory: ")
|
| 564 : |
monnier |
332 |
(let ((dir (expand-file-name dir)))
|
| 565 : |
|
|
(with-current-buffer (sml-proc-buffer)
|
| 566 : |
|
|
(sml-send-string (format sml-cd-command dir) t)
|
| 567 : |
|
|
(setq default-directory dir))
|
| 568 : |
|
|
(setq sml-prev-dir/file (cons dir nil))))
|
| 569 : |
monnier |
32 |
|
| 570 : |
monnier |
332 |
(defun sml-send-string (str &optional print and-go)
|
| 571 : |
|
|
(let ((proc (sml-proc))
|
| 572 : |
|
|
(str (concat str ";\n"))
|
| 573 : |
|
|
(win (get-buffer-window (current-buffer) 'visible)))
|
| 574 : |
|
|
(when win (select-window win))
|
| 575 : |
|
|
(goto-char (point-max))
|
| 576 : |
|
|
(when print (insert str))
|
| 577 : |
|
|
(sml-update-cursor)
|
| 578 : |
|
|
(set-marker (process-mark proc) (point-max))
|
| 579 : |
|
|
(setq compilation-last-buffer (current-buffer))
|
| 580 : |
|
|
(comint-send-string proc str)
|
| 581 : |
|
|
(when and-go (switch-to-sml nil))))
|
| 582 : |
monnier |
32 |
|
| 583 : |
monnier |
332 |
(defun sml-compile (command)
|
| 584 : |
monnier |
535 |
"Pass a COMMAND to the SML process to compile the current program.
|
| 585 : |
|
|
|
| 586 : |
|
|
You can then use the command \\[next-error] to find the next error message
|
| 587 : |
|
|
and move to the source code that caused it.
|
| 588 : |
|
|
|
| 589 : |
|
|
Interactively, prompts for the command if `compilation-read-command' is
|
| 590 : |
|
|
non-nil. With prefix arg, always prompts."
|
| 591 : |
monnier |
33 |
(interactive
|
| 592 : |
monnier |
535 |
(let* ((dir default-directory)
|
| 593 : |
|
|
(cmd "cd \"."))
|
| 594 : |
|
|
;; look for files to determine the default command
|
| 595 : |
|
|
(while (and (stringp dir)
|
| 596 : |
|
|
(dolist (cf sml-compile-commands-alist 1)
|
| 597 : |
|
|
(when (file-exists-p (expand-file-name (cdr cf) dir))
|
| 598 : |
|
|
(setq cmd (concat cmd "\"; " (car cf))) (return nil))))
|
| 599 : |
|
|
(let ((newdir (file-name-directory (directory-file-name dir))))
|
| 600 : |
|
|
(setq dir (unless (equal newdir dir) newdir))
|
| 601 : |
|
|
(setq cmd (concat cmd "/.."))))
|
| 602 : |
|
|
(setq cmd
|
| 603 : |
|
|
(cond
|
| 604 : |
|
|
((local-variable-p 'sml-compile-command) sml-compile-command)
|
| 605 : |
|
|
((string-match "^\\s-*cd\\s-+\"\\.\"\\s-*;\\s-*" cmd)
|
| 606 : |
|
|
(substring cmd (match-end 0)))
|
| 607 : |
|
|
((string-match "^\\s-*cd\\s-+\"\\(\\./\\)" cmd)
|
| 608 : |
|
|
(replace-match "" t t cmd 1))
|
| 609 : |
|
|
((string-match ";" cmd) cmd)
|
| 610 : |
|
|
(t sml-compile-command)))
|
| 611 : |
|
|
;; code taken from compile.el
|
| 612 : |
|
|
(if (or compilation-read-command current-prefix-arg)
|
| 613 : |
|
|
(list (read-from-minibuffer "Compile command: "
|
| 614 : |
|
|
cmd nil nil '(compile-history . 1)))
|
| 615 : |
|
|
(list cmd))))
|
| 616 : |
|
|
;; ;; now look for command's file to determine the directory
|
| 617 : |
|
|
;; (setq dir default-directory)
|
| 618 : |
|
|
;; (while (and (stringp dir)
|
| 619 : |
|
|
;; (dolist (cf sml-compile-commands-alist t)
|
| 620 : |
|
|
;; (when (and (equal cmd (car cf))
|
| 621 : |
|
|
;; (file-exists-p (expand-file-name (cdr cf) dir)))
|
| 622 : |
|
|
;; (return nil))))
|
| 623 : |
|
|
;; (let ((newdir (file-name-directory (directory-file-name dir))))
|
| 624 : |
|
|
;; (setq dir (unless (equal newdir dir) newdir))))
|
| 625 : |
|
|
;; (setq dir (or dir default-directory))
|
| 626 : |
|
|
;; (list cmd dir)))
|
| 627 : |
|
|
(set (make-local-variable 'sml-compile-command) command)
|
| 628 : |
monnier |
332 |
(save-some-buffers (not compilation-ask-about-save) nil)
|
| 629 : |
monnier |
535 |
(let ((dir default-directory))
|
| 630 : |
|
|
(when (string-match "^\\s-*cd\\s-+\"\\([^\"]+\\)\"\\s-*;" command)
|
| 631 : |
blume |
566 |
(setq dir (match-string 1 command))
|
| 632 : |
monnier |
535 |
(setq command (replace-match "" t t command)))
|
| 633 : |
blume |
566 |
(setq dir (expand-file-name dir))
|
| 634 : |
monnier |
332 |
(with-current-buffer (sml-proc-buffer)
|
| 635 : |
|
|
(setq default-directory dir)
|
| 636 : |
|
|
(sml-send-string (concat (format sml-cd-command dir) "; " command) t t))))
|
| 637 : |
monnier |
32 |
|
| 638 : |
monnier |
33 |
;;; PARSING ERROR MESSAGES
|
| 639 : |
monnier |
32 |
|
| 640 : |
|
|
;; This should need no modification to support other compilers.
|
| 641 : |
|
|
|
| 642 : |
monnier |
332 |
;; Update the buffer-local error-cursor in proc-buffer to be its
|
| 643 : |
|
|
;; current proc mark.
|
| 644 : |
monnier |
32 |
|
| 645 : |
monnier |
332 |
(defvar sml-endof-error-alist nil)
|
| 646 : |
monnier |
32 |
|
| 647 : |
monnier |
332 |
(defun sml-update-cursor ()
|
| 648 : |
|
|
;; update buffer local variable
|
| 649 : |
|
|
(set-marker sml-error-cursor (1- (process-mark (sml-proc))))
|
| 650 : |
|
|
(setq sml-endof-error-alist nil)
|
| 651 : |
|
|
(compilation-forget-errors)
|
| 652 : |
monnier |
378 |
(if (markerp compilation-parsing-end)
|
| 653 : |
|
|
(set-marker compilation-parsing-end sml-error-cursor)
|
| 654 : |
|
|
(setq compilation-parsing-end sml-error-cursor)))
|
| 655 : |
monnier |
32 |
|
| 656 : |
monnier |
332 |
(defun sml-make-error (f c)
|
| 657 : |
|
|
(let ((err (point-marker))
|
| 658 : |
|
|
(linenum (string-to-number c))
|
| 659 : |
|
|
(filename (list (first f) (second f)))
|
| 660 : |
|
|
(column (string-to-number (compile-buffer-substring (third f)))))
|
| 661 : |
|
|
;; record the end of error, if any
|
| 662 : |
|
|
(when (fourth f)
|
| 663 : |
monnier |
535 |
(let ((endlinestr (compile-buffer-substring (fourth f))))
|
| 664 : |
|
|
(when endlinestr
|
| 665 : |
|
|
(let* ((endline (string-to-number endlinestr))
|
| 666 : |
|
|
(endcol (string-to-number
|
| 667 : |
|
|
(or (compile-buffer-substring (fifth f)) "0")))
|
| 668 : |
|
|
(linediff (- endline linenum)))
|
| 669 : |
|
|
(push (list err linediff (if (= 0 linediff) (- endcol column) endcol))
|
| 670 : |
|
|
sml-endof-error-alist)))))
|
| 671 : |
monnier |
332 |
;; build the error descriptor
|
| 672 : |
|
|
(if (string= (car sml-temp-file) (first f))
|
| 673 : |
|
|
;; special case for code sent via sml-send-region
|
| 674 : |
|
|
(let ((marker (cdr sml-temp-file)))
|
| 675 : |
|
|
(with-current-buffer (marker-buffer marker)
|
| 676 : |
|
|
(goto-char marker)
|
| 677 : |
|
|
(forward-line (1- linenum))
|
| 678 : |
|
|
(forward-char (1- column))
|
| 679 : |
|
|
(cons err (point-marker))))
|
| 680 : |
|
|
;; taken from compile.el
|
| 681 : |
|
|
(list err filename linenum column))))
|
| 682 : |
monnier |
32 |
|
| 683 : |
monnier |
332 |
(defadvice compilation-goto-locus (after sml-endof-error activate)
|
| 684 : |
|
|
(let* ((next-error (ad-get-arg 0))
|
| 685 : |
|
|
(err (car next-error))
|
| 686 : |
|
|
(pos (cdr next-error))
|
| 687 : |
|
|
(endof (with-current-buffer (marker-buffer err)
|
| 688 : |
|
|
(assq err sml-endof-error-alist))))
|
| 689 : |
|
|
(if (not endof) (sml-error-overlay 'undo)
|
| 690 : |
|
|
(with-current-buffer (marker-buffer pos)
|
| 691 : |
|
|
(goto-char pos)
|
| 692 : |
|
|
(let ((linediff (second endof))
|
| 693 : |
|
|
(coldiff (third endof)))
|
| 694 : |
|
|
(when (> 0 linediff) (forward-line linediff))
|
| 695 : |
|
|
(forward-char coldiff))
|
| 696 : |
|
|
(sml-error-overlay nil pos (point))
|
| 697 : |
|
|
(push-mark nil t (not sml-error-overlay))
|
| 698 : |
|
|
(goto-char pos)))))
|
| 699 : |
monnier |
32 |
|
| 700 : |
monnier |
332 |
(defun sml-error-overlay (undo &optional beg end)
|
| 701 : |
monnier |
535 |
"Move `sml-error-overlay' to the text region in the current buffer.
|
| 702 : |
|
|
If the buffer-local variable `sml-error-overlay' is
|
| 703 : |
monnier |
332 |
non-nil it should be an overlay \(or extent, in XEmacs speak\)\; this
|
| 704 : |
|
|
function moves the overlay over the current region. If the optional
|
| 705 : |
|
|
BUFFER argument is given, move the overlay in that buffer instead of
|
| 706 : |
|
|
the current buffer.
|
| 707 : |
|
|
|
| 708 : |
|
|
Called interactively, the optional prefix argument UNDO indicates that
|
| 709 : |
|
|
the overlay should simply be removed: \\[universal-argument] \
|
| 710 : |
|
|
\\[sml-error-overlay]."
|
| 711 : |
monnier |
32 |
(interactive "P")
|
| 712 : |
monnier |
332 |
(when sml-error-overlay
|
| 713 : |
|
|
(unless (overlayp sml-error-overlay)
|
| 714 : |
|
|
(let ((ol sml-error-overlay))
|
| 715 : |
|
|
(setq sml-error-overlay (make-overlay 0 0))
|
| 716 : |
|
|
(overlay-put sml-error-overlay 'face (if (symbolp ol) ol 'region))))
|
| 717 : |
monnier |
394 |
(if undo (move-overlay sml-error-overlay 1 1 (current-buffer))
|
| 718 : |
monnier |
332 |
;; if active regions, signals mark not active if no region set
|
| 719 : |
|
|
(let ((beg (or beg (region-beginning)))
|
| 720 : |
|
|
(end (or end (region-end))))
|
| 721 : |
|
|
(move-overlay sml-error-overlay beg end (current-buffer))))))
|
| 722 : |
monnier |
32 |
|
| 723 : |
|
|
;;; 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
|
| 724 : |
|
|
|
| 725 : |
monnier |
535 |
;;(define-key sml-mode-map [(meta shift down-mouse-1)] 'sml-drag-region)
|
| 726 : |
monnier |
32 |
|
| 727 : |
monnier |
535 |
(provide 'sml-proc)
|
| 728 : |
monnier |
32 |
|
| 729 : |
monnier |
535 |
;;; sml-proc.el ends here
|
Parent Directory
| 
Revision Log
