Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
Newer
Older
100644 358 lines (320 sloc) 15.136 kb
4418871 New file.
monnier authored
1 ;;; inf-haskell.el --- Interaction with an inferior Haskell process.
2
36dd8bd (inferior-haskell-info-xref-re): New cst.
monnier authored
3 ;; Copyright (C) 2004, 2005, 2006, 2007 Free Software Foundation, Inc.
4418871 New file.
monnier authored
4
5 ;; Author: Stefan Monnier <monnier@iro.umontreal.ca>
6 ;; Keywords: Haskell
7
8 ;; This file is free software; you can redistribute it and/or modify
9 ;; it under the terms of the GNU General Public License as published by
10 ;; the Free Software Foundation; either version 2, or (at your option)
11 ;; any later version.
12
13 ;; This file is distributed in the hope that it will be useful,
14 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
15 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
16 ;; GNU General Public License for more details.
17
18 ;; You should have received a copy of the GNU General Public License
19 ;; along with GNU Emacs; see the file COPYING. If not, write to
20 ;; the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
21 ;; Boston, MA 02111-1307, USA.
22
23 ;;; Commentary:
24
25 ;; The code is made of 2 parts: a major mode for the buffer that holds the
225a7c5 (inferior-haskell-load-file): Quote file name.
monnier authored
26 ;; inferior process's session and a minor mode for use in source buffers.
4418871 New file.
monnier authored
27
28 ;;; Code:
29
30 (require 'comint)
31 (require 'shell) ;For directory tracking.
32 (require 'compile)
36dd8bd (inferior-haskell-info-xref-re): New cst.
monnier authored
33 (require 'haskell-mode)
7410480 (inferior-haskell-wait-for-prompt): New fun, extracted
monnier authored
34 (eval-when-compile (require 'cl))
4418871 New file.
monnier authored
35
36 ;; Here I depart from the inferior-haskell- prefix.
37 ;; Not sure if it's a good idea.
27cc26c (haskell-program-name): Use ghci if hugs is absent.
monnier authored
38 (defcustom haskell-program-name
39 ;; Arbitrarily give preference to hugs over ghci.
40 (or (cond
41 ((not (fboundp 'executable-find)) nil)
42 ((executable-find "hugs") "hugs \"+.\"")
43 ((executable-find "ghci") "ghci"))
44 "hugs \"+.\"")
4418871 New file.
monnier authored
45 "The name of the command to start the inferior Haskell process.
46 The command can include arguments."
8b661ca (haskell-program-name): Fix defcustom delcaration.
monnier authored
47 ;; Custom only supports the :options keyword for a few types, e.g. not
48 ;; for string.
49 ;; :options '("hugs \"+.\"" "ghci")
4418871 New file.
monnier authored
50 :group 'haskell
51 :type '(choice string (repeat string)))
52
36dd8bd (inferior-haskell-info-xref-re): New cst.
monnier authored
53 (defconst inferior-haskell-info-xref-re
54 "\t-- Defined at \\(.+\\):\\([0-9]+\\):\\([0-9]+\\)$")
55
4418871 New file.
monnier authored
56 (defconst inferior-haskell-error-regexp-alist
57 ;; The format of error messages used by Hugs.
e19bf49 (inferior-haskell-error-regexp-alist): Fix GHCi regexp, support warni…
monnier authored
58 `(("^ERROR \"\\(.+?\\)\"\\(:\\| line \\)\\([0-9]+\\) - " 1 3)
4418871 New file.
monnier authored
59 ;; Format of error messages used by GHCi.
e19bf49 (inferior-haskell-error-regexp-alist): Fix GHCi regexp, support warni…
monnier authored
60 ("^\\(.+?\\):\\([0-9]+\\):\\(\\([0-9]+\\):\\)?\\( \\|\n +\\)\\(Warning\\)?"
36dd8bd (inferior-haskell-info-xref-re): New cst.
monnier authored
61 1 2 4 ,@(if (fboundp 'compilation-fake-loc) '((6))))
5a72afa (inferior-haskell-error-regexp-alist): Add entries for GHCI's excepti…
monnier authored
62 ;; Runtime exceptions, from ghci.
63 ("^\\*\\*\\* Exception: \\(.+?\\):(\\([0-9]+\\),\\([0-9]+\\))-(\\([0-9]+\\),\\([0-9]+\\)): .*"
64 1 ,@(if (fboundp 'compilation-fake-loc) '((2 . 4) (3 . 5)) '(2 3)))
65 ;; GHCI uses two different forms for line/col ranges, depending on
66 ;; whether it's all on the same line or not :-(
67 ("^\\*\\*\\* Exception: \\(.+?\\):\\([0-9]+\\):\\([0-9]+\\)-\\([0-9]+\\): .*"
68 1 2 ,(if (fboundp 'compilation-fake-loc) '(3 . 4) 3))
36dd8bd (inferior-haskell-info-xref-re): New cst.
monnier authored
69 ;; Info xrefs.
70 ,@(if (fboundp 'compilation-fake-loc)
71 `((,inferior-haskell-info-xref-re
72 1 2 3 0))))
4418871 New file.
monnier authored
73 "Regexps for error messages generated by inferior Haskell processes.
74 The format should be the same as for `compilation-error-regexp-alist'.")
75
c7c6278 (inferior-haskell-use-cabal): New custom var.
monnier authored
76 (defcustom inferior-haskell-use-cabal t
77 "If non-nil, try and find a Cabal file to get the project root directory."
78 :type 'boolean)
79
4418871 New file.
monnier authored
80 (define-derived-mode inferior-haskell-mode comint-mode "Inf-Haskell"
81 "Major mode for interacting with an inferior Haskell process."
82 (set (make-local-variable 'comint-prompt-regexp)
83 "^\\*?[A-Z][\\._a-zA-Z0-9]*\\( \\*?[A-Z][\\._a-zA-Z0-9]*\\)*> ")
84 (set (make-local-variable 'comint-input-autoexpand) nil)
85
86 ;; Setup directory tracking.
87 (set (make-local-variable 'shell-cd-regexp) ":cd")
bbbe054 (inferior-haskell-mode): Use shell-dirtrack-mode if possible.
monnier authored
88 (condition-case nil
89 (shell-dirtrack-mode 1)
90 (error ;The minor mode function may not exist or not accept an arg.
91 (set (make-local-variable 'shell-dirtrackp) t)
92 (add-hook 'comint-input-filter-functions 'shell-directory-tracker
93 nil 'local)))
4418871 New file.
monnier authored
94
95 ;; Setup `compile' support so you can just use C-x ` and friends.
96 (set (make-local-variable 'compilation-error-regexp-alist)
97 inferior-haskell-error-regexp-alist)
5a72afa (inferior-haskell-error-regexp-alist): Add entries for GHCI's excepti…
monnier authored
98 (set (make-local-variable 'compilation-first-column) 0) ;GHCI counts from 0.
bfd15e1 (inferior-haskell-mode): Hide compilation-mode bindings.
monnier authored
99 (if (and (not (boundp 'minor-mode-overriding-map-alist))
100 (fboundp 'compilation-shell-minor-mode))
101 ;; If we can't remove compilation-minor-mode bindings, at least try to
102 ;; use compilation-shell-minor-mode, so there are fewer
103 ;; annoying bindings.
104 (compilation-shell-minor-mode 1)
105 ;; Else just use compilation-minor-mode but without its bindings because
106 ;; things like mouse-2 are simply too annoying.
107 (compilation-minor-mode 1)
108 (let ((map (make-sparse-keymap)))
109 (dolist (keys '([menu-bar] [follow-link]))
110 ;; Preserve some of the bindings.
111 (define-key map keys (lookup-key compilation-minor-mode-map keys)))
112 (add-to-list 'minor-mode-overriding-map-alist
113 (cons 'compilation-minor-mode map)))))
4418871 New file.
monnier authored
114
6784a8b (inferior-haskell-string-to-strings): Remove `separator' argument. C…
monnier authored
115 (defun inferior-haskell-string-to-strings (string)
116 "Split the STRING into a list of strings."
117 (let ((i (string-match "[\"]" string)))
118 (if (null i) (split-string string) ; no quoting: easy
119 (append (unless (eq i 0) (split-string (substring string 0 i)))
4418871 New file.
monnier authored
120 (let ((rfs (read-from-string string i)))
121 (cons (car rfs)
122 (inferior-haskell-string-to-strings
6784a8b (inferior-haskell-string-to-strings): Remove `separator' argument. C…
monnier authored
123 (substring string (cdr rfs)))))))))
4418871 New file.
monnier authored
124
125 (defun inferior-haskell-command (arg)
126 (inferior-haskell-string-to-strings
127 (if (null arg) haskell-program-name
6dd0f3a (inferior-haskell-command): Provide a default.
monnier authored
128 (read-string "Command to run haskell: " haskell-program-name))))
4418871 New file.
monnier authored
129
130 (defvar inferior-haskell-buffer nil
131 "The buffer in which the inferior process is running.")
132
133 (defun inferior-haskell-start-process (command)
134 "Start an inferior haskell process.
6784a8b (inferior-haskell-string-to-strings): Remove `separator' argument. C…
monnier authored
135 With universal prefix \\[universal-argument], prompts for a COMMAND,
4418871 New file.
monnier authored
136 otherwise uses `haskell-program-name'.
137 It runs the hook `inferior-haskell-hook' after starting the process and
138 setting up the inferior-haskell buffer."
139 (interactive (list (inferior-haskell-command current-prefix-arg)))
140 (setq inferior-haskell-buffer
141 (apply 'make-comint "haskell" (car command) nil (cdr command)))
142 (with-current-buffer inferior-haskell-buffer
143 (inferior-haskell-mode)
144 (run-hooks 'inferior-haskell-hook)))
145
146 (defun inferior-haskell-process (&optional arg)
147 (or (if (buffer-live-p inferior-haskell-buffer)
148 (get-buffer-process inferior-haskell-buffer))
149 (progn
150 (let ((current-prefix-arg arg))
151 (call-interactively 'inferior-haskell-start-process))
152 ;; Try again.
153 (inferior-haskell-process arg))))
154
155 ;;;###autoload
156 (defalias 'run-haskell 'switch-to-haskell)
157 ;;;###autoload
158 (defun switch-to-haskell (&optional arg)
159 "Show the inferior-haskell buffer. Start the process if needed."
160 (interactive "P")
161 (let ((proc (inferior-haskell-process arg)))
162 (pop-to-buffer (process-buffer proc))))
163
ce51306 (with-selected-window): Define while compiling.
monnier authored
164 (eval-when-compile
165 (unless (fboundp 'with-selected-window)
166 (defmacro with-selected-window (win &rest body)
167 `(save-selected-window
168 (select-window ,win)
169 ,@body))))
6dd0f3a (inferior-haskell-command): Provide a default.
monnier authored
170
7410480 (inferior-haskell-wait-for-prompt): New fun, extracted
monnier authored
171 (defcustom inferior-haskell-wait-and-jump nil
172 "If non-nil, wait for file loading to terminate and jump to the error."
173 :type 'boolean
174 :group 'haskell)
175
176 (defun inferior-haskell-wait-for-prompt (proc)
177 "Wait until PROC sends us a prompt.
178 The process PROC should be associated to a comint buffer."
179 (with-current-buffer (process-buffer proc)
180 (while (progn
181 (goto-char comint-last-input-end)
182 (and (not (re-search-forward comint-prompt-regexp nil t))
183 (accept-process-output proc))))))
184
c7c6278 (inferior-haskell-use-cabal): New custom var.
monnier authored
185 (defvar inferior-haskell-cabal-buffer nil)
186
187 (defun inferior-haskell-cabal-of-buf (buf)
188 (require 'haskell-cabal)
189 (with-current-buffer buf
190 (or inferior-haskell-cabal-buffer
191 (and (not (local-variable-p 'inferior-haskell-cabal-buffer))
192 (set (make-local-variable 'inferior-haskell-cabal-buffer)
193 (haskell-cabal-find-file))))))
194
4418871 New file.
monnier authored
195 ;;;###autoload
196 (defun inferior-haskell-load-file (&optional reload)
197 "Pass the current buffer's file to the inferior haskell process."
198 (interactive)
2eaced4 (inferior-haskell-load-file): Save buffer before using buffer-file-name.
monnier authored
199 ;; Save first, so we're sure that `buffer-file-name' is non-nil afterward.
200 (save-buffer)
c7c6278 (inferior-haskell-use-cabal): New custom var.
monnier authored
201 (let ((buf (current-buffer))
202 (file buffer-file-name)
4418871 New file.
monnier authored
203 (proc (inferior-haskell-process)))
204 (with-current-buffer (process-buffer proc)
205 (compilation-forget-errors)
c7c6278 (inferior-haskell-use-cabal): New custom var.
monnier authored
206 (let ((parsing-end (marker-position (process-mark proc)))
207 cabal)
208 ;; Go to the root of the Cabal project, if applicable.
209 (when (and inferior-haskell-use-cabal
210 (setq cabal (inferior-haskell-cabal-of-buf buf)))
211 ;; Not sure if it's useful/needed and if it actually works.
212 (unless (equal default-directory
213 (with-current-buffer cabal default-directory))
214 (setq default-directory
215 (with-current-buffer cabal default-directory))
216 (inferior-haskell-send-command
217 proc (concat ":cd " default-directory)))
218 (setq file (file-relative-name file)))
d8a5cc8 (inferior-haskell-load-file): Fix the compilation-parsing-end fiddlin…
monnier authored
219 (inferior-haskell-send-command
220 proc (if reload ":reload" (concat ":load \"" file "\"")))
221 ;; Move the parsing-end marker after sending the command so
222 ;; that it doesn't point just to the insertion point.
223 ;; Otherwise insertion may move the marker (if done with
224 ;; insert-before-markers) and we'd then miss some errors.
225 (if (boundp 'compilation-parsing-end)
226 (if (markerp compilation-parsing-end)
227 (set-marker compilation-parsing-end parsing-end)
228 (setq compilation-parsing-end parsing-end))))
1cda384 (inferior-haskell-load-file): Simplify and make more
monnier authored
229 (with-selected-window (display-buffer (current-buffer))
7410480 (inferior-haskell-wait-for-prompt): New fun, extracted
monnier authored
230 (goto-char (point-max)))
231 (when inferior-haskell-wait-and-jump
232 (inferior-haskell-wait-for-prompt proc)
233 (ignore-errors ;Don't beep if there were no errors.
234 (next-error))))))
8512ba1 (inferior-haskell-mode): Typo.
monnier authored
235
236 (defun inferior-haskell-send-command (proc str)
237 (setq str (concat str "\n"))
238 (with-current-buffer (process-buffer proc)
7410480 (inferior-haskell-wait-for-prompt): New fun, extracted
monnier authored
239 (inferior-haskell-wait-for-prompt proc)
8512ba1 (inferior-haskell-mode): Typo.
monnier authored
240 (goto-char (process-mark proc))
241 (insert-before-markers str)
242 (move-marker comint-last-input-end (point))
243 (comint-send-string proc str)))
4418871 New file.
monnier authored
244
245 (defun inferior-haskell-reload-file ()
246 "Tell the inferior haskell process to reread the current buffer's file."
247 (interactive)
248 (inferior-haskell-load-file 'reload))
249
36dd8bd (inferior-haskell-info-xref-re): New cst.
monnier authored
250 (defun inferior-haskell-type (expr &optional insert-value)
251 "Query the haskell process for the type of the given expression.
252 If optional argument `insert-value' is non-nil, insert the type above point
253 in the buffer. This can be done interactively with the \\[universal-argument] prefix.
254 The returned info is cached for reuse by `haskell-doc-mode'."
255 (interactive
256 (let ((sym (haskell-ident-at-point)))
257 (list (read-string (if (> (length sym) 0)
258 (format "Show type of (default %s): " sym)
259 "Show type of: ")
260 nil nil sym)
261 current-prefix-arg)))
262 (if (string-match "\\`\\s_+\\'" expr) (setq expr (concat "(" expr ")")))
263 (let* ((proc (inferior-haskell-process))
264 (type
265 (with-current-buffer (process-buffer proc)
266 (let ((parsing-end ; Remember previous spot.
267 (marker-position (process-mark proc))))
268 (inferior-haskell-send-command proc (concat ":type " expr))
269 ;; Find new point.
270 (goto-char (point-max))
271 (inferior-haskell-wait-for-prompt proc)
272 ;; Back up to the previous end-of-line.
273 (end-of-line 0)
274 ;; Extract the type output
275 (buffer-substring-no-properties
276 (save-excursion (goto-char parsing-end)
277 (line-beginning-position 2))
278 (point))))))
279 (if (not (string-match (concat "\\`" (regexp-quote expr) "[ \t]+::[ \t]*")
280 type))
281 (error "No type info: %s" type)
282
283 ;; Cache for reuse by haskell-doc.
284 (when (and (boundp 'haskell-doc-mode) haskell-doc-mode
285 (boundp 'haskell-doc-user-defined-ids)
286 ;; Haskell-doc only works for idents, not arbitrary expr.
287 (string-match "\\`(?\\(\\s_+\\|\\(\\sw\\|\\s'\\)+\\)?[ \t]*::[ \t]*"
288 type))
289 (let ((sym (match-string 1 type)))
290 (setq haskell-doc-user-defined-ids
291 (cons (cons sym (substring type (match-end 0)))
292 (remove-if (lambda (item) (equal (car item) sym))
293 haskell-doc-user-defined-ids)))))
294
295 (if (interactive-p) (message type))
296 (when insert-value
297 (beginning-of-line)
298 (insert type "\n"))
299 type)))
300
301 (defun inferior-haskell-info (sym)
302 "Query the haskell process for the info of the given expression."
303 (interactive
304 (let ((sym (haskell-ident-at-point)))
305 (list (read-string (if (> (length sym) 0)
306 (format "Show info of (default %s): " sym)
307 "Show info of: ")
308 nil nil sym))))
309 (let ((proc (inferior-haskell-process)))
310 (with-current-buffer (process-buffer proc)
311 (let ((parsing-end ; Remember previous spot.
312 (marker-position (process-mark proc))))
313 (inferior-haskell-send-command proc (concat ":info " sym))
314 ;; Find new point.
315 (goto-char (point-max))
316 (inferior-haskell-wait-for-prompt proc)
317 ;; Move to previous end-of-line
318 (end-of-line 0)
319 (let ((result
320 (buffer-substring-no-properties
321 (save-excursion (goto-char parsing-end)
322 (line-beginning-position 2))
323 (point))))
324 ;; Move back to end of process buffer
325 (goto-char (point-max))
326 (if (interactive-p) (message "%s" result))
327 result)))))
328
329 (defun inferior-haskell-find-definition (sym)
330 "Attempt to locate and jump to the definition of the given expression."
331 (interactive
332 (let ((sym (haskell-ident-at-point)))
333 (list (read-string (if (> (length sym) 0)
334 (format "Find definition of (default %s): " sym)
335 "Find definition of: ")
336 nil nil sym))))
337 (let ((info (inferior-haskell-info sym)))
338 (if (not (string-match inferior-haskell-info-xref-re info))
339 (error "No source information available")
340 (let ((file (match-string-no-properties 1 info))
341 (line (string-to-number
342 (match-string-no-properties 2 info)))
343 (col (string-to-number
344 (match-string-no-properties 3 info))))
345 (when file
346 ;; Push current location marker on the ring used by `find-tag'
347 (require 'etags)
348 (ring-insert find-tag-marker-ring (point-marker))
349 (pop-to-buffer (find-file-noselect file))
350 (when line
351 (goto-line line)
352 (when col (move-to-column col))))))))
353
4418871 New file.
monnier authored
354 (provide 'inf-haskell)
bfd15e1 (inferior-haskell-mode): Hide compilation-mode bindings.
monnier authored
355
356 ;; arch-tag: 61804287-63dd-4052-bc0e-90f691b34b40
4418871 New file.
monnier authored
357 ;;; inf-haskell.el ends here
Something went wrong with that request. Please try again.