| 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
|
Parent Directory
| 
Revision Log
