1 : |
monnier |
32 |
;;; sml-proc.el. Comint based interaction mode for Standard ML.
|
2 : |
|
|
|
3 : |
|
|
;; Copyright (C) 1989, Lars Bo Nielsen, 1994,1997 Matthew J. Morley
|
4 : |
|
|
|
5 : |
|
|
;; $Revision$
|
6 : |
|
|
;; $Date$
|
7 : |
|
|
|
8 : |
|
|
;; ====================================================================
|
9 : |
|
|
|
10 : |
|
|
;; This file is not part of GNU Emacs, but it is distributed under the
|
11 : |
|
|
;; same conditions.
|
12 : |
|
|
|
13 : |
|
|
;; This program is free software; you can redistribute it and/or
|
14 : |
|
|
;; modify it under the terms of the GNU General Public License as
|
15 : |
|
|
;; published by the Free Software Foundation; either version 2, or (at
|
16 : |
|
|
;; your option) any later version.
|
17 : |
|
|
|
18 : |
|
|
;; This program is distributed in the hope that it will be useful, but
|
19 : |
|
|
;; WITHOUT ANY WARRANTY; without even the implied warranty of
|
20 : |
|
|
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
|
21 : |
|
|
;; General Public License for more details.
|
22 : |
|
|
|
23 : |
|
|
;; You should have received a copy of the GNU General Public License
|
24 : |
|
|
;; along with GNU Emacs; see the file COPYING. If not, write to the
|
25 : |
|
|
;; Free Software Foundation, 675 Mass Ave, Cambridge, MA 0139, USA.
|
26 : |
|
|
;; (See sml-mode.el for HISTORY.)
|
27 : |
|
|
|
28 : |
|
|
;; ====================================================================
|
29 : |
|
|
|
30 : |
|
|
;; [MJM 10/94] Separating this from sml-mode means sml-mode will run
|
31 : |
|
|
;; under 18.59 (or anywhere without comint, if there are such places).
|
32 : |
|
|
;; See sml-mode.el for further information.
|
33 : |
|
|
|
34 : |
|
|
;;; DESCRIPTION
|
35 : |
|
|
|
36 : |
|
|
;; Inferior-sml-mode is for interacting with an ML process run under
|
37 : |
|
|
;; emacs. This uses the comint package so you get history, expansion,
|
38 : |
|
|
;; backup and all the other benefits of comint. Interaction is
|
39 : |
|
|
;; achieved by M-x sml which starts a sub-process under emacs. You may
|
40 : |
|
|
;; need to set this up for autoloading in your .emacs:
|
41 : |
|
|
|
42 : |
|
|
;; (autoload 'sml "sml-proc" "Run an inferior ML process." t)
|
43 : |
|
|
|
44 : |
|
|
;; Exactly what process is governed by the variable sml-program-name
|
45 : |
|
|
;; -- just "sml" by default. If you give a prefix argument (C-u M-x
|
46 : |
|
|
;; sml) you will be prompted for a different program to execute from
|
47 : |
|
|
;; the default -- if you just hit RETURN you get the default anyway --
|
48 : |
|
|
;; along with the option to specify any command line arguments. Once
|
49 : |
|
|
;; you select the ML program name in this manner, it remains the
|
50 : |
|
|
;; default (unless you set in a hook, or otherwise).
|
51 : |
|
|
|
52 : |
|
|
;; NOTE: inferior-sml-mode-hook is run AFTER the ML program has been
|
53 : |
|
|
;; launched. inferior-sml-load-hook is run only when sml-proc.el is
|
54 : |
|
|
;; loaded into Emacs.
|
55 : |
|
|
|
56 : |
|
|
;; When running an ML process some further key-bindings are effective
|
57 : |
|
|
;; in sml-mode buffer(s). C-c C-s (switch-to-sml) will split the
|
58 : |
|
|
;; screen into two windows if necessary and place you in the ML
|
59 : |
|
|
;; process buffer. In the interaction buffer, C-c C-s is bound to the
|
60 : |
|
|
;; `sml' command by default (in case you need to restart).
|
61 : |
|
|
|
62 : |
|
|
;; C-c C-l (sml-load-file) will load an SML source file into the
|
63 : |
|
|
;; inferior process, C-c C-r (sml-send-region) will send the current
|
64 : |
|
|
;; region of text to the ML process, etc. Given a prefix argument to
|
65 : |
|
|
;; these commands will switch you from the SML buffer to the ML
|
66 : |
|
|
;; process buffer as well as sending the text. If you get errors
|
67 : |
|
|
;; reported by the compiler, C-c ` (sml-next-error) will step through
|
68 : |
|
|
;; the errors with you.
|
69 : |
|
|
|
70 : |
|
|
;; NOTE. There is only limited support for this as it obviously
|
71 : |
|
|
;; depends on the compiler's error messages being recognised by the
|
72 : |
|
|
;; mode. Error reporting is currently only geared up for SML/NJ,
|
73 : |
|
|
;; Moscow ML, and Poly/ML (see file sml-{mosml,poly-ml}.el). Look at
|
74 : |
|
|
;; the documentation for sml-error-parser and sml-next-error -- you
|
75 : |
|
|
;; may only need to modify the former to recover this feature for some
|
76 : |
|
|
;; other ML systems, along with sml-error-regexp.
|
77 : |
|
|
|
78 : |
|
|
;; While small pieces of text can be fed quite happily into the ML
|
79 : |
|
|
;; process directly, lager pieces should (probably) be sent via a
|
80 : |
|
|
;; temporary file making use of the compiler's "use" command.
|
81 : |
|
|
|
82 : |
|
|
;; CURRENT RATIONALE: you get sense out of the error messages if
|
83 : |
|
|
;; there's a real file associated with a block of code, and XEmacs is
|
84 : |
|
|
;; less likely to hang. These are likely to change.
|
85 : |
|
|
|
86 : |
|
|
;; For more information see the variable sml-temp-threshold. You
|
87 : |
|
|
;; should set the variable sml-use-command appropriately for your ML
|
88 : |
|
|
;; compiler. By default things are set up to work for the SML/NJ
|
89 : |
|
|
;; compiler.
|
90 : |
|
|
|
91 : |
|
|
;;; FOR YOUR .EMACS
|
92 : |
|
|
|
93 : |
|
|
;; Here are some ideas for inferior-sml-*-hooks:
|
94 : |
|
|
|
95 : |
|
|
;; (setq inferior-sml-load-hook
|
96 : |
|
|
;; '(lambda() "Set global defaults for inferior-sml-mode"
|
97 : |
|
|
;; (define-key inferior-sml-mode-map "\C-cd" 'sml-cd)
|
98 : |
|
|
;; (define-key sml-mode-map "\C-cd" 'sml-cd)
|
99 : |
|
|
;; (define-key sml-mode-map "\C-c\C-f" 'sml-send-function)
|
100 : |
|
|
;; (setq sml-temp-threshold 0))) ; safe: always use tmp file
|
101 : |
|
|
|
102 : |
|
|
;; (setq inferior-sml-mode-hook
|
103 : |
|
|
;; '(lambda() "Inferior SML mode defaults"
|
104 : |
|
|
;; (setq comint-scroll-show-maximum-output t
|
105 : |
|
|
;; comint-scroll-to-bottom-on-output t
|
106 : |
|
|
;; comint-input-autoexpand nil)))
|
107 : |
|
|
|
108 : |
|
|
;; ===================================================================
|
109 : |
|
|
|
110 : |
|
|
;;; INFERIOR ML MODE VARIABLES
|
111 : |
|
|
|
112 : |
|
|
(require 'sml-mode)
|
113 : |
|
|
(require 'comint)
|
114 : |
|
|
(provide 'sml-proc)
|
115 : |
|
|
|
116 : |
|
|
(defvar sml-program-name "sml"
|
117 : |
|
|
"*Program to run as ML.")
|
118 : |
|
|
|
119 : |
|
|
(defvar sml-default-arg ""
|
120 : |
|
|
"*Default command line option to pass, if any.")
|
121 : |
|
|
|
122 : |
monnier |
33 |
(defvar sml-make-command "CM.make()"
|
123 : |
|
|
"The command used by default by `sml-make'.")
|
124 : |
monnier |
32 |
|
125 : |
monnier |
33 |
(defvar sml-make-file-name "sources.cm"
|
126 : |
|
|
"The name of the makefile that `sml-make' will look for (if non-nil).")
|
127 : |
monnier |
32 |
|
128 : |
|
|
;;(defvar sml-raise-on-error nil
|
129 : |
|
|
;; "*When non-nil, `sml-next-error' will raise the ML process's frame.")
|
130 : |
|
|
|
131 : |
|
|
(defvar sml-temp-threshold 0
|
132 : |
|
|
"*Controls when emacs uses temporary files to communicate with ML.
|
133 : |
|
|
If not a number (e.g., NIL), then emacs always sends text directly to
|
134 : |
|
|
the subprocess. If an integer N, then emacs uses a temporary file
|
135 : |
|
|
whenever the text is longer than N chars. `sml-temp-file' contains the
|
136 : |
|
|
name of the temporary file for communicating. See variable
|
137 : |
|
|
`sml-use-command' and function `sml-send-region'.
|
138 : |
|
|
|
139 : |
|
|
Sending regions directly through the pty (not using temp files)
|
140 : |
|
|
doesn't work very well -- e.g., SML/NJ nor Poly/ML incorrectly report
|
141 : |
|
|
the line # of errors occurring in std_in.")
|
142 : |
|
|
|
143 : |
monnier |
33 |
(defvar sml-temp-file
|
144 : |
|
|
(make-temp-name
|
145 : |
|
|
(concat (file-name-as-directory (or (getenv "TMPDIR") "/tmp")) "/ml"))
|
146 : |
monnier |
32 |
"*Temp file that emacs uses to communicate with the ML process.
|
147 : |
|
|
See `sml-temp-threshold'. Defaults to \(make-temp-name \"/tmp/ml\"\)")
|
148 : |
|
|
|
149 : |
|
|
(defvar inferior-sml-mode-hook nil
|
150 : |
|
|
"*This hook is run when the inferior ML process is started.
|
151 : |
|
|
All buffer local customisations for the interaction buffers go here.")
|
152 : |
|
|
|
153 : |
|
|
(defvar inferior-sml-load-hook nil
|
154 : |
|
|
"*Hook run when inferior-sml-mode (sml-proc.el) is loaded into Emacs.
|
155 : |
|
|
This is a good place to put your preferred key bindings.")
|
156 : |
|
|
|
157 : |
|
|
(defvar sml-buffer nil
|
158 : |
|
|
"*The current ML process buffer.
|
159 : |
|
|
|
160 : |
|
|
MULTIPLE PROCESS SUPPORT (Whoever wants multi-process support anyway?)
|
161 : |
|
|
=====================================================================
|
162 : |
|
|
sml-mode supports, in a fairly simple fashion, running multiple ML
|
163 : |
|
|
processes. To run multiple ML processes, you start the first up with
|
164 : |
|
|
\\[sml]. It will be in a buffer named *sml*. Rename this buffer with
|
165 : |
|
|
\\[rename-buffer]. You may now start up a new process with another
|
166 : |
|
|
\\[sml]. It will be in a new buffer, named *sml*. You can switch
|
167 : |
|
|
between the different process buffers with \\[switch-to-buffer].
|
168 : |
|
|
|
169 : |
|
|
NB *sml* is just the default name for the buffer. It actually gets
|
170 : |
|
|
it's name from the value of `sml-program-name' -- *poly*, *smld*,...
|
171 : |
|
|
|
172 : |
|
|
If you have more than one ML process around, commands that send text
|
173 : |
|
|
from source buffers to ML processes -- like `sml-send-function' or
|
174 : |
|
|
`sml-send-region' -- have to choose a process to send it to. This is
|
175 : |
|
|
determined by the global variable `sml-buffer'. Suppose you have three
|
176 : |
|
|
inferior ML's running:
|
177 : |
|
|
Buffer Process
|
178 : |
|
|
sml #<process sml>
|
179 : |
|
|
mosml #<process mosml>
|
180 : |
|
|
*sml* #<process sml<2>>
|
181 : |
|
|
If you do a \\[sml-send-function] command on some ML source code,
|
182 : |
|
|
what process do you send it to?
|
183 : |
|
|
|
184 : |
|
|
- If you're in a process buffer (sml, mosml, or *sml*), you send it to
|
185 : |
|
|
that process (usually makes sense only to `sml-load-file').
|
186 : |
|
|
- If you're in some other buffer (e.g., a source file), you send it to
|
187 : |
|
|
the process attached to buffer `sml-buffer'.
|
188 : |
|
|
|
189 : |
|
|
This process selection is performed by function `sml-proc' which looks
|
190 : |
|
|
at the value of `sml-buffer' -- which must be a lisp buffer object, or
|
191 : |
|
|
a string \(or nil\).
|
192 : |
|
|
|
193 : |
|
|
Whenever \\[sml] fires up a new process, it resets `sml-buffer' to be
|
194 : |
|
|
the new process's buffer. If you only run one process, this will do
|
195 : |
|
|
the right thing. If you run multiple processes, you can change
|
196 : |
|
|
`sml-buffer' to another process buffer with \\[set-variable], or
|
197 : |
|
|
use the command \\[sml-buffer] in the interaction buffer of choice.")
|
198 : |
|
|
|
199 : |
|
|
|
200 : |
|
|
;;; ALL STUFF THAT DEFAULTS TO THE SML/NJ COMPILER (0.93)
|
201 : |
|
|
|
202 : |
|
|
(defvar sml-use-command "use \"%s\""
|
203 : |
|
|
"*Template for loading a file into the inferior ML process.
|
204 : |
|
|
Set to \"use \\\"%s\\\"\" for SML/NJ or Edinburgh ML;
|
205 : |
|
|
set to \"PolyML.use \\\"%s\\\"\" for Poly/ML, etc.")
|
206 : |
|
|
|
207 : |
monnier |
33 |
(defvar sml-cd-command "OS.FileSys.chDir \"%s\""
|
208 : |
monnier |
32 |
"*Command template for changing working directories under ML.
|
209 : |
|
|
Set this to nil if your compiler can't change directories.
|
210 : |
|
|
|
211 : |
|
|
The format specifier \"%s\" will be converted into the directory name
|
212 : |
|
|
specified when running the command \\[sml-cd].")
|
213 : |
|
|
|
214 : |
|
|
(defvar sml-prompt-regexp "^[\-=] *"
|
215 : |
|
|
"*Regexp used to recognise prompts in the inferior ML process.")
|
216 : |
|
|
|
217 : |
|
|
(defvar sml-error-parser 'sml-smlnj-error-parser
|
218 : |
|
|
"*This function parses an error message into a 3-5 element list:
|
219 : |
|
|
|
220 : |
|
|
\(file start-line start-col end-line-col err-msg\).
|
221 : |
|
|
|
222 : |
|
|
The first three components are required by `sml-next-error', but the other
|
223 : |
|
|
two are optional. If the file associated with the input is the standard
|
224 : |
|
|
input stream, this function should probably return
|
225 : |
|
|
|
226 : |
|
|
\(\"std_in\" start-line start-col\).
|
227 : |
|
|
|
228 : |
|
|
This function will be called in a context in which the match data \(see
|
229 : |
|
|
`match-data'\) are current for `sml-error-regexp'. The mode sets the
|
230 : |
|
|
default value to the function `sml-smlnj-error-parser'.
|
231 : |
|
|
|
232 : |
|
|
In a step towards greater sml-mode modularity END-LINE-COL can be either
|
233 : |
|
|
|
234 : |
|
|
- the symbol nil \(in which case it is ignored\)
|
235 : |
|
|
|
236 : |
|
|
or
|
237 : |
|
|
|
238 : |
|
|
- an Emacs Lisp expression that when `eval'd at \(start-line,start-col\)
|
239 : |
|
|
will move point to the end of the errorful text in the file.
|
240 : |
|
|
|
241 : |
|
|
Note that the compiler should return the full path name of the errorful
|
242 : |
|
|
file, and that this might require you to fiddle with the compiler's
|
243 : |
|
|
prettyprinting switches.")
|
244 : |
|
|
|
245 : |
|
|
;; std_in:2.1-4.3 Error: operator and operand don't agree (tycon mismatch)
|
246 : |
|
|
;; std_in:2.1 Error: operator and operand don't agree (tycon mismatch)
|
247 : |
|
|
|
248 : |
|
|
(defconst sml-smlnj-error-regexp
|
249 : |
|
|
(concat
|
250 : |
|
|
"^[-= ]*\\(.+\\):" ;file name
|
251 : |
|
|
"\\([0-9]+\\)\\.\\([0-9]+\\)" ;start line.column
|
252 : |
|
|
"\\(-\\([0-9]+\\)\\.\\([0-9]+\\)\\)?" ;end line.colum
|
253 : |
|
|
".+\\(\\(Error\\|Warning\\): .*\\)") ;the message
|
254 : |
|
|
|
255 : |
|
|
"Default regexp matching SML/NJ error and warning messages.
|
256 : |
|
|
|
257 : |
|
|
There should be no need to customise this, though you might decide
|
258 : |
|
|
that you aren't interested in Warnings -- my advice would be to modify
|
259 : |
|
|
`sml-error-regexp' explicitly to do that though.
|
260 : |
|
|
|
261 : |
|
|
If you do customise `sml-smlnj-error-regexp' you may need to modify
|
262 : |
|
|
the function `sml-smlnj-error-parser' (qv).")
|
263 : |
|
|
|
264 : |
|
|
(defvar sml-error-regexp sml-smlnj-error-regexp
|
265 : |
|
|
"*Regexp for matching \(the start of\) an error message.")
|
266 : |
|
|
|
267 : |
monnier |
33 |
;; font-lock support
|
268 : |
|
|
(defvar inferior-sml-font-lock-keywords
|
269 : |
|
|
`((,(concat "\\(" sml-prompt-regexp "\\)\\(.*\\)")
|
270 : |
|
|
(1 font-lock-prompt-face)
|
271 : |
|
|
(2 font-lock-command-face keep))
|
272 : |
|
|
(,sml-error-regexp . font-lock-warning-face)
|
273 : |
monnier |
39 |
("^\\[\\(.*GC #.*\n\\)*.*\\]" . font-lock-comment-face)
|
274 : |
|
|
("^GC #.*" . font-lock-comment-face)))
|
275 : |
monnier |
33 |
|
276 : |
|
|
;; default faces values
|
277 : |
|
|
(defvar font-lock-prompt-face
|
278 : |
|
|
(if (facep 'font-lock-prompt-face)
|
279 : |
|
|
'font-lock-prompt-face
|
280 : |
|
|
'font-lock-keyword-face))
|
281 : |
|
|
(defvar font-lock-command-face
|
282 : |
|
|
(if (facep 'font-lock-command-face)
|
283 : |
|
|
'font-lock-command-face
|
284 : |
|
|
'font-lock-function-name-face))
|
285 : |
|
|
|
286 : |
|
|
(defvar inferior-sml-font-lock-defaults
|
287 : |
|
|
'(inferior-sml-font-lock-keywords nil nil nil nil))
|
288 : |
|
|
|
289 : |
monnier |
32 |
(defun sml-smlnj-error-parser (pt)
|
290 : |
|
|
"This parses the SML/NJ error message at PT into a 5 element list
|
291 : |
|
|
|
292 : |
|
|
\(file start-line start-col end-of-err msg\)
|
293 : |
|
|
|
294 : |
|
|
where FILE is the file in which the error occurs\; START-LINE is the line
|
295 : |
|
|
number in the file where the error occurs\; START-COL is the character
|
296 : |
|
|
position on that line where the error occurs.
|
297 : |
|
|
|
298 : |
|
|
If present, the fourth return value is a simple Emacs Lisp expression that
|
299 : |
|
|
will move point to the end of the errorful text, assuming that point is at
|
300 : |
|
|
\(start-line,start-col\) to begin with\; and MSG is the text of the error
|
301 : |
|
|
message given by the compiler."
|
302 : |
|
|
|
303 : |
|
|
;; This function uses `sml-smlnj-error-regexp' to do the parsing, and
|
304 : |
|
|
;; assumes that regexp groups 1, 2, and 3 correspond to the first three
|
305 : |
|
|
;; elements of the list returned\; and groups 5, 6 and 7 correspond to the
|
306 : |
|
|
;; optional elements in that order.
|
307 : |
|
|
|
308 : |
|
|
(save-excursion
|
309 : |
|
|
(goto-char pt)
|
310 : |
|
|
(if (not (looking-at sml-smlnj-error-regexp))
|
311 : |
|
|
;; the user loses big time.
|
312 : |
|
|
(list nil nil nil)
|
313 : |
|
|
(let ((file (match-string 1)) ; the file
|
314 : |
|
|
(slin (string-to-int (match-string 2))) ; the start line
|
315 : |
|
|
(scol (string-to-int (match-string 3))) ; the start col
|
316 : |
|
|
(msg (if (match-beginning 7) (match-string 7))))
|
317 : |
|
|
;; another loss: buggy sml/nj's produce nonsense like file:0.0 Error
|
318 : |
|
|
(if (zerop slin) (list file nil scol)
|
319 : |
|
|
;; ok, was a range of characters mentioned?
|
320 : |
|
|
(if (match-beginning 4)
|
321 : |
|
|
;; assume m-b 4 implies m-b 5 and m-b 6 (sml-smlnj-error-regexp)
|
322 : |
|
|
(let* ((elin (string-to-int (match-string 5))) ; end line
|
323 : |
|
|
(ecol (string-to-int (match-string 6))) ; end col
|
324 : |
|
|
(jump (if (= elin slin)
|
325 : |
|
|
;; move forward on the same line
|
326 : |
|
|
`(forward-char ,(1+ (- ecol scol)))
|
327 : |
|
|
;; otherwise move down, and over to ecol
|
328 : |
|
|
`(progn
|
329 : |
|
|
(forward-line ,(- elin slin))
|
330 : |
|
|
(forward-char ,ecol)))))
|
331 : |
|
|
;; nconc glues lists together. jump & msg aren't lists
|
332 : |
|
|
(nconc (list file slin scol) (list jump) (list msg)))
|
333 : |
|
|
(nconc (list file slin scol) (list nil) (list msg))))))))
|
334 : |
|
|
|
335 : |
|
|
(defun sml-smlnj (pfx)
|
336 : |
|
|
"Set up and run Standard ML of New Jersey.
|
337 : |
|
|
Prefix argument means accept the defaults below.
|
338 : |
|
|
|
339 : |
|
|
Note: defaults set here will be clobbered if you setq them in the
|
340 : |
|
|
inferior-sml-mode-hook.
|
341 : |
|
|
|
342 : |
|
|
sml-program-name <option> \(default \"sml\"\)
|
343 : |
|
|
sml-default-arg <option> \(default \"\"\)
|
344 : |
|
|
sml-use-command \"use \\\"%s\\\"\"
|
345 : |
monnier |
33 |
sml-cd-command \"OS.FileSys.chDir \\\"%s\\\"\"
|
346 : |
monnier |
32 |
sml-prompt-regexp \"^[\\-=] *\"
|
347 : |
|
|
sml-error-regexp sml-sml-nj-error-regexp
|
348 : |
|
|
sml-error-parser 'sml-sml-nj-error-parser"
|
349 : |
|
|
(interactive "P")
|
350 : |
|
|
(let ((cmd (if pfx "sml"
|
351 : |
|
|
(read-string "Command name: " sml-program-name)))
|
352 : |
|
|
(arg (if pfx ""
|
353 : |
|
|
(read-string "Any arguments or options (default none): "))))
|
354 : |
|
|
;; sml-mode global variables
|
355 : |
|
|
(setq sml-program-name cmd)
|
356 : |
|
|
(setq sml-default-arg arg)
|
357 : |
|
|
;; buffer-local (compiler-local) variables
|
358 : |
|
|
(setq-default sml-use-command "use \"%s\""
|
359 : |
monnier |
33 |
sml-cd-command "OS.FileSys.chDir \"%s\""
|
360 : |
monnier |
32 |
sml-prompt-regexp "^[\-=] *"
|
361 : |
|
|
sml-error-regexp sml-smlnj-error-regexp
|
362 : |
|
|
sml-error-parser 'sml-smlnj-error-parser)
|
363 : |
|
|
(sml-run cmd sml-default-arg)))
|
364 : |
|
|
|
365 : |
|
|
|
366 : |
|
|
;;; CODE
|
367 : |
|
|
|
368 : |
|
|
(defvar inferior-sml-mode-map nil)
|
369 : |
|
|
|
370 : |
|
|
;; buffer-local
|
371 : |
|
|
|
372 : |
|
|
(defvar sml-error-file nil) ; file from which the last error came
|
373 : |
|
|
(defvar sml-real-file nil) ; used for finding source errors
|
374 : |
|
|
(defvar sml-error-cursor nil) ; ditto
|
375 : |
|
|
(defvar sml-error-barrier nil) ; ditto
|
376 : |
|
|
|
377 : |
|
|
(defun sml-proc-buffer ()
|
378 : |
|
|
"Returns the current ML process buffer,
|
379 : |
|
|
or the current buffer if it is in `inferior-sml-mode'. Raises an error
|
380 : |
|
|
if the variable `sml-buffer' does not appear to point to an existing
|
381 : |
|
|
buffer."
|
382 : |
|
|
(let ((buffer
|
383 : |
|
|
(cond ((eq major-mode 'inferior-sml-mode)
|
384 : |
|
|
;; default to current buffer if it's in inferior-sml-mode
|
385 : |
|
|
(current-buffer))
|
386 : |
|
|
((bufferp sml-buffer)
|
387 : |
|
|
;; buffer-name returns nil if the buffer has been killed
|
388 : |
|
|
(buffer-name sml-buffer))
|
389 : |
|
|
((stringp sml-buffer)
|
390 : |
|
|
;; get-buffer returns nil if there's no buffer of that name
|
391 : |
|
|
(get-buffer sml-buffer)))))
|
392 : |
|
|
(or buffer
|
393 : |
|
|
(error "No current process buffer. See variable sml-buffer"))))
|
394 : |
|
|
|
395 : |
|
|
(defun sml-proc ()
|
396 : |
|
|
"Returns the current ML process. See variable `sml-buffer'."
|
397 : |
|
|
(let ((proc (get-buffer-process (sml-proc-buffer))))
|
398 : |
|
|
(or proc
|
399 : |
|
|
(error "No current process. See variable sml-buffer"))))
|
400 : |
|
|
|
401 : |
|
|
(defun sml-buffer (echo)
|
402 : |
|
|
"Make the current buffer the current `sml-buffer' if that is sensible.
|
403 : |
|
|
Lookup variable `sml-buffer' to see why this might be useful."
|
404 : |
|
|
(interactive "P")
|
405 : |
|
|
(let ((current
|
406 : |
|
|
(cond ((bufferp sml-buffer) (or (buffer-name sml-buffer) "undefined"))
|
407 : |
|
|
((stringp sml-buffer) sml-buffer)
|
408 : |
|
|
(t "undefined"))))
|
409 : |
|
|
(if echo (message (format "ML process buffer is %s." current))
|
410 : |
|
|
(let ((buffer (if (eq major-mode 'inferior-sml-mode) (current-buffer))))
|
411 : |
|
|
(if (not buffer) (message (format "ML process buffer is %s." current))
|
412 : |
|
|
(setq sml-buffer buffer)
|
413 : |
|
|
(message (format "ML process buffer is %s." (buffer-name buffer))))))))
|
414 : |
|
|
|
415 : |
|
|
(defun sml-noproc ()
|
416 : |
|
|
"Nil iff `sml-proc' returns a process."
|
417 : |
|
|
(condition-case nil (progn (sml-proc) nil) (error t)))
|
418 : |
|
|
|
419 : |
|
|
(defun sml-proc-tidy ()
|
420 : |
|
|
"Something to add to `kill-emacs-hook' to tidy up tmp files on exit."
|
421 : |
|
|
(if (file-readable-p sml-temp-file)
|
422 : |
|
|
(delete-file sml-temp-file)))
|
423 : |
|
|
|
424 : |
|
|
(defun inferior-sml-mode ()
|
425 : |
|
|
"Major mode for interacting with an inferior ML process.
|
426 : |
|
|
|
427 : |
|
|
The following commands are available:
|
428 : |
|
|
\\{inferior-sml-mode-map}
|
429 : |
|
|
|
430 : |
|
|
An ML process can be fired up (again) with \\[sml].
|
431 : |
|
|
|
432 : |
|
|
Customisation: Entry to this mode runs the hooks on `comint-mode-hook'
|
433 : |
|
|
and `inferior-sml-mode-hook' (in that order).
|
434 : |
|
|
|
435 : |
|
|
Variables controlling behaviour of this mode are
|
436 : |
|
|
|
437 : |
|
|
`sml-program-name' (default \"sml\")
|
438 : |
|
|
Program to run as ML.
|
439 : |
|
|
|
440 : |
|
|
`sml-use-command' (default \"use \\\"%s\\\"\")
|
441 : |
|
|
Template for loading a file into the inferior ML process.
|
442 : |
|
|
|
443 : |
|
|
`sml-cd-command' (default \"System.Directory.cd \\\"%s\\\"\")
|
444 : |
|
|
ML command for changing directories in ML process (if possible).
|
445 : |
|
|
|
446 : |
|
|
`sml-prompt-regexp' (default \"^[\\-=] *\")
|
447 : |
|
|
Regexp used to recognise prompts in the inferior ML process.
|
448 : |
|
|
|
449 : |
|
|
`sml-temp-threshold' (default 0)
|
450 : |
|
|
Controls when emacs uses temporary files to communicate with ML.
|
451 : |
|
|
If an integer N, then emacs uses a temporary file whenever the
|
452 : |
|
|
text is longer than N chars.
|
453 : |
|
|
|
454 : |
|
|
`sml-temp-file' (default (make-temp-name \"/tmp/ml\"))
|
455 : |
|
|
Temp file that emacs uses to communicate with the ML process.
|
456 : |
|
|
|
457 : |
|
|
`sml-error-regexp'
|
458 : |
|
|
(default -- complicated)
|
459 : |
|
|
Regexp for matching error messages from the compiler.
|
460 : |
|
|
|
461 : |
|
|
`sml-error-parser' (default 'sml-smlnj-error-parser)
|
462 : |
|
|
This function parses a error messages into a 3, 4 or 5 element list:
|
463 : |
|
|
(file start-line start-col (end-line end-col) err-msg).
|
464 : |
|
|
|
465 : |
|
|
You can send text to the inferior ML process from other buffers containing
|
466 : |
|
|
ML source.
|
467 : |
|
|
`switch-to-sml' switches the current buffer to the ML process buffer.
|
468 : |
|
|
`sml-send-function' sends the current *paragraph* to the ML process.
|
469 : |
|
|
`sml-send-region' sends the current region to the ML process.
|
470 : |
|
|
|
471 : |
|
|
Prefixing the sml-send-<whatever> commands with \\[universal-argument]
|
472 : |
|
|
causes a switch to the ML process buffer after sending the text.
|
473 : |
|
|
|
474 : |
|
|
For information on running multiple processes in multiple buffers, see
|
475 : |
|
|
documentation for variable `sml-buffer'.
|
476 : |
|
|
|
477 : |
|
|
Commands:
|
478 : |
|
|
RET after the end of the process' output sends the text from the
|
479 : |
|
|
end of process to point.
|
480 : |
|
|
RET before the end of the process' output copies the current line
|
481 : |
|
|
to the end of the process' output, and sends it.
|
482 : |
|
|
DEL converts tabs to spaces as it moves back.
|
483 : |
|
|
TAB file name completion, as in shell-mode, etc.."
|
484 : |
|
|
(interactive)
|
485 : |
|
|
(kill-all-local-variables)
|
486 : |
|
|
(comint-mode)
|
487 : |
|
|
(setq comint-prompt-regexp sml-prompt-regexp)
|
488 : |
|
|
(sml-mode-variables)
|
489 : |
|
|
|
490 : |
|
|
;; For sequencing through error messages:
|
491 : |
monnier |
33 |
|
492 : |
|
|
(set (make-local-variable 'sml-error-cursor)
|
493 : |
|
|
(marker-position (point-max-marker)))
|
494 : |
|
|
(set (make-local-variable 'sml-error-barrier)
|
495 : |
|
|
(marker-position (point-max-marker)))
|
496 : |
|
|
(set (make-local-variable 'sml-real-file) (cons nil 0))
|
497 : |
|
|
(set (make-local-variable 'font-lock-defaults)
|
498 : |
|
|
inferior-sml-font-lock-defaults)
|
499 : |
monnier |
32 |
|
500 : |
|
|
(make-local-variable 'sml-use-command)
|
501 : |
|
|
(make-local-variable 'sml-cd-command)
|
502 : |
|
|
(make-local-variable 'sml-prompt-regexp)
|
503 : |
|
|
(make-local-variable 'sml-error-parser)
|
504 : |
|
|
(make-local-variable 'sml-error-regexp)
|
505 : |
|
|
|
506 : |
|
|
(setq major-mode 'inferior-sml-mode)
|
507 : |
|
|
(setq mode-name "Inferior ML")
|
508 : |
|
|
(setq mode-line-process '(": %s"))
|
509 : |
|
|
(use-local-map inferior-sml-mode-map)
|
510 : |
|
|
(add-hook 'kill-emacs-hook 'sml-proc-tidy)
|
511 : |
|
|
|
512 : |
|
|
(run-hooks 'inferior-sml-mode-hook))
|
513 : |
|
|
|
514 : |
|
|
;;; FOR RUNNING ML FROM EMACS
|
515 : |
|
|
|
516 : |
monnier |
33 |
;;;###autoload
|
517 : |
|
|
(defun run-sml (&optional pfx)
|
518 : |
monnier |
32 |
"Run an inferior ML process, input and output via buffer *sml*.
|
519 : |
|
|
With a prefix argument, this command allows you to specify any command
|
520 : |
|
|
line options to pass to the complier. The command runs hook functions
|
521 : |
|
|
on `comint-mode-hook' and `inferior-sml-mode-hook' in that order.
|
522 : |
|
|
|
523 : |
|
|
If there is a process already running in *sml*, just switch to that
|
524 : |
|
|
buffer instead.
|
525 : |
|
|
|
526 : |
|
|
In fact the name of the buffer created is chosen to reflect the name
|
527 : |
|
|
of the program name specified by `sml-program-name', or entered at the
|
528 : |
|
|
prompt. You can have several inferior ML process running, but only one
|
529 : |
|
|
current one -- given by `sml-buffer' (qv).
|
530 : |
|
|
|
531 : |
|
|
\(Type \\[describe-mode] in the process buffer for a list of commands.)"
|
532 : |
|
|
(interactive "P")
|
533 : |
|
|
(let ((cmd (if pfx
|
534 : |
|
|
(read-string "ML command: " sml-program-name)
|
535 : |
|
|
sml-program-name))
|
536 : |
|
|
(args (if pfx
|
537 : |
|
|
(read-string "Any args: " sml-default-arg)
|
538 : |
|
|
sml-default-arg)))
|
539 : |
|
|
(sml-run cmd args)))
|
540 : |
|
|
|
541 : |
|
|
(defun sml-run (cmd arg)
|
542 : |
|
|
"Run the ML program CMD with given arguments ARGS.
|
543 : |
|
|
This usually updates `sml-buffer' to a buffer named *CMD*."
|
544 : |
|
|
(let* ((pname (file-name-nondirectory cmd))
|
545 : |
|
|
(bname (format "*%s*" pname))
|
546 : |
|
|
(args (if (equal arg "") () (sml-args-to-list arg))))
|
547 : |
|
|
(if (comint-check-proc bname)
|
548 : |
monnier |
33 |
(pop-to-buffer (sml-proc-buffer)) ;do nothing but switch buffer
|
549 : |
monnier |
32 |
(setq sml-buffer
|
550 : |
|
|
(if (null args)
|
551 : |
|
|
;; there is a good reason for this; to ensure
|
552 : |
|
|
;; *no* argument is sent, not even a "".
|
553 : |
|
|
(set-buffer (apply 'make-comint pname cmd nil))
|
554 : |
|
|
(set-buffer (apply 'make-comint pname cmd nil args))))
|
555 : |
|
|
(message (format "Starting \"%s\" in background." pname))
|
556 : |
|
|
(inferior-sml-mode)
|
557 : |
|
|
(goto-char (point-max))
|
558 : |
|
|
;; and this -- to keep these as defaults even if
|
559 : |
|
|
;; they're set in the mode hooks.
|
560 : |
|
|
(setq sml-program-name cmd)
|
561 : |
|
|
(setq sml-default-arg arg))))
|
562 : |
|
|
|
563 : |
|
|
(defun sml-args-to-list (string)
|
564 : |
|
|
(let ((where (string-match "[ \t]" string)))
|
565 : |
|
|
(cond ((null where) (list string))
|
566 : |
|
|
((not (= where 0))
|
567 : |
|
|
(cons (substring string 0 where)
|
568 : |
|
|
(sml-args-to-list (substring string (+ 1 where)
|
569 : |
|
|
(length string)))))
|
570 : |
|
|
(t (let ((pos (string-match "[^ \t]" string)))
|
571 : |
|
|
(if (null pos)
|
572 : |
|
|
nil
|
573 : |
|
|
(sml-args-to-list (substring string pos
|
574 : |
|
|
(length string)))))))))
|
575 : |
|
|
|
576 : |
|
|
(defun sml-temp-threshold (&optional thold)
|
577 : |
|
|
"Set the variable to the given prefix (nil, if no prefix given).
|
578 : |
|
|
This is really mainly here to help debugging sml-mode!"
|
579 : |
|
|
(interactive "P")
|
580 : |
|
|
(setq sml-temp-threshold
|
581 : |
|
|
(if current-prefix-arg (prefix-numeric-value thold)))
|
582 : |
|
|
(message "%s" sml-temp-threshold))
|
583 : |
|
|
|
584 : |
|
|
;;;###autoload
|
585 : |
|
|
(defun switch-to-sml (eob-p)
|
586 : |
|
|
"Switch to the ML process buffer.
|
587 : |
|
|
With prefix argument, positions cursor at point, otherwise at end of buffer."
|
588 : |
|
|
(interactive "P")
|
589 : |
monnier |
33 |
(if (sml-noproc) (save-excursion (run-sml t)))
|
590 : |
|
|
(pop-to-buffer (sml-proc-buffer))
|
591 : |
monnier |
32 |
(cond ((not eob-p)
|
592 : |
|
|
(push-mark (point) t)
|
593 : |
|
|
(goto-char (point-max)))))
|
594 : |
|
|
|
595 : |
|
|
;; Fakes it with a "use <temp-file>;" if necessary.
|
596 : |
|
|
|
597 : |
|
|
;;;###autoload
|
598 : |
|
|
(defun sml-send-region (start end &optional and-go)
|
599 : |
|
|
"Send current region to the inferior ML process.
|
600 : |
|
|
Prefix argument means switch-to-sml afterwards.
|
601 : |
|
|
|
602 : |
|
|
If the region is longer than `sml-temp-threshold' and the variable
|
603 : |
|
|
`sml-use-command' is defined, the region is written out to a temporary file
|
604 : |
|
|
and a \"use <temp-file>\" command is sent to the compiler\; otherwise the
|
605 : |
|
|
text in the region is sent directly to the compiler. In either case a
|
606 : |
|
|
trailing \"\;\\n\" will be added automatically.
|
607 : |
|
|
|
608 : |
|
|
See variables `sml-temp-threshold', `sml-temp-file' and `sml-use-command'."
|
609 : |
|
|
(interactive "r\nP")
|
610 : |
monnier |
33 |
(if (sml-noproc) (save-excursion (run-sml t)))
|
611 : |
monnier |
32 |
(cond ((equal start end)
|
612 : |
|
|
(message "The region is zero (ignored)"))
|
613 : |
|
|
((and sml-use-command
|
614 : |
|
|
(numberp sml-temp-threshold)
|
615 : |
|
|
(< sml-temp-threshold (- end start)))
|
616 : |
|
|
;; Just in case someone is still reading from sml-temp-file:
|
617 : |
|
|
(if (file-exists-p sml-temp-file)
|
618 : |
|
|
(delete-file sml-temp-file))
|
619 : |
|
|
(write-region start end sml-temp-file nil 'silently)
|
620 : |
|
|
(sml-update-barrier (buffer-file-name (current-buffer)) start)
|
621 : |
|
|
(sml-update-cursor (sml-proc-buffer))
|
622 : |
|
|
(comint-send-string (sml-proc)
|
623 : |
|
|
(concat (format sml-use-command sml-temp-file) ";\n")))
|
624 : |
|
|
(t
|
625 : |
|
|
(comint-send-region (sml-proc) start end)
|
626 : |
|
|
(comint-send-string (sml-proc) ";\n")))
|
627 : |
|
|
(if and-go (switch-to-sml nil)))
|
628 : |
|
|
|
629 : |
|
|
;; Update the buffer-local variables sml-real-file and sml-error-barrier
|
630 : |
|
|
;; in the process buffer:
|
631 : |
|
|
|
632 : |
|
|
(defun sml-update-barrier (file pos)
|
633 : |
|
|
(let ((buf (current-buffer)))
|
634 : |
|
|
(unwind-protect
|
635 : |
|
|
(let* ((proc (sml-proc))
|
636 : |
|
|
(pmark (marker-position (process-mark proc))))
|
637 : |
|
|
(set-buffer (process-buffer proc))
|
638 : |
|
|
;; update buffer local variables
|
639 : |
|
|
(setq sml-real-file (and file (cons file pos)))
|
640 : |
|
|
(setq sml-error-barrier pmark))
|
641 : |
|
|
(set-buffer buf))))
|
642 : |
|
|
|
643 : |
|
|
;; Update the buffer-local error-cursor in proc-buffer to be its
|
644 : |
|
|
;; current proc mark.
|
645 : |
|
|
|
646 : |
|
|
(defun sml-update-cursor (proc-buffer) ;always= sml-proc-buffer
|
647 : |
|
|
(let ((buf (current-buffer)))
|
648 : |
|
|
(unwind-protect
|
649 : |
|
|
(let* ((proc (sml-proc)) ;just in case?
|
650 : |
|
|
(pmark (marker-position (process-mark proc))))
|
651 : |
|
|
(set-buffer proc-buffer)
|
652 : |
|
|
;; update buffer local variable
|
653 : |
|
|
(setq sml-error-cursor pmark))
|
654 : |
|
|
(set-buffer buf))))
|
655 : |
|
|
|
656 : |
|
|
;; This is quite bogus, so it isn't bound to a key by default.
|
657 : |
|
|
;; Anyone coming up with an algorithm to recognise fun & local
|
658 : |
|
|
;; declarations surrounding point will do everyone a favour!
|
659 : |
|
|
|
660 : |
|
|
(defun sml-send-function (&optional and-go)
|
661 : |
|
|
"Send current paragraph to the inferior ML process.
|
662 : |
|
|
With a prefix argument switch to the sml buffer as well
|
663 : |
|
|
\(cf. `sml-send-region'\)."
|
664 : |
|
|
(interactive "P")
|
665 : |
|
|
(save-excursion
|
666 : |
|
|
(sml-mark-function)
|
667 : |
|
|
(sml-send-region (point) (mark)))
|
668 : |
|
|
(if and-go (switch-to-sml nil)))
|
669 : |
|
|
|
670 : |
|
|
;;;###autoload
|
671 : |
|
|
(defun sml-send-buffer (&optional and-go)
|
672 : |
|
|
"Send buffer to inferior shell running ML process.
|
673 : |
|
|
With a prefix argument switch to the sml buffer as well
|
674 : |
|
|
\(cf. `sml-send-region'\)."
|
675 : |
|
|
(interactive "P")
|
676 : |
|
|
(if (memq major-mode sml-source-modes)
|
677 : |
|
|
(sml-send-region (point-min) (point-max) and-go)))
|
678 : |
|
|
|
679 : |
|
|
;; Since sml-send-function/region take an optional prefix arg, these
|
680 : |
|
|
;; commands are redundant. But they are kept around for the user to
|
681 : |
|
|
;; bind if she wishes, since its easier to type C-c r than C-u C-c C-r.
|
682 : |
|
|
|
683 : |
|
|
(defun sml-send-region-and-go (start end)
|
684 : |
|
|
"Send current region to the inferior ML process, and go there."
|
685 : |
|
|
(interactive "r")
|
686 : |
|
|
(sml-send-region start end t))
|
687 : |
|
|
|
688 : |
|
|
(defun sml-send-function-and-go ()
|
689 : |
|
|
"Send current paragraph to the inferior ML process, and go there."
|
690 : |
|
|
(interactive)
|
691 : |
|
|
(sml-send-function t))
|
692 : |
|
|
|
693 : |
|
|
|
694 : |
|
|
;;; Mouse control and handling dedicated frames for Inferior ML
|
695 : |
|
|
|
696 : |
|
|
;; simplified from frame.el in Emacs: special-display-popup-frame...
|
697 : |
|
|
|
698 : |
|
|
(defun sml-proc-frame ()
|
699 : |
|
|
"Returns the current ML process buffer's frame, or creates one first."
|
700 : |
|
|
(let ((buffer (sml-proc-buffer)))
|
701 : |
monnier |
33 |
(window-frame (display-buffer buffer))))
|
702 : |
monnier |
32 |
|
703 : |
monnier |
33 |
;;(defun sml-pop-to-buffer (warp)
|
704 : |
|
|
;; "(Towards) handling multiple frames properly.
|
705 : |
|
|
;;Raises the frame, and warps the mouse over there, only if WARP is non-nil."
|
706 : |
|
|
;; (let ((current (window-frame (selected-window)))
|
707 : |
|
|
;; (buffer (sml-proc-buffer)))
|
708 : |
|
|
;; (let ((frame (sml-proc-frame)))
|
709 : |
|
|
;; (if (eq current frame)
|
710 : |
|
|
;; (pop-to-buffer buffer) ; stay on the same frame.
|
711 : |
|
|
;; (select-frame frame) ; XEmacs sometimes moves focus.
|
712 : |
|
|
;; (select-window (get-buffer-window buffer)) ; necc. for XEmacs
|
713 : |
|
|
;; ;; (raise-frame frame)
|
714 : |
|
|
;; (if warp (sml-warp-mouse frame))))))
|
715 : |
monnier |
32 |
|
716 : |
|
|
|
717 : |
|
|
;;; 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
|
718 : |
|
|
|
719 : |
|
|
;; Only these two functions have to dance around the inane differences
|
720 : |
|
|
;; between Emacs and XEmacs (fortunately)
|
721 : |
|
|
|
722 : |
|
|
(defun sml-warp-mouse (frame)
|
723 : |
|
|
"Warp the pointer across the screen to upper right corner of FRAME."
|
724 : |
|
|
(raise-frame frame)
|
725 : |
|
|
(cond ((string-match "\\(Lucid\\|XEmacs\\)" emacs-version)
|
726 : |
|
|
;; LUCID (19.10) or later... set-m-pos needs a WINDOW
|
727 : |
|
|
(set-mouse-position (frame-root-window frame) (1- (frame-width)) 0))
|
728 : |
|
|
(t
|
729 : |
|
|
;; GNU, post circa 19.19... set-m-pos needs a FRAME
|
730 : |
|
|
(set-mouse-position frame (1- (frame-width)) 0)
|
731 : |
|
|
;; probably not needed post 19.29
|
732 : |
|
|
(if (fboundp 'unfocus-frame) (unfocus-frame)))))
|
733 : |
|
|
|
734 : |
|
|
(defun sml-drag-region (event)
|
735 : |
|
|
"Highlight the text the mouse is dragged over, and send it to ML.
|
736 : |
|
|
This must be bound to a button-down mouse event, currently \\[sml-drag-region].
|
737 : |
|
|
|
738 : |
|
|
If you drag the mouse (ie, keep the mouse button depressed) the
|
739 : |
|
|
program text sent to the complier is delimited by where you started
|
740 : |
|
|
dragging the mouse, and where you release the mouse button.
|
741 : |
|
|
|
742 : |
|
|
If you only click the mouse, the program text sent to the compiler is
|
743 : |
|
|
delimited by the current position of point and the place where you
|
744 : |
|
|
click the mouse.
|
745 : |
|
|
|
746 : |
|
|
In either event, the values of both point and mark are left
|
747 : |
|
|
undisturbed once this operation is completed."
|
748 : |
|
|
(interactive "e")
|
749 : |
|
|
(let ((mark-ring) ;BAD: selection start gets cons'd
|
750 : |
|
|
(pmark (point))) ;where point is now
|
751 : |
|
|
(if (fboundp 'mouse-track-default)
|
752 : |
|
|
;; Assume this is XEmacs, otherwise assume its Emacs
|
753 : |
|
|
(save-excursion
|
754 : |
|
|
(let ((zmacs-regions))
|
755 : |
|
|
(set-marker (mark-marker) nil)
|
756 : |
|
|
(mouse-track-default event)
|
757 : |
|
|
(if (not (region-exists-p)) (push-mark pmark nil t))
|
758 : |
|
|
(call-interactively 'sml-send-region)))
|
759 : |
|
|
;; Emacs: making this buffer-local ought to happen in sml-mode
|
760 : |
|
|
(make-local-variable 'transient-mark-mode)
|
761 : |
|
|
(save-excursion
|
762 : |
|
|
(let ((transient-mark-mode 1))
|
763 : |
|
|
(mouse-drag-region event)
|
764 : |
|
|
(if (not mark-active) (push-mark pmark nil t))
|
765 : |
|
|
(call-interactively 'sml-send-region))))))
|
766 : |
|
|
|
767 : |
|
|
|
768 : |
|
|
;;; LOADING AND IMPORTING SOURCE FILES:
|
769 : |
|
|
|
770 : |
|
|
(defvar sml-source-modes '(sml-mode)
|
771 : |
|
|
"*Used to determine if a buffer contains ML source code.
|
772 : |
|
|
If it's loaded into a buffer that is in one of these major modes, it's
|
773 : |
|
|
considered an ML source file by `sml-load-file'. Used by these commands
|
774 : |
|
|
to determine defaults.")
|
775 : |
|
|
|
776 : |
|
|
(defvar sml-prev-l/c-dir/file nil
|
777 : |
|
|
"Caches the (directory . file) pair used in the last `sml-load-file'
|
778 : |
|
|
or `sml-cd' command. Used for determining the default in the next one.")
|
779 : |
|
|
|
780 : |
|
|
;;;###autoload
|
781 : |
|
|
(defun sml-load-file (&optional and-go)
|
782 : |
|
|
"Load an ML file into the current inferior ML process.
|
783 : |
|
|
With a prefix argument switch to sml buffer as well.
|
784 : |
|
|
|
785 : |
|
|
This command uses the ML command template `sml-use-command' to construct
|
786 : |
|
|
the command to send to the ML process\; a trailing \"\;\\n\" will be added
|
787 : |
|
|
automatically."
|
788 : |
|
|
(interactive "P")
|
789 : |
monnier |
33 |
(if (sml-noproc) (save-excursion (run-sml t)))
|
790 : |
monnier |
32 |
(if sml-use-command
|
791 : |
|
|
(let ((file
|
792 : |
|
|
(car (comint-get-source "Load ML file: " sml-prev-l/c-dir/file
|
793 : |
|
|
sml-source-modes t))))
|
794 : |
|
|
;; Check if buffer needs saved. Should (save-some-buffers) instead?
|
795 : |
|
|
(comint-check-source file)
|
796 : |
|
|
(setq sml-prev-l/c-dir/file
|
797 : |
|
|
(cons (file-name-directory file) (file-name-nondirectory file)))
|
798 : |
|
|
(sml-update-cursor (sml-proc-buffer))
|
799 : |
|
|
(comint-send-string
|
800 : |
|
|
(sml-proc) (concat (format sml-use-command file) ";\n")))
|
801 : |
|
|
(message "Can't load files if `sml-use-command' is undefined!"))
|
802 : |
|
|
(if and-go (switch-to-sml nil)))
|
803 : |
|
|
|
804 : |
|
|
(defun sml-cd (dir)
|
805 : |
|
|
"Change the working directory of the inferior ML process.
|
806 : |
|
|
The default directory of the process buffer is changed to DIR. If the
|
807 : |
|
|
variable `sml-cd-command' is non-nil it should be an ML command that will
|
808 : |
|
|
be executed to change the compiler's working directory\; a trailing
|
809 : |
|
|
\"\;\\n\" will be added automatically."
|
810 : |
|
|
(interactive "DSML Directory: ")
|
811 : |
|
|
(let* ((buf (sml-proc-buffer))
|
812 : |
|
|
(proc (get-buffer-process buf))
|
813 : |
monnier |
33 |
(dir (expand-file-name dir))
|
814 : |
|
|
(string (concat (format sml-cd-command dir) ";\n")))
|
815 : |
monnier |
32 |
(save-excursion
|
816 : |
|
|
(set-buffer buf)
|
817 : |
monnier |
33 |
(goto-char (point-max))
|
818 : |
|
|
(insert string)
|
819 : |
|
|
(set-marker (process-mark proc) (point))
|
820 : |
|
|
(if sml-cd-command (process-send-string proc string))
|
821 : |
monnier |
32 |
(cd dir))
|
822 : |
|
|
(setq sml-prev-l/c-dir/file (cons dir nil))))
|
823 : |
|
|
|
824 : |
monnier |
33 |
(defun sml-send-command (cmd &optional dir)
|
825 : |
|
|
"Send string to ML process, display this string in ML's buffer"
|
826 : |
|
|
(if (sml-noproc) (save-excursion (run-sml t)))
|
827 : |
|
|
(let* ((my-dir (or dir (expand-file-name default-directory)))
|
828 : |
|
|
(cd-cmd (if my-dir
|
829 : |
|
|
(concat (format sml-cd-command my-dir) "; ")
|
830 : |
|
|
""))
|
831 : |
|
|
(buf (sml-proc-buffer))
|
832 : |
|
|
(proc (get-buffer-process buf))
|
833 : |
|
|
(string (concat cd-cmd cmd ";\n")))
|
834 : |
|
|
(save-some-buffers t)
|
835 : |
|
|
(save-excursion
|
836 : |
|
|
(sml-update-cursor buf)
|
837 : |
|
|
(set-buffer buf)
|
838 : |
|
|
(goto-char (point-max))
|
839 : |
|
|
(insert string)
|
840 : |
|
|
(if my-dir (cd my-dir))
|
841 : |
|
|
(set-marker (process-mark proc) (point))
|
842 : |
|
|
(process-send-string proc string))
|
843 : |
|
|
(switch-to-sml t)))
|
844 : |
monnier |
32 |
|
845 : |
monnier |
33 |
(defun sml-make (command)
|
846 : |
|
|
"re-make a system using (by default) CM.
|
847 : |
|
|
The exact command used can be specified by providing a prefix argument."
|
848 : |
|
|
(interactive
|
849 : |
|
|
;; code taken straight from compile.el
|
850 : |
|
|
(if (or current-prefix-arg (not sml-make-command))
|
851 : |
|
|
(list (read-from-minibuffer "Compile command: "
|
852 : |
|
|
sml-make-command nil nil
|
853 : |
|
|
'(compile-history . 1)))
|
854 : |
|
|
(list sml-make-command)))
|
855 : |
|
|
(setq sml-make-command command)
|
856 : |
|
|
;; try to find a makefile up the sirectory tree
|
857 : |
|
|
(let ((dir (and sml-make-file-name (expand-file-name default-directory))))
|
858 : |
|
|
(while (and dir (not (file-exists-p (concat dir sml-make-file-name))))
|
859 : |
|
|
(let ((newdir (file-name-directory (directory-file-name dir))))
|
860 : |
|
|
(setq dir (if (equal newdir dir) nil newdir))))
|
861 : |
|
|
(sml-send-command command dir)))
|
862 : |
monnier |
32 |
|
863 : |
monnier |
33 |
;;; PARSING ERROR MESSAGES
|
864 : |
monnier |
32 |
|
865 : |
|
|
;; This should need no modification to support other compilers.
|
866 : |
|
|
|
867 : |
|
|
;;;###autoload
|
868 : |
|
|
(defun sml-next-error (skip)
|
869 : |
|
|
"Find the next error by parsing the inferior ML buffer.
|
870 : |
|
|
A prefix argument means `sml-skip-errors' (qv) instead.
|
871 : |
|
|
|
872 : |
|
|
Move the error message on the top line of the window\; put the cursor
|
873 : |
|
|
\(point\) at the beginning of the error source.
|
874 : |
|
|
|
875 : |
|
|
If the error message specifies a range, and `sml-error-parser' returns
|
876 : |
|
|
the range, the mark is placed at the end of the range. If the variable
|
877 : |
|
|
`sml-error-overlay' is non-nil, the region will also be highlighted.
|
878 : |
|
|
|
879 : |
|
|
If `sml-error-parser' returns a fifth component this is assumed to be
|
880 : |
|
|
a string to indicate the nature of the error: this will be echoed in
|
881 : |
|
|
the minibuffer.
|
882 : |
|
|
|
883 : |
|
|
Error interaction only works if there is a real file associated with
|
884 : |
|
|
the input -- though of course it also depends on the compiler's error
|
885 : |
|
|
messages \(also see documantation for `sml-error-parser'\).
|
886 : |
|
|
|
887 : |
|
|
However: if the last text sent went via `sml-load-file' (or the temp
|
888 : |
|
|
file mechanism), the next error reported will be relative to the start
|
889 : |
|
|
of the region sent, any error reports in the previous output being
|
890 : |
|
|
forgotten. If the text went directly to the compiler the succeeding
|
891 : |
|
|
error reported will be the next error relative to the location \(in
|
892 : |
|
|
the output\) of the last error. This odd behaviour may have a use...?"
|
893 : |
|
|
(interactive "P")
|
894 : |
|
|
(if skip (sml-skip-errors) (sml-do-next-error)))
|
895 : |
|
|
|
896 : |
|
|
(defun sml-bottle (msg)
|
897 : |
|
|
"Function to let `sml-next-error' give up gracefully."
|
898 : |
|
|
(sml-warp-mouse (selected-frame))
|
899 : |
|
|
(error msg))
|
900 : |
|
|
|
901 : |
|
|
(defun sml-do-next-error ()
|
902 : |
|
|
"The buisiness end of `sml-next-error' (qv)"
|
903 : |
|
|
(let ((case-fold-search nil)
|
904 : |
|
|
;; set this variable iff we called sml-next-error in a SML buffer
|
905 : |
|
|
(sml-window (if (memq major-mode sml-source-modes) (selected-window)))
|
906 : |
|
|
(proc-buffer (sml-proc-buffer)))
|
907 : |
|
|
;; undo (don't destroy) the previous overlay to be tidy
|
908 : |
|
|
(sml-error-overlay 'undo 1 1
|
909 : |
|
|
(and sml-error-file (get-file-buffer sml-error-file)))
|
910 : |
|
|
;; go to interaction buffer but don't raise it's frame
|
911 : |
monnier |
33 |
(pop-to-buffer (sml-proc-buffer))
|
912 : |
monnier |
32 |
;; go to the last remembered error, and search for the next one.
|
913 : |
|
|
(goto-char sml-error-cursor)
|
914 : |
|
|
(if (not (re-search-forward sml-error-regexp (point-max) t))
|
915 : |
|
|
;; no more errors -- move point to the sml prompt at the end
|
916 : |
|
|
(progn
|
917 : |
|
|
(goto-char (point-max))
|
918 : |
|
|
(if sml-window (select-window sml-window)) ;return there, perhaps
|
919 : |
|
|
(message "No error message(s) found."))
|
920 : |
|
|
;; error found: point is at end of last match; set the cursor posn.
|
921 : |
|
|
(setq sml-error-cursor (point))
|
922 : |
|
|
;; move the SML window's text up to this line
|
923 : |
|
|
(set-window-start (get-buffer-window proc-buffer) (match-beginning 0))
|
924 : |
|
|
(let* ((pos)
|
925 : |
|
|
(parse (funcall sml-error-parser (match-beginning 0)))
|
926 : |
|
|
(file (nth 0 parse))
|
927 : |
|
|
(line0 (nth 1 parse))
|
928 : |
|
|
(col0 (nth 2 parse))
|
929 : |
|
|
(line/col1 (nth 3 parse))
|
930 : |
|
|
(msg (nth 4 parse)))
|
931 : |
|
|
;; Give up immediately if the error report is scribble
|
932 : |
|
|
(if (or (null file) (null line0))
|
933 : |
|
|
(sml-bottle "Failed to parse/locate this error properly!"))
|
934 : |
|
|
;; decide what to do depending on the file returned
|
935 : |
|
|
(if (string= file "std_in")
|
936 : |
|
|
;; presently a fundamental limitation i'm afraid.
|
937 : |
|
|
(sml-bottle "Sorry, can't locate errors on std_in.")
|
938 : |
|
|
(if (string= file sml-temp-file)
|
939 : |
|
|
;; errors found in tmp file; seek the real file
|
940 : |
|
|
(if (< (point) sml-error-barrier)
|
941 : |
|
|
;; weird. user cleared *sml* and use'd the tmp file?
|
942 : |
|
|
(sml-bottle "Temp file error report is not current.")
|
943 : |
|
|
(if (not (car sml-real-file))
|
944 : |
|
|
;; sent from a buffer w/o a file attached.
|
945 : |
|
|
;; DEAL WITH THIS EVENTUALLY.
|
946 : |
|
|
(sml-bottle "No real file associated with the temp file.")
|
947 : |
|
|
;; real file and error-barrier
|
948 : |
|
|
(setq file (car sml-real-file))
|
949 : |
|
|
(setq pos (cdr sml-real-file))))))
|
950 : |
|
|
(if (not (file-readable-p file))
|
951 : |
|
|
(sml-bottle (concat "Can't read " file))
|
952 : |
|
|
;; instead of (find-file-other-window file) to lookup the file
|
953 : |
monnier |
33 |
(find-file-other-window file)
|
954 : |
monnier |
32 |
;; no good if the buffer's narrowed, still...
|
955 : |
|
|
(goto-char (or pos 1)) ; line 1 if no tmp file
|
956 : |
|
|
(forward-line (1- line0))
|
957 : |
|
|
(forward-char (1- col0))
|
958 : |
|
|
;; point is at start of error text; seek the end.
|
959 : |
|
|
(let ((start (point))
|
960 : |
|
|
(end (and line/col1
|
961 : |
|
|
(condition-case nil
|
962 : |
|
|
(progn (eval line/col1) (point))
|
963 : |
|
|
(error nil)))))
|
964 : |
|
|
;; return to start anyway
|
965 : |
|
|
(goto-char start)
|
966 : |
|
|
;; if point went to end, put mark there, and maybe highlight
|
967 : |
|
|
(if end (progn (push-mark end t)
|
968 : |
|
|
(sml-error-overlay nil start end)))
|
969 : |
|
|
(setq sml-error-file file) ; remember this for next time
|
970 : |
|
|
(if msg (message msg)))))))) ; echo the error/warning message
|
971 : |
|
|
|
972 : |
|
|
(defun sml-skip-errors ()
|
973 : |
|
|
"Skip past the rest of the errors."
|
974 : |
|
|
(interactive)
|
975 : |
|
|
(if (memq major-mode sml-source-modes) (sml-error-overlay 'undo))
|
976 : |
|
|
(sml-update-cursor (sml-proc-buffer))
|
977 : |
|
|
(if (eq major-mode 'sml-inferior-mode) (goto-char (point-max))))
|
978 : |
|
|
|
979 : |
|
|
;;; Set up the inferior mode keymap, using sml-mode bindings...
|
980 : |
|
|
|
981 : |
|
|
(cond ((not inferior-sml-mode-map)
|
982 : |
monnier |
33 |
(setq inferior-sml-mode-map (nconc (make-sparse-keymap) comint-mode-map))
|
983 : |
monnier |
32 |
(install-sml-keybindings inferior-sml-mode-map)
|
984 : |
monnier |
33 |
(define-key inferior-sml-mode-map "\C-c\C-s" 'run-sml)
|
985 : |
monnier |
32 |
(define-key inferior-sml-mode-map "\t" 'comint-dynamic-complete)))
|
986 : |
|
|
|
987 : |
|
|
;;; 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
|
988 : |
|
|
|
989 : |
|
|
(if window-system
|
990 : |
|
|
(cond ((string-match "\\(Lucid\\|XEmacs\\)" emacs-version)
|
991 : |
|
|
;; LUCID (19.10) or later...
|
992 : |
|
|
(define-key sml-mode-map '(meta shift button1) 'sml-drag-region))
|
993 : |
|
|
(t
|
994 : |
|
|
;; GNU, post circa 19.19
|
995 : |
|
|
(define-key sml-mode-map [M-S-down-mouse-1] 'sml-drag-region))))
|
996 : |
|
|
|
997 : |
|
|
;;; ...and do the user's customisations.
|
998 : |
|
|
|
999 : |
|
|
(run-hooks 'inferior-sml-load-hook)
|
1000 : |
|
|
|
1001 : |
|
|
;;; Here is where sml-proc.el ends
|