Home My Page Projects Code Snippets Project Openings SML/NJ
Summary Activity Forums Tracker Lists Tasks Docs Surveys News SCM Files

SCM Repository

[smlnj] Annotation of /sml-mode/trunk/sml-proc.el
ViewVC logotype

Annotation of /sml-mode/trunk/sml-proc.el

Parent Directory Parent Directory | Revision Log Revision Log


Revision 32 - (view) (download)
Original Path: sml/trunk/sml-mode/sml-proc.el

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

root@smlnj-gforge.cs.uchicago.edu
ViewVC Help
Powered by ViewVC 1.0.0