Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with
or
.
Download ZIP
Fetching contributors…

Cannot retrieve contributors at this time

167 lines (142 sloc) 6.508 kB
;;; inf-haskell.el --- Interaction with an inferior Haskell process.
;; Copyright (C) 2004, 2005 Free Software Foundation, Inc.
;; Author: Stefan Monnier <monnier@iro.umontreal.ca>
;; Keywords: Haskell
;; This file is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation; either version 2, or (at your option)
;; any later version.
;; This file is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;; You should have received a copy of the GNU General Public License
;; along with GNU Emacs; see the file COPYING. If not, write to
;; the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
;; Boston, MA 02111-1307, USA.
;;; Commentary:
;; The code is made of 2 parts: a major mode for the buffer that holds the
;; inferior process's session and a minor mode for use in source buffers.
;;; Code:
(require 'comint)
(require 'shell) ;For directory tracking.
(require 'compile)
;; Here I depart from the inferior-haskell- prefix.
;; Not sure if it's a good idea.
(defcustom haskell-program-name
;; Arbitrarily give preference to hugs over ghci.
(or (cond
((not (fboundp 'executable-find)) nil)
((executable-find "hugs") "hugs \"+.\"")
((executable-find "ghci") "ghci"))
"hugs \"+.\"")
"The name of the command to start the inferior Haskell process.
The command can include arguments."
:options '("hugs \"+.\"" "ghci")
:group 'haskell
:type '(choice string (repeat string)))
(defconst inferior-haskell-error-regexp-alist
;; The format of error messages used by Hugs.
'(("^ERROR \"\\(.+?\\)\"\\(:\\| line \\)\\([0-9]+\\) - " 1 3)
;; Format of error messages used by GHCi.
("^\\(.+?\\):\\([0-9]\\):\\( \\|$\\)" 1 3)
)
"Regexps for error messages generated by inferior Haskell processes.
The format should be the same as for `compilation-error-regexp-alist'.")
(define-derived-mode inferior-haskell-mode comint-mode "Inf-Haskell"
"Major mode for interacting with an inferior Haskell process."
(set (make-local-variable 'comint-prompt-regexp)
"^\\*?[A-Z][\\._a-zA-Z0-9]*\\( \\*?[A-Z][\\._a-zA-Z0-9]*\\)*> ")
(set (make-local-variable 'comint-input-autoexpand) nil)
;; Setup directory tracking.
(set (make-local-variable 'shell-dirtrackp) t)
(set (make-local-variable 'shell-cd-regexp) ":cd")
(add-hook 'comint-input-filter-functions 'shell-directory-tracker nil 'local)
;; Setup `compile' support so you can just use C-x ` and friends.
(set (make-local-variable 'compilation-error-regexp-alist)
inferior-haskell-error-regexp-alist)
(cond
((fboundp 'compilation-shell-minor-mode) (compilation-shell-minor-mode 1))
((fboundp 'compilation-minor-mode) (compilation-minor-mode 1))))
(defun inferior-haskell-string-to-strings (string &optional separator)
"Split the STRING into a list of strings.
The SEPARATOR regexp defaults to \"\\s-+\"."
(let ((sep (or separator "\\s-+"))
(i (string-match "[\"]" string)))
(if (null i) (split-string string sep) ; no quoting: easy
(append (unless (eq i 0) (split-string (substring string 0 i) sep))
(let ((rfs (read-from-string string i)))
(cons (car rfs)
(inferior-haskell-string-to-strings
(substring string (cdr rfs)) sep)))))))
(defun inferior-haskell-command (arg)
(inferior-haskell-string-to-strings
(if (null arg) haskell-program-name
(read-string "Command to run haskell: "))))
(defvar inferior-haskell-buffer nil
"The buffer in which the inferior process is running.")
(defun inferior-haskell-start-process (command)
"Start an inferior haskell process.
With universal prefix \\[universal-argument], prompts for a command,
otherwise uses `haskell-program-name'.
It runs the hook `inferior-haskell-hook' after starting the process and
setting up the inferior-haskell buffer."
(interactive (list (inferior-haskell-command current-prefix-arg)))
(setq inferior-haskell-buffer
(apply 'make-comint "haskell" (car command) nil (cdr command)))
(with-current-buffer inferior-haskell-buffer
(inferior-haskell-mode)
(run-hooks 'inferior-haskell-hook)))
(defun inferior-haskell-process (&optional arg)
(or (if (buffer-live-p inferior-haskell-buffer)
(get-buffer-process inferior-haskell-buffer))
(progn
(let ((current-prefix-arg arg))
(call-interactively 'inferior-haskell-start-process))
;; Try again.
(inferior-haskell-process arg))))
;;;###autoload
(defalias 'run-haskell 'switch-to-haskell)
;;;###autoload
(defun switch-to-haskell (&optional arg)
"Show the inferior-haskell buffer. Start the process if needed."
(interactive "P")
(let ((proc (inferior-haskell-process arg)))
(pop-to-buffer (process-buffer proc))))
;;;###autoload
(defun inferior-haskell-load-file (&optional reload)
"Pass the current buffer's file to the inferior haskell process."
(interactive)
(let ((file buffer-file-name)
(proc (inferior-haskell-process)))
(save-buffer)
(with-current-buffer (process-buffer proc)
;; Not sure if it's useful/needed and if it actually works.
;; (unless (equal (file-name-as-directory default-directory)
;; (file-name-directory file))
;; (inferior-haskell-send-string
;; proc (concat ":cd " (file-name-directory file) "\n")))
(compilation-forget-errors)
(if (boundp 'compilation-parsing-end)
(if (markerp compilation-parsing-end)
(set-marker compilation-parsing-end (point-max))
(setq compilation-parsing-end (point-max))))
(inferior-haskell-send-command
proc (if reload ":reload" (concat ":load \"" file "\""))))))
(defun inferior-haskell-send-command (proc str)
(setq str (concat str "\n"))
(with-current-buffer (process-buffer proc)
(while (and
(goto-char comint-last-input-end)
(not (re-search-forward comint-prompt-regexp nil t))
(accept-process-output proc)))
(goto-char (process-mark proc))
(insert-before-markers str)
(move-marker comint-last-input-end (point))
(comint-send-string proc str)))
(defun inferior-haskell-reload-file ()
"Tell the inferior haskell process to reread the current buffer's file."
(interactive)
(inferior-haskell-load-file 'reload))
(provide 'inf-haskell)
;;; inf-haskell.el ends here
Jump to Line
Something went wrong with that request. Please try again.