/vendor/haskell-mode/haskell-hugs.el
Emacs Lisp | 316 lines | 199 code | 37 blank | 80 comment | 12 complexity | bcbd008d785cafa2e12bcf5e3788da19 MD5 | raw file
Possible License(s): GPL-2.0
1;;; haskell-hugs.el --- simplistic interaction mode with a 2 3;; Copyright 2004, 2005, 2006, 2007 Free Software Foundation, Inc. 4;; Copyright 1998, 1999 Guy Lapalme 5 6;; Hugs interpreter for Haskell developped by 7;; The University of Nottingham and Yale University, 1994-1997. 8;; Web: http://www.haskell.org/hugs. 9;; In standard Emacs terminology, this would be called 10;; inferior-hugs-mode 11 12;; Keywords: Hugs inferior mode, Hugs interaction mode 13;; URL: http://cvs.haskell.org/cgi-bin/cvsweb.cgi/fptools/CONTRIB/haskell-modes/emacs/haskell-hugs.el?rev=HEAD 14 15;; This file is not part of GNU Emacs. 16 17;; This file is free software; you can redistribute it and/or modify 18;; it under the terms of the GNU General Public License as published by 19;; the Free Software Foundation; either version 3, or (at your option) 20;; any later version. 21 22;; This file is distributed in the hope that it will be useful, 23;; but WITHOUT ANY WARRANTY; without even the implied warranty of 24;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 25;; GNU General Public License for more details. 26 27;; You should have received a copy of the GNU General Public License 28;; along with GNU Emacs; see the file COPYING. If not, write to the 29;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, 30;; Boston, MA 02111-1307, USA. 31 32 33;;; Commentary: 34 35;; Purpose: 36;; 37;; To send a Haskell buffer to another buffer running a Hugs interpreter 38;; The functions are adapted from the Hugs Mode developed by 39;; Chris Van Humbeeck <chris.vanhumbeeck@cs.kuleuven.ac.be> 40;; which used to be available at: 41;; http://www-i2.informatik.rwth-aachen.de/Forschung/FP/Haskell/hugs-mode.el 42;; 43;; Installation: 44;; 45;; To use with the Haskell mode of 46;; Moss&Thorn <http://www.haskell.org/haskell-mode> 47;; add this to .emacs: 48;; 49;; (add-hook 'haskell-mode-hook 'turn-on-haskell-hugs) 50;; 51;; Customisation: 52;; The name of the hugs interpreter is in variable 53;; haskell-hugs-program-name 54;; Arguments can be sent to the Hugs interpreter when it is called 55;; by setting the value of the variable 56;; haskell-hugs-program-args 57;; which by default contains '("+.") so that the progress of the 58;; interpreter is visible without any "^H" in the *hugs* Emacs buffer. 59;; 60;; This value can be interactively by calling C-cC-s with an 61;; argument. 62;; 63;; If the command does not seem to respond, see the 64;; content of the `comint-prompt-regexp' variable 65;; to check that it waits for the appropriate Hugs prompt 66;; the current value is appropriate for Hugs 1.3 and 1.4 67;; 68;; 69;; `haskell-hugs-hook' is invoked in the *hugs* once it is started. 70;; 71;;; All functions/variables start with 72;;; `(turn-(on/off)-)haskell-hugs' or `haskell-hugs-'. 73 74(defgroup haskell-hugs nil 75 "Major mode for interacting with an inferior Hugs session." 76 :group 'haskell 77 :prefix "haskell-hugs-") 78 79(defun turn-on-haskell-hugs () 80 "Turn on Haskell interaction mode with a Hugs interpreter running in an 81another Emacs buffer named *hugs*. 82Maps the followind commands in the haskell keymap. 83 \\[haskell-hugs-load-file] 84 to save the current buffer and load it by sending the :load command 85 to Hugs. 86 \\[haskell-hugs-reload-file] 87 to send the :reload command to Hugs without saving the buffer. 88 \\[haskell-hugs-show-hugs-buffer] 89 to show the Hugs buffer and go to it." 90 (local-set-key "\C-c\C-s" 'haskell-hugs-start-process) 91 (local-set-key "\C-c\C-l" 'haskell-hugs-load-file) 92 (local-set-key "\C-c\C-r" 'haskell-hugs-reload-file) 93 (local-set-key "\C-c\C-b" 'haskell-hugs-show-hugs-buffer)) 94 95(defun turn-off-haskell-hugs () 96 "Turn off Haskell interaction mode with a Hugs interpreter within a buffer." 97 (local-unset-key "\C-c\C-s") 98 (local-unset-key "\C-c\C-l") 99 (local-unset-key "\C-c\C-r") 100 (local-unset-key "\C-c\C-b")) 101 102(define-derived-mode haskell-hugs-mode comint-mode "Haskell Hugs" 103;; called by haskell-hugs-start-process, 104;; itself called by haskell-hugs-load-file 105;; only when the file is loaded the first time 106 "Major mode for interacting with an inferior Hugs session. 107 108The commands available from within a Haskell script are: 109 \\<haskell-mode-map>\\[haskell-hugs-load-file] 110 to save the current buffer and load it by sending the :load command 111 to Hugs. 112 \\[haskell-hugs-reload-file] 113 to send the :reload command to Hugs without saving the buffer. 114 \\[haskell-hugs-show-hugs-buffer] 115 to show the Hugs buffer and go to it. 116 117\\<haskell-hugs-mode-map> 118Commands: 119Return at end of buffer sends line as input. 120Return not at end copies rest of line to end and sends it. 121\\[comint-kill-input] and \\[backward-kill-word] are kill commands, 122imitating normal Unix input editing. 123\\[comint-interrupt-subjob] interrupts the comint or its current 124subjob if any. 125\\[comint-stop-subjob] stops, likewise. 126 \\[comint-quit-subjob] sends quit signal." 127 ) 128 129;; Hugs-interface 130 131(require 'comint) 132(require 'shell) 133 134(defvar haskell-hugs-process nil 135 "The active Hugs subprocess corresponding to current buffer.") 136 137(defvar haskell-hugs-process-buffer nil 138 "*Buffer used for communication with Hugs subprocess for current buffer.") 139 140(defcustom haskell-hugs-program-name "hugs" 141 "*The name of the command to start the Hugs interpreter." 142 :type 'string 143 :group 'haskell-hugs) 144 145(defcustom haskell-hugs-program-args '("+.") 146 "*A list of string args to send to the hugs process." 147 :type '(repeat string) 148 :group 'haskell-hugs) 149 150(defvar haskell-hugs-load-end nil 151 "Position of the end of the last load command.") 152 153(defvar haskell-hugs-send-end nil 154 "Position of the end of the last send command.") 155 156(defalias 'run-hugs 'haskell-hugs-start-process) 157 158(defun haskell-hugs-start-process (arg) 159 "Start a Hugs process and invokes `haskell-hugs-hook' if not nil. 160Prompts for a list of args if called with an argument." 161 (interactive "P") 162 (message "Starting `hugs-process' %s" haskell-hugs-program-name) 163 (if arg 164 (setq haskell-hugs-program-args 165 (read-minibuffer "List of args for Hugs:" 166 (prin1-to-string haskell-hugs-program-args)))) 167 (setq haskell-hugs-process-buffer 168 (apply 'make-comint 169 "hugs" haskell-hugs-program-name nil 170 haskell-hugs-program-args)) 171 (setq haskell-hugs-process 172 (get-buffer-process haskell-hugs-process-buffer)) 173 ;; Select Hugs buffer temporarily 174 (set-buffer haskell-hugs-process-buffer) 175 (haskell-hugs-mode) 176 (make-local-variable 'shell-cd-regexp) 177 (make-local-variable 'shell-dirtrackp) 178 (setq shell-cd-regexp ":cd") 179 (setq shell-dirtrackp t) 180 (add-hook 'comint-input-filter-functions 'shell-directory-tracker nil 'local) 181 ; ? or module name in Hugs 1.4 182 (setq comint-prompt-regexp "^\? \\|^[[:upper:]][_[:alnum:]\.]*> ") 183 ;; comint's history syntax conflicts with Hugs syntax, eg. !! 184 (setq comint-input-autoexpand nil) 185 (run-hooks 'haskell-hugs-hook) 186 (message "") 187 ) 188 189(defun haskell-hugs-wait-for-output () 190 "Wait until output arrives and go to the last input." 191 (while (progn 192 (goto-char comint-last-input-end) 193 (and 194 (not (re-search-forward comint-prompt-regexp nil t)) 195 (accept-process-output haskell-hugs-process))))) 196 197(defun haskell-hugs-send (&rest string) 198 "Send `haskell-hugs-process' the arguments (one or more strings). 199A newline is sent after the strings and they are inserted into the 200current buffer after the last output." 201 ;; Wait until output arrives and go to the last input. 202 (haskell-hugs-wait-for-output) 203 ;; Position for this input. 204 (goto-char (point-max)) 205 (apply 'insert string) 206 (comint-send-input) 207 (setq haskell-hugs-send-end (marker-position comint-last-input-end))) 208 209(defun haskell-hugs-go (load-command cd) 210 "Save the current buffer and load its file into the Hugs process. 211The first argument LOAD-COMMAND specifies how the file should be 212loaded: as a new file (\":load \") or as a reload (\":reload \"). 213 214If the second argument CD is non-nil, change the Haskell-Hugs process to the 215current buffer's directory before loading the file. 216 217If the variable `haskell-hugs-command' is set then its value will be sent to 218the Hugs process after the load command. This can be used for a 219top-level expression to evaluate." 220 (hack-local-variables) ;; In case they've changed 221 (save-buffer) 222 (let ((file (if (string-equal load-command ":load ") 223 (concat "\"" buffer-file-name "\"") 224 "")) 225 (dir (expand-file-name default-directory)) 226 (cmd (and (boundp 'haskell-hugs-command) 227 haskell-hugs-command 228 (if (stringp haskell-hugs-command) 229 haskell-hugs-command 230 (symbol-name haskell-hugs-command))))) 231 (if (and haskell-hugs-process-buffer 232 (eq (process-status haskell-hugs-process) 'run)) 233 ;; Ensure the Hugs buffer is selected. 234 (set-buffer haskell-hugs-process-buffer) 235 ;; Start Haskell-Hugs process. 236 (haskell-hugs-start-process nil)) 237 238 (if cd (haskell-hugs-send (concat ":cd " dir))) 239 ;; Wait until output arrives and go to the last input. 240 (haskell-hugs-wait-for-output) 241 (haskell-hugs-send load-command file) 242 ;; Error message search starts from last load command. 243 (setq haskell-hugs-load-end (marker-position comint-last-input-end)) 244 (if cmd (haskell-hugs-send cmd)) 245 ;; Wait until output arrives and go to the last input. 246 (haskell-hugs-wait-for-output))) 247 248(defun haskell-hugs-load-file (cd) 249 "Save a hugs buffer file and load its file. 250If CD (prefix argument if interactive) is non-nil, change the Hugs 251process to the current buffer's directory before loading the file. 252If there is an error, set the cursor at the error line otherwise show 253the Hugs buffer." 254 (interactive "P") 255 (haskell-hugs-gen-load-file ":load " cd) 256 ) 257 258(defun haskell-hugs-reload-file (cd) 259 "Save a hugs buffer file and load its file. 260If CD (prefix argument if interactive) is non-nil, change the Hugs 261process to the current buffer's directory before loading the file. 262If there is an error, set the cursor at the error line otherwise show 263the Hugs buffer." 264 (interactive "P") 265 (haskell-hugs-gen-load-file ":reload " cd) 266 ) 267 268(defun haskell-hugs-gen-load-file (cmd cd) 269 "Save a hugs buffer file and load its file or reload depending on CMD. 270If CD is non-nil, change the process to the current buffer's directory 271before loading the file. If there is an error, set the cursor at the 272error line otherwise show the Hugs buffer." 273 (save-excursion (haskell-hugs-go cmd cd)) 274 ;; Ensure the Hugs buffer is selected. 275 (set-buffer haskell-hugs-process-buffer) 276 ;; Error message search starts from last load command. 277 (goto-char haskell-hugs-load-end) 278 (if (re-search-forward 279 "^ERROR \"\\([^ ]*\\)\"\\( (line \\([0-9]*\\))\\|\\)" nil t) 280 (let ((efile (buffer-substring (match-beginning 1) 281 (match-end 1))) 282 (eline (if (match-beginning 3) 283 (string-to-int (buffer-substring (match-beginning 3) 284 (match-end 3))))) 285 (emesg (buffer-substring (1+ (point)) 286 (save-excursion (end-of-line) (point))))) 287 (pop-to-buffer haskell-hugs-process-buffer) ; show *hugs* buffer 288 (goto-char (point-max)) 289 (recenter) 290 (message "Hugs error %s %s" 291 (file-name-nondirectory efile) emesg) 292 (if (file-exists-p efile) 293 (progn (find-file-other-window efile) 294 (if eline (goto-line eline)) 295 (recenter))) 296 ) 297 (pop-to-buffer haskell-hugs-process-buffer) ; show *hugs* buffer 298 (goto-char (point-max)) 299 (message "There were no errors.") 300 (recenter 2) ; show only the end... 301 ) 302 ) 303 304(defun haskell-hugs-show-hugs-buffer () 305 "Goes to the Hugs buffer." 306 (interactive) 307 (if (or (not haskell-hugs-process-buffer) 308 (not (buffer-live-p haskell-hugs-process-buffer))) 309 (haskell-hugs-start-process nil)) 310 (pop-to-buffer haskell-hugs-process-buffer) 311 ) 312 313(provide 'haskell-hugs) 314 315;; arch-tag: c2a621e9-d743-4361-a459-983fbf1d4589 316;;; haskell-hugs.el ends here