diff options
Diffstat (limited to 'ghc/CONTRIB/haskell-modes')
16 files changed, 9688 insertions, 0 deletions
diff --git a/ghc/CONTRIB/haskell-modes/README b/ghc/CONTRIB/haskell-modes/README new file mode 100644 index 0000000000..248460d211 --- /dev/null +++ b/ghc/CONTRIB/haskell-modes/README @@ -0,0 +1,55 @@ +I've collected all the Haskell modes for GNU Emacs that I could lay my +hands on -- there are billions. A list is attached, grouped by +"family". + +I don't like "mode junk" myself, so I don't use any of them. I will +include advertising or testimonials from happy users if they send them +along... + +Will Partain +partain@dcs.glasgow.ac.uk +95/12/05 + +======================================================================= + +* "Chalmers Haskell mode family" -- "Major mode for editing Haskell", + by Lars Bo Nielsen and Lennart Augustsson. + + chalmers/original -- the original -- version 0.1. + + chalmers/thiemann -- Peter Thiemann added "indentation stuff" + and fontification -- version 0.2. + + chalmers/sof -- Sigbjorn Finne's <sof@dcs.glasgow.ac.uk> hacked + version of Thiemann's. + +....................................................................... + +* "Glasgow Haskell mode family" -- originally written by Richard McPhee + et al., at Glasgow University, as a student project, for Kevin + Hammond. + + glasgow/original : version 1.0, now maintained by + gem@minster.york.ac.uk + +....................................................................... + +* "Simon Marlow Haskell mode family" -- This is the one that comes + with GHC, versions 0.16 up to at least 0.26. + + simonm/real : the real thing + + simonm/ghc : the one distributed with GHC 0.16-0.26; no particular + reason to prefer this one... + +....................................................................... + +* "Yale Haskell mode family" -- Especially good for chatting to a + Yale-Haskell inferior process :-) + + yale/original : the real thing + + yale/chak : "extended by Manuel M.T. Chakravarty with rudimentary + editing features (including better syntax table) and support + for the font-lock-mode." Via Hans Wolfgang Loidl + <hwloidl@dcs.glasgow.ac.uk> diff --git a/ghc/CONTRIB/haskell-modes/chalmers/original/haskell-mode.el b/ghc/CONTRIB/haskell-modes/chalmers/original/haskell-mode.el new file mode 100644 index 0000000000..167956d429 --- /dev/null +++ b/ghc/CONTRIB/haskell-modes/chalmers/original/haskell-mode.el @@ -0,0 +1,543 @@ +;; haskell-mode.el. Major mode for editing Haskell. +;; Copyright (C) 1989, Free Software Foundation, Inc., Lars Bo Nielsen +;; and Lennart Augustsson + +;; This file is not officially part of GNU Emacs. + +;; GNU Emacs is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY. No author or distributor +;; accepts responsibility to anyone for the consequences of using it +;; or for whether it serves any particular purpose or works at all, +;; unless he says so in writing. Refer to the GNU Emacs General Public +;; License for full details. + +;; Everyone is granted permission to copy, modify and redistribute +;; GNU Emacs, but only under the conditions described in the +;; GNU Emacs General Public License. A copy of this license is +;; supposed to have been given to you along with GNU Emacs so you +;; can know your rights and responsibilities. It should be in a +;; file named COPYING. Among other things, the copyright notice +;; and this notice must be preserved on all copies. + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; +;; Haskell Mode. A major mode for editing and running Haskell. (Version 0.0) +;; ================================================================= +;; +;; This is a mode for editing and running Haskell. +;; It is very much based on the sml mode for GNU Emacs. It +;; features: +;; +;; - Inferior shell running Haskell. No need to leave emacs, just +;; keep right on editing while Haskell runs in another window. +;; +;; - Automatic "load file" in inferior shell. Send regions of code +;; to the Haskell program. +;; +;; +;; 1. HOW TO USE THE Haskell-MODE +;; ========================== +;; +;; Here is a short introduction to the mode. +;; +;; 1.1 GETTING STARTED +;; ------------------- +;; +;; If you are an experienced user of Emacs, just skip this section. +;; +;; To use the haskell-mode, insert this in your "~/.emacs" file (Or ask your +;; emacs-administrator to help you.): +;; +;; (setq auto-mode-alist (cons '("\\.hs$" . haskell-mode) (cons '("\\.lhs$" . haskell-mode) +;; auto-mode-alist))) +;; (autoload 'haskell-mode "haskell-mode" "Major mode for editing Haskell." t) +;; +;; Now every time a file with the extension `.hs' or `.lhs' is found, it is +;; automatically started up in haskell-mode. +;; +;; You will also have to specify the path to this file, so you will have +;; to add this as well: +;; +;; (setq load-path (cons "/usr/me/emacs" load-path)) +;; +;; where "/usr/me/emacs" is the directory where this file is. +;; +;; You may also want to compile the this file (M-x byte-compile-file) +;; for speed. +;; +;; You are now ready to start using haskell-mode. If you have tried other +;; language modes (like lisp-mode or C-mode), you should have no +;; problems. There are only a few extra functions in this mode. +;; +;; 1.2. EDITING COMMANDS. +;; ---------------------- +;; +;; The following editing and inferior-shell commands can ONLY be issued +;; from within a buffer in haskell-mode. +;; +;; LFD (reindent-then-newline-and-indent). +;; This is probably the function you will be using the most (press +;; CTRL while you press Return, press C-j or press Newline). It +;; will reindent the line, then make a new line and perform a new +;; indentation. +;; +;; M-; (indent-for-comment). +;; Like in other language modes, this command will give you a comment +;; at the of the current line. The column where the comment starts is +;; determined by the variable comment-column (default: 40). +;; +;; C-c C-v (haskell-mode-version). +;; Get the version of the haskell-mode. +;; +;; +;; 1.3. COMMANDS RELATED TO THE INFERIOR SHELL +;; ------------------------------------------- +;; +;; C-c C-s (haskell-pop-to-shell). +;; This command starts up an inferior shell running haskell. If the shell +;; is running, it will just pop up the shell window. +;; +;; C-c C-u (haskell-save-buffer-use-file). +;; This command will save the current buffer and send a "load file", +;; where file is the file visited by the current buffer, to the +;; inferior shell running haskell. +;; +;; C-c C-f (haskell-run-on-file). +;; Will send a "load file" to the inferior shell running haskell, +;; prompting you for the file name. +;; +;; C-c C-r (haskell-send-region). +;; Will send region, from point to mark, to the inferior shell +;; running haskell. +;; +;; C-c C-b (haskell-send-buffer). +;; Will send whole buffer to inferior shell running haskell. +;; +;; 2. INDENTATION +;; ================ +;; Not yet. +;; +;; 3. INFERIOR SHELL. +;; ================== +;; +;; The mode for Standard ML also contains a mode for an inferior shell +;; running haskell. The mode is the same as the shell-mode, with just one +;; extra command. +;; +;; 3.1. INFERIOR SHELL COMMANDS +;; ---------------------------- +;; +;; C-c C-f (haskell-run-on-file). Send a `load file' to the process running +;; haskell. +;; +;; 3.2. CONSTANTS CONTROLLING THE INFERIOR SHELL MODE +;; -------------------------------------------------- +;; +;; Because haskell is called differently on various machines, and the +;; haskell-systems have their own command for reading in a file, a set of +;; constants controls the behavior of the inferior shell running haskell (to +;; change these constants: See CUSTOMIZING YOUR Haskell-MODE below). +;; +;; haskell-prog-name (default "hbi"). +;; This constant is a string, containing the command to invoke +;; Standard ML on your system. +;; +;; haskell-use-right-delim (default "\"") +;; haskell-use-left-delim (default "\"") +;; The left and right delimiter used by your version of haskell, for +;; `use file-name'. +;; +;; haskell-process-name (default "Haskell"). +;; The name of the process running haskell. (This will be the name +;; appearing on the mode line of the buffer) +;; +;; NOTE: The haskell-mode functions: haskell-send-buffer, haskell-send-function and +;; haskell-send-region, creates temporary files (I could not figure out how +;; to send large amounts of data to a process). These files will be +;; removed when you leave emacs. +;; +;; +;; 4. CUSTOMIZING YOUR Haskell-MODE +;; ============================ +;; +;; If you have to change some of the constants, you will have to add a +;; `hook' to the haskell-mode. Insert this in your "~/.emacs" file. +;; +;; (setq haskell-mode-hook 'my-haskell-constants) +;; +;; Your function "my-haskell-constants" will then be executed every time +;; "haskell-mode" is invoked. Now you only have to write the emacs-lisp +;; function "my-haskell-constants", and put it in your "~/.emacs" file. +;; +;; Say you are running a version of haskell that uses the syntax `load +;; ["file"]', is invoked by the command "OurHaskell" and you don't want the +;; indentation algorithm to indent according to open parenthesis, your +;; function should look like this: +;; +;; (defun my-haskell-constants () +;; (setq haskell-prog-name "OurHaskell") +;; (setq haskell-use-left-delim "[\"") +;; (setq haskell-use-right-delim "\"]") +;; (setq haskell-paren-lookback nil)) +;; +;; The haskell-shell also runs a `hook' (haskell-shell-hook) when it is invoked. +;; +;; +;; +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; +;; +;; ORIGINAL AUTHOR +;; Lars Bo Nielsen +;; Aalborg University +;; Computer Science Dept. +;; 9000 Aalborg +;; Denmark +;; +;; lbn@iesd.dk +;; or: ...!mcvax!diku!iesd!lbn +;; or: mcvax!diku!iesd!lbn@uunet.uu.net +;; +;; MODIFIED FOR Haskell BY +;; Lennart Augustsson +;; +;; +;; Please let me know if you come up with any ideas, bugs, or fixes. +;; +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(defconst haskell-mode-version-string + "HASKELL-MODE, Version 0.1") + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; +;;; CONSTANTS CONTROLLING THE MODE. +;;; +;;; These are the constants you might want to change +;;; + +;; The command used to start up the haskell-program. +(defconst haskell-prog-name "hbi" "*Name of program to run as haskell.") + +;; The left delimmitter for `load file' +(defconst haskell-use-left-delim "\"" + "*The left delimiter for the filename when using \"load\".") + +;; The right delimmitter for `load file' +(defconst haskell-use-right-delim "\"" + "*The right delimiter for the filename when using \"load\".") + +;; A regular expression matching the prompt pattern in the inferior +;; shell +(defconst haskell-shell-prompt-pattern "^> *" + "*The prompt pattern for the inferion shell running haskell.") + +;; The template used for temporary files, created when a region is +;; send to the inferior process running haskell. +(defconst haskell-tmp-template "/tmp/haskell.tmp." + "*Template for the temporary file, created by haskell-simulate-send-region.") + +;; The name of the process running haskell (This will also be the name of +;; the buffer). +(defconst haskell-process-name "Haskell" "*The name of the Haskell-process") + +;;; +;;; END OF CONSTANTS CONTROLLING THE MODE. +;;; +;;; If you change anything below, you are on your own. +;;; +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + + +(defvar haskell-mode-syntax-table nil "The syntax table used in haskell-mode.") + +(defvar haskell-mode-map nil "The mode map used in haskell-mode.") + +(defun haskell-mode () + "Major mode for editing Haskell code. +Tab indents for Haskell code. +Comments are delimited with -- +Paragraphs are separated by blank lines only. +Delete converts tabs to spaces as it moves back. + +Key bindings: +============= + +\\[haskell-pop-to-shell]\t Pop to the haskell window. +\\[haskell-save-buffer-use-file]\t Save the buffer, and send a \"load file\". +\\[haskell-send-region]\t Send region (point and mark) to haskell. +\\[haskell-run-on-file]\t Send a \"load file\" to haskell. +\\[haskell-send-buffer]\t Send whole buffer to haskell. +\\[haskell-mode-version]\t Get the version of haskell-mode. +\\[haskell-evaluate-expression]\t Prompt for an expression and evalute it. + + +Mode map +======== +\\{haskell-mode-map} +Runs haskell-mode-hook if non nil." + (interactive) + (kill-all-local-variables) + (if haskell-mode-map + () + (setq haskell-mode-map (make-sparse-keymap)) + (define-key haskell-mode-map "\C-c\C-v" 'haskell-mode-version) + (define-key haskell-mode-map "\C-c\C-u" 'haskell-save-buffer-use-file) + (define-key haskell-mode-map "\C-c\C-s" 'haskell-pop-to-shell) + (define-key haskell-mode-map "\C-c\C-r" 'haskell-send-region) + (define-key haskell-mode-map "\C-c\C-m" 'haskell-region) + (define-key haskell-mode-map "\C-c\C-f" 'haskell-run-on-file) + (define-key haskell-mode-map "\C-c\C-b" 'haskell-send-buffer) + (define-key haskell-mode-map "\C-ce" 'haskell-evaluate-expression) + (define-key haskell-mode-map "\C-j" 'reindent-then-newline-and-indent) + (define-key haskell-mode-map "\177" 'backward-delete-char-untabify)) + (use-local-map haskell-mode-map) + (setq major-mode 'haskell-mode) + (setq mode-name "Haskell") + (define-abbrev-table 'haskell-mode-abbrev-table ()) + (setq local-abbrev-table haskell-mode-abbrev-table) + (if haskell-mode-syntax-table + () + (setq haskell-mode-syntax-table (make-syntax-table)) + (modify-syntax-entry ?\( "()1" haskell-mode-syntax-table) + (modify-syntax-entry ?\) ")(4" haskell-mode-syntax-table) + (modify-syntax-entry ?\\ "." haskell-mode-syntax-table) + (modify-syntax-entry ?* ". 23" haskell-mode-syntax-table) + ;; Special characters in haskell-mode to be treated as normal + ;; characters: + (modify-syntax-entry ?_ "w" haskell-mode-syntax-table) + (modify-syntax-entry ?\' "w" haskell-mode-syntax-table) + ) + (set-syntax-table haskell-mode-syntax-table) + (make-local-variable 'require-final-newline) ; Always put a new-line + (setq require-final-newline t) ; in the end of file + (make-local-variable 'indent-line-function) + (setq indent-line-function 'haskell-indent-line) + (make-local-variable 'comment-start) + (setq comment-start "-- ") + (make-local-variable 'comment-end) + (setq comment-end "") + (make-local-variable 'comment-column) + (setq comment-column 39) ; Start of comment in this column + (make-local-variable 'comment-start-skip) + (setq comment-start-skip "(\\*+[ \t]?") ; This matches a start of comment + (make-local-variable 'comment-indent-hook) + (setq comment-indent-hook 'haskell-comment-indent) + ;; + ;; Adding these will fool the matching of parens. I really don't + ;; know why. It would be nice to have comments treated as + ;; white-space + ;; + ;; (make-local-variable 'parse-sexp-ignore-comments) + ;; (setq parse-sexp-ignore-comments t) + ;; + (run-hooks 'haskell-mode-hook)) ; Run the hook + +(defun haskell-mode-version () + (interactive) + (message haskell-mode-version-string)) + + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; +;;; INDENTATION +;;; +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +(defun haskell-indent-line () + "Indent current line of Haskell code." + (interactive) + (let ((indent (haskell-calculate-indentation))) + (if (/= (current-indentation) indent) + (let ((beg (progn (beginning-of-line) (point)))) + (skip-chars-forward "\t ") + (delete-region beg (point)) + (indent-to indent)) + ;; If point is before indentation, move point to indentation + (if (< (current-column) (current-indentation)) + (skip-chars-forward "\t "))))) + +(defun haskell-calculate-indentation () + (save-excursion + (previous-line 1) + (beginning-of-line) ; Go to first non whitespace + (skip-chars-forward "\t ") ; on the line. + (current-column))) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; +;;; INFERIOR SHELL +;;; +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(defvar haskell-shell-map nil "The mode map for haskell-shell.") + +(defun haskell-shell () + "Inferior shell invoking Haskell. +It is not possible to have more than one shell running Haskell. +Like the shell mode with the additional command: + +\\[haskell-run-on-file]\t Runs haskell on the file. +\\{haskell-shell-map} +Variables controlling the mode: + +haskell-prog-name (default \"hbi\") + The string used to invoke the haskell program. + +haskell-use-right-delim (default \"\\\"\") +haskell-use-left-delim (default \"\\\"\") + The left and right delimiter used by your version of haskell, for + \"load file-name\". + +haskell-process-name (default \"Haskell\") + The name of the process running haskell. + +haskell-shell-prompt-pattern (default \"^> *\") + The prompt pattern. + +Runs haskell-shell-hook if not nil." + (interactive) + (if (not (process-status haskell-process-name)) + (save-excursion ; Process is not running + (message "Starting Haskell...") ; start up a new process + (require 'shell) + (set-buffer (make-shell haskell-process-name haskell-prog-name)) + (erase-buffer) ; Erase the buffer if a previous + (if haskell-shell-map ; process died in there + () + (setq haskell-shell-map (copy-sequence shell-mode-map)) + (define-key haskell-shell-map "\C-c\C-f" 'haskell-run-on-file)) + (use-local-map haskell-shell-map) + (make-local-variable 'shell-prompt-pattern) + (setq shell-prompt-pattern haskell-shell-prompt-pattern) + (setq major-mode 'haskell-shell) + (setq mode-name "Haskell Shell") + (setq mode-line-format + "-----Emacs: %17b %M %[(%m: %s)%]----%3p--%-") + (set-process-filter (get-process haskell-process-name) 'haskell-process-filter) + (message "Starting Haskell...done.") + (run-hooks 'haskell-shell-hook)))) + +(defun haskell-process-filter (proc str) + (let ((cur (current-buffer)) + (pop-up-windows t)) + (pop-to-buffer (concat "*" haskell-process-name "*")) + (goto-char (point-max)) + (if (string= str "\b\b\b \b\b\b") + (backward-delete-char 4) + (insert str)) + (set-marker (process-mark proc) (point-max)) + (pop-to-buffer cur))) + +(defun haskell-pop-to-shell () + (interactive) + (haskell-shell) + (pop-to-buffer (concat "*" haskell-process-name "*"))) + +(defun haskell-run-on-file (fil) + (interactive "FRun Haskell on : ") + (haskell-shell) + (save-some-buffers) + (send-string haskell-process-name + (concat "load " haskell-use-left-delim (expand-file-name fil) + haskell-use-right-delim ";\n"))) + +(defun haskell-save-buffer-use-file () + "Save the buffer, and send a `use file' to the inferior shell +running Haskell." + (interactive) + (let (file) + (if (setq file (buffer-file-name)) ; Is the buffer associated + (progn ; with file ? + (save-buffer) + (haskell-shell) + (send-string haskell-process-name + (concat "load " haskell-use-left-delim + (expand-file-name file) + haskell-use-right-delim ";\n"))) + (error "Buffer not associated with file.")))) + +(defvar haskell-tmp-files-list nil + "List of all temporary files created by haskell-simulate-send-region. +Each element in the list is a list with the format: + + (\"tmp-filename\" buffer start-line)") + +(defvar haskell-simulate-send-region-called-p nil + "Has haskell-simulate-send-region been called previously.") + +(defun haskell-make-temp-name (pre) + (concat (make-temp-name pre) ".m")) + +(defun haskell-simulate-send-region (point1 point2) + "Simulate send region. As send-region only can handle what ever the +system sets as the default, we have to make a temporary file. +Updates the list of temporary files (haskell-tmp-files-list)." + (let ((file (expand-file-name (haskell-make-temp-name haskell-tmp-template)))) + ;; Remove temporary files when we leave emacs + (if (not haskell-simulate-send-region-called-p) + (progn + (setq haskell-old-kill-emacs-hook kill-emacs-hook) + (setq kill-emacs-hook 'haskell-remove-tmp-files) + (setq haskell-simulate-send-region-called-p t))) + (save-excursion + (goto-char point1) + (setq haskell-tmp-files-list + (cons (list file + (current-buffer) + (save-excursion ; Calculate line no. + (beginning-of-line) + (1+ (count-lines 1 (point))))) + haskell-tmp-files-list))) + (write-region point1 point2 file nil 'dummy) + (haskell-shell) + (message "Using temporary file: %s" file) + (send-string + haskell-process-name + ;; string to send: load file; + (concat "load " haskell-use-left-delim file haskell-use-right-delim ";\n")))) + +(defvar haskell-old-kill-emacs-hook nil + "Old value of kill-emacs-hook") + +(defun haskell-remove-tmp-files () + "Remove the temporary files, created by haskell-simulate-send-region, if +they still exist. Only files recorded in haskell-tmp-files-list are removed." + (message "Removing temporary files created by haskell-mode...") + (while haskell-tmp-files-list + (condition-case () + (delete-file (car (car haskell-tmp-files-list))) + (error ())) + (setq haskell-tmp-files-list (cdr haskell-tmp-files-list))) + (message "Removing temporary files created by haskell-mode...done.") + (run-hooks 'haskell-old-kill-emacs-hook)) + +(defun haskell-send-region () + "Send region." + (interactive) + (let (start end) + (save-excursion + (setq end (point)) + (exchange-point-and-mark) + (setq start (point))) + (haskell-simulate-send-region start end))) + +(defun haskell-send-buffer () + "Send the buffer." + (interactive) + (haskell-simulate-send-region (point-min) (point-max))) + +(defun haskell-evaluate-expression (h-expr) + "Prompt for and evaluate an expression" + (interactive "sExpression: ") + (let ((str (concat h-expr ";\n")) + (buf (current-buffer))) + (haskell-pop-to-shell) + (insert str) + (send-string haskell-process-name str) + (pop-to-buffer buf))) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; +;;; END OF Haskell-MODE +;;; +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; diff --git a/ghc/CONTRIB/haskell-modes/chalmers/sof/haskell-mode.el b/ghc/CONTRIB/haskell-modes/chalmers/sof/haskell-mode.el new file mode 100644 index 0000000000..25a4324ad8 --- /dev/null +++ b/ghc/CONTRIB/haskell-modes/chalmers/sof/haskell-mode.el @@ -0,0 +1,825 @@ +;; haskell-mode.el. Major mode for editing Haskell. +;; Copyright (C) 1989, Free Software Foundation, Inc., Lars Bo Nielsen +;; and Lennart Augustsson +;; modified by Peter Thiemann, March 1994 + +;; This file is not officially part of GNU Emacs. + +;; GNU Emacs is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY. No author or distributor +;; accepts responsibility to anyone for the consequences of using it +;; or for whether it serves any particular purpose or works at all, +;; unless he says so in writing. Refer to the GNU Emacs General Public +;; License for full details. + +;; Everyone is granted permission to copy, modify and redistribute +;; GNU Emacs, but only under the conditions described in the +;; GNU Emacs General Public License. A copy of this license is +;; supposed to have been given to you along with GNU Emacs so you +;; can know your rights and responsibilities. It should be in a +;; file named COPYING. Among other things, the copyright notice +;; and this notice must be preserved on all copies. + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; +;; Haskell Mode. A major mode for editing and running Haskell. (Version 0.0) +;; ================================================================= +;; +;; This is a mode for editing and running Haskell. +;; It is very much based on the sml mode for GNU Emacs. It +;; features: +;; +;; - Inferior shell running Haskell. No need to leave emacs, just +;; keep right on editing while Haskell runs in another window. +;; +;; - Automatic "load file" in inferior shell. Send regions of code +;; to the Haskell program. +;; +;; +;; 1. HOW TO USE THE Haskell-MODE +;; ========================== +;; +;; Here is a short introduction to the mode. +;; +;; 1.1 GETTING STARTED +;; ------------------- +;; +;; If you are an experienced user of Emacs, just skip this section. +;; +;; To use the haskell-mode, insert this in your "~/.emacs" file (Or ask your +;; emacs-administrator to help you.): +;; +;; (setq auto-mode-alist (cons '("\\.hs$" . haskell-mode) (cons '("\\.lhs$" . haskell-mode) +;; auto-mode-alist))) +;; (autoload 'haskell-mode "haskell-mode" "Major mode for editing Haskell." t) +;; +;; Now every time a file with the extension `.hs' or `.lhs' is found, it is +;; automatically started up in haskell-mode. +;; +;; You will also have to specify the path to this file, so you will have +;; to add this as well: +;; +;; (setq load-path (cons "/usr/me/emacs" load-path)) +;; +;; where "/usr/me/emacs" is the directory where this file is. +;; +;; You may also want to compile the this file (M-x byte-compile-file) +;; for speed. +;; +;; You are now ready to start using haskell-mode. If you have tried other +;; language modes (like lisp-mode or C-mode), you should have no +;; problems. There are only a few extra functions in this mode. +;; +;; 1.2. EDITING COMMANDS. +;; ---------------------- +;; +;; The following editing and inferior-shell commands can ONLY be issued +;; from within a buffer in haskell-mode. +;; +;; LFD (haskell-newline-and-indent). +;; This is probably the function you will be using the most (press +;; CTRL while you press Return, press C-j or press Newline). It +;; makes a new line and performs indentation based on the last +;; preceding non-comment line. +;; +;; M-; (indent-for-comment). +;; Like in other language modes, this command will give you a comment +;; at the of the current line. The column where the comment starts is +;; determined by the variable comment-column (default: 40). +;; +;; C-c C-v (haskell-mode-version). +;; Get the version of the haskell-mode. +;; +;; +;; 1.3. COMMANDS RELATED TO THE INFERIOR SHELL +;; ------------------------------------------- +;; +;; C-c C-s (haskell-pop-to-shell). +;; This command starts up an inferior shell running haskell. If the shell +;; is running, it will just pop up the shell window. +;; +;; C-c C-u (haskell-save-buffer-use-file). +;; This command will save the current buffer and send a "load file", +;; where file is the file visited by the current buffer, to the +;; inferior shell running haskell. +;; +;; C-c C-f (haskell-run-on-file). +;; Will send a "load file" to the inferior shell running haskell, +;; prompting you for the file name. +;; +;; C-c C-r (haskell-send-region). +;; Will send region, from point to mark, to the inferior shell +;; running haskell. +;; +;; C-c C-b (haskell-send-buffer). +;; Will send whole buffer to inferior shell running haskell. +;; +;; 2. INDENTATION +;; ================ +;; +;; The first indentation command (using C-j or TAB) on a given line +;; indents like the last preceding non-comment line. The next TAB +;; indents to the indentation of the innermost enclosing scope. Further +;; TABs get you to further enclosing scopes. After indentation has +;; reached the first column, the process restarts using the indentation +;; of the preceding non-comment line, again. +;; +;; 3. INFERIOR SHELL. +;; ================== +;; +;; The mode for Standard ML also contains a mode for an inferior shell +;; running haskell. The mode is the same as the shell-mode, with just one +;; extra command. +;; +;; 3.1. INFERIOR SHELL COMMANDS +;; ---------------------------- +;; +;; C-c C-f (haskell-run-on-file). Send a `load file' to the process running +;; haskell. +;; +;; 3.2. CONSTANTS CONTROLLING THE INFERIOR SHELL MODE +;; -------------------------------------------------- +;; +;; Because haskell is called differently on various machines, and the +;; haskell-systems have their own command for reading in a file, a set of +;; constants controls the behavior of the inferior shell running haskell (to +;; change these constants: See CUSTOMIZING YOUR Haskell-MODE below). +;; +;; haskell-prog-name (default "hbi"). +;; This constant is a string, containing the command to invoke +;; Standard ML on your system. +;; +;; haskell-use-right-delim (default "\"") +;; haskell-use-left-delim (default "\"") +;; The left and right delimiter used by your version of haskell, for +;; `use file-name'. +;; +;; haskell-process-name (default "Haskell"). +;; The name of the process running haskell. (This will be the name +;; appearing on the mode line of the buffer) +;; +;; NOTE: The haskell-mode functions: haskell-send-buffer, haskell-send-function and +;; haskell-send-region, creates temporary files (I could not figure out how +;; to send large amounts of data to a process). These files will be +;; removed when you leave emacs. +;; +;; 4. FONTIFICATION +;; +;; There is support for Jamie Zawinski's font-lock-mode through the +;; variable "haskell-font-lock-keywords". +;; +;; 5. CUSTOMIZING YOUR Haskell-MODE +;; ============================ +;; +;; If you have to change some of the constants, you will have to add a +;; `hook' to the haskell-mode. Insert this in your "~/.emacs" file. +;; +;; (setq haskell-mode-hook 'my-haskell-constants) +;; +;; Your function "my-haskell-constants" will then be executed every time +;; "haskell-mode" is invoked. Now you only have to write the emacs-lisp +;; function "my-haskell-constants", and put it in your "~/.emacs" file. +;; +;; Say you are running a version of haskell that uses the syntax `load +;; ["file"]', is invoked by the command "OurHaskell" and you don't want the +;; indentation algorithm to indent according to open parenthesis, your +;; function should look like this: +;; +;; (defun my-haskell-constants () +;; (setq haskell-prog-name "OurHaskell") +;; (setq haskell-use-left-delim "[\"") +;; (setq haskell-use-right-delim "\"]") +;; (setq haskell-paren-lookback nil)) +;; +;; The haskell-shell also runs a `hook' (haskell-shell-hook) when it is invoked. +;; +;; +;; +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; +;; +;; ORIGINAL AUTHOR +;; Lars Bo Nielsen +;; Aalborg University +;; Computer Science Dept. +;; 9000 Aalborg +;; Denmark +;; +;; lbn@iesd.dk +;; or: ...!mcvax!diku!iesd!lbn +;; or: mcvax!diku!iesd!lbn@uunet.uu.net +;; +;; MODIFIED FOR Haskell BY +;; Lennart Augustsson +;; indentation stuff by Peter Thiemann +;; +;; +;; Please let me know if you come up with any ideas, bugs, or fixes. +;; +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(defconst haskell-mode-version-string + "HASKELL-MODE, Version 0.2, PJT indentation") + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; +;;; CONSTANTS CONTROLLING THE MODE. +;;; +;;; These are the constants you might want to change +;;; + +;; The command used to start up the haskell-program. +(defconst haskell-prog-name "hbi" "*Name of program to run as haskell.") + +;; The left delimmitter for `load file' +(defconst haskell-use-left-delim "\"" + "*The left delimiter for the filename when using \"load\".") + +;; The right delimmitter for `load file' +(defconst haskell-use-right-delim "\"" + "*The right delimiter for the filename when using \"load\".") + +;; A regular expression matching the prompt pattern in the inferior +;; shell +(defconst haskell-shell-prompt-pattern "^> *" + "*The prompt pattern for the inferion shell running haskell.") + +;; The template used for temporary files, created when a region is +;; send to the inferior process running haskell. +(defconst haskell-tmp-template "/tmp/haskell.tmp." + "*Template for the temporary file, created by haskell-simulate-send-region.") + +;; The name of the process running haskell (This will also be the name of +;; the buffer). +(defconst haskell-process-name "Haskell" "*The name of the Haskell-process") + +;;; +;;; END OF CONSTANTS CONTROLLING THE MODE. +;;; +;;; If you change anything below, you are on your own. +;;; +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + + +(defvar haskell-mode-syntax-table nil "The syntax table used in haskell-mode.") + +(defvar haskell-mode-map nil "The mode map used in haskell-mode.") + +(defvar haskell-mode-abbrev-table nil "The abbrev-table used in haskell-mode.") + +(defvar haskell-old-kill-emacs-hook nil "Old value of kill-emacs-hook") + +(defun haskell-mode () + "Major mode for editing Haskell code. +Tab indents for Haskell code. +Comments are delimited with -- +Paragraphs are separated by blank lines only. +Delete converts tabs to spaces as it moves back. + +Key bindings: +============= + +\\[haskell-pop-to-shell]\t Pop to the haskell window. +\\[haskell-save-buffer-use-file]\t Save the buffer, and send a \"load file\". +\\[haskell-send-region]\t Send region (point and mark) to haskell. +\\[haskell-run-on-file]\t Send a \"load file\" to haskell. +\\[haskell-send-buffer]\t Send whole buffer to haskell. +\\[haskell-mode-version]\t Get the version of haskell-mode. +\\[haskell-evaluate-expression]\t Prompt for an expression and evalute it. + + +Mode map +======== +\\{haskell-mode-map} +Runs haskell-mode-hook if non nil." + (interactive) + (kill-all-local-variables) + (if haskell-mode-map + () + (setq haskell-mode-map (make-sparse-keymap)) + (define-key haskell-mode-map "\C-c\C-v" 'haskell-mode-version) + (define-key haskell-mode-map "\C-c\C-u" 'haskell-save-buffer-use-file) + (define-key haskell-mode-map "\C-c\C-s" 'haskell-pop-to-shell) + (define-key haskell-mode-map "\C-c\C-r" 'haskell-send-region) + (define-key haskell-mode-map "\C-c\C-m" 'haskell-region) + (define-key haskell-mode-map "\C-c\C-f" 'haskell-run-on-file) + (define-key haskell-mode-map "\C-c\C-b" 'haskell-send-buffer) + (define-key haskell-mode-map "\C-c\C-l" 'comment-line) + (define-key haskell-mode-map "\C-ce" 'haskell-evaluate-expression) +; (define-key haskell-mode-map "\C-j" 'haskell-newline-and-indent) + (define-key haskell-mode-map [S-tab] 'tab-to-tab-stop) + (define-key haskell-mode-map "\177" 'backward-delete-char-untabify)) + (use-local-map haskell-mode-map) + (setq major-mode 'haskell-mode) + (setq mode-name "Haskell") + (define-abbrev-table 'haskell-mode-abbrev-table ()) + (setq local-abbrev-table haskell-mode-abbrev-table) + (if haskell-mode-syntax-table + () + (setq haskell-mode-syntax-table (make-syntax-table)) + (modify-syntax-entry ?{ "(}1" haskell-mode-syntax-table) + (modify-syntax-entry ?} "){4" haskell-mode-syntax-table) +; partain: out +; (modify-syntax-entry ?- "_ 2356" haskell-mode-syntax-table) +; (modify-syntax-entry ?\f "> b" haskell-mode-syntax-table) +; (modify-syntax-entry ?\n "> b" haskell-mode-syntax-table) +; partain: end out +; partain: in + (modify-syntax-entry ?- "_ 23" haskell-mode-syntax-table) +; (modify-syntax-entry ?\f "> b" haskell-mode-syntax-table) +; (modify-syntax-entry ?\n "> b" haskell-mode-syntax-table) +; partain: end in + (modify-syntax-entry ?\\ "\\" haskell-mode-syntax-table) + (modify-syntax-entry ?* "_" haskell-mode-syntax-table) + (modify-syntax-entry ?_ "_" haskell-mode-syntax-table) + (modify-syntax-entry ?' "_" haskell-mode-syntax-table) + (modify-syntax-entry ?: "_" haskell-mode-syntax-table) + (modify-syntax-entry ?| "." haskell-mode-syntax-table) + ) + (set-syntax-table haskell-mode-syntax-table) + (make-local-variable 'require-final-newline) ; Always put a new-line + (setq require-final-newline t) ; in the end of file +; (make-local-variable 'change-major-mode-hook) +; (setq change-major-mode-hook nil) +; (make-local-variable 'indent-line-function) +; (setq indent-line-function 'haskell-indent-line) + (make-local-variable 'comment-start) + (setq comment-start "-- ") +; (setq comment-start "{- ") + (make-local-variable 'comment-end) + (setq comment-end "") +; (setq comment-end " -}") + (make-local-variable 'comment-column) + (setq comment-column 60) ; Start of comment in this column + (make-local-variable 'comment-start-skip) + (setq comment-start-skip "{-+ *\\|--+ *") ; This matches a start of comment + (make-local-variable 'comment-multi-line) + (setq comment-multi-line nil) +; (make-local-variable 'comment-indent-function) +; (setq comment-indent-function 'haskell-comment-indent) + ;; + ;; Adding these will fool the matching of parens. I really don't + ;; know why. It would be nice to have comments treated as + ;; white-space + ;; + ;; (make-local-variable 'parse-sexp-ignore-comments) + ;; (setq parse-sexp-ignore-comments t) + ;; + (run-hooks 'haskell-mode-hook)) ; Run the hook + +(defun haskell-mode-version () + (interactive) + (message haskell-mode-version-string)) + + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; +;;; INDENTATION +;;; +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +;;; some variables for later use + +(defvar haskell-open-comment "{-") +(defvar haskell-close-comment "-}") +(defvar haskell-indentation-counter 0 + "count repeated invocations of indent-for-tab-command") +(defvar haskell-literate-flag nil + "used to guide literate/illiterate behavior, set automagically") + +(defun haskell-newline-and-indent () + (interactive) + (setq haskell-literate-flag + (save-excursion + (beginning-of-line) + (= (following-char) ?>))) + (newline) + (if haskell-literate-flag (insert ">")) + (haskell-indent-line)) + +(defun haskell-indent-line () + "Indent current line of ordinary or literate Haskell code." + (interactive) + (let ((indent (haskell-calculate-indentation-pjt-2))) + (if (/= (current-indentation) indent) + (let ((beg (progn + (beginning-of-line) + (if (= (following-char) ?>) (forward-char 1)) ;LITERATE + (point)))) + (skip-chars-forward "\t ") + (delete-region beg (point)) + (indent-to indent)) + ;; If point is before indentation, move point to indentation + (if (< (current-column) (current-indentation)) + (skip-chars-forward "\t "))))) + +(defun haskell-calculate-indentation () + (save-excursion + (let ((col (current-column))) + (while (and (not (bobp)) ;skip over empty and comment-only lines + (= col (current-column))) + (previous-line 1) + (beginning-of-line) ; Go to first non whitespace + (if (= (following-char) ?>) ;LITERATE + (forward-char 1) + (if haskell-literate-flag ;ignore illiterate lines + (end-of-line))) + (skip-chars-forward "\t ") ; on the line. + (setq col (current-column)) + (search-forward-regexp (concat haskell-open-comment "\\|--\\|\n") nil 0) + (goto-char (match-beginning 0))) + (search-backward-regexp "\\b\\(where\\|let\\|of\\|in\\)\\b\\|\n" nil 0) + (if (looking-at "\n") + () + (setq col (current-column)) + (forward-word 1) + (skip-chars-forward "\t ") + (if (looking-at "\\w") + (setq col (current-column)) + (setq col (+ 2 col)))) + col))) + +(defun haskell-calculate-indentation-pjt-2 () + "Calculate indentation for Haskell program code, versatile version" + (save-excursion + (if (eq last-command 'haskell-indentation) + (setq haskell-indentation-counter (1+ haskell-indentation-counter)) + (setq haskell-indentation-counter -1)) + (setq this-command 'haskell-indentation) + (let* ((simple-indent (haskell-calculate-indentation)) + (count haskell-indentation-counter) + (min-indent simple-indent) ; minimum indentation found in a non-comment line + (last-indent simple-indent) ; indentation of the following non-comment line + (return-indent nil) ; computed indentation + (comment-depth 0)) + (previous-line 1) + (if (< haskell-indentation-counter 0) ; 1st tab gives simple indentation + (setq return-indent simple-indent)) + (while (not return-indent) + (if (search-backward-regexp "\\b\\(where\\|let\\|of\\)\\b\\|\n\\|{-\\|-}" nil t 1) + (cond + ((looking-at haskell-open-comment) + (setq comment-depth (1- comment-depth))) + ((looking-at haskell-close-comment) + (setq comment-depth (1+ comment-depth))) + ((= 0 comment-depth) + (cond + ((looking-at "\n") + (save-excursion + (forward-char 1) + (if (= (following-char) ?>) + (forward-char 1) + (if haskell-literate-flag + (end-of-line))) ;LITERATE: ignore lines w/o > + (skip-chars-forward "\t ") + (if (looking-at (concat haskell-open-comment "\\|--\\|\n")) + () + (setq last-indent (current-column)) + (if (< last-indent min-indent) + (setq min-indent last-indent))))) + (t ; looking at a keyword + (save-excursion + (forward-word 1) + (skip-chars-forward " \t") + (if (and haskell-literate-flag ;LITERATE: ignore lines w/o > + (save-excursion + (beginning-of-line) + (/= (following-char) ?>))) + (end-of-line)) + (if (looking-at (concat haskell-open-comment "\\|--\\|\n")) + () + (setq last-indent (current-column))) + (if (<= last-indent min-indent) + (if (> count 0) + (setq count (1- count)) + (setq return-indent last-indent))) + (if (< last-indent min-indent) + (setq min-indent last-indent))))))) + (setq return-indent simple-indent) + (setq haskell-indentation-counter -1))) + return-indent))) + +(defun haskell-skip-nested-comment () + ;; point looks at opening {-, move over closing -} + ;; todo: specify what happens on failure, bounds check ... + (forward-char 2) + (let ((comment-depth 1)) + (while (> comment-depth 0) + (search-forward-regexp "{-\\|-}") + (goto-char (match-beginning 0)) + (setq comment-depth + (if (= (following-char) 123) ; code for opening brace + (1+ comment-depth) + (1- comment-depth))) + (goto-char (match-end 0))))) + + +;;;seemingly obsolete functions +(defun haskell-inside-of-inline-comment () + (let ((bolp (save-excursion + (beginning-of-line) + (point)))) + (search-backward comment-start bolp t 1))) + +(defun haskell-inside-of-nested-comment () + (save-excursion + (let ((count 0)) + (while + (search-backward-regexp "\\({-\\|-}\\)" 0 t 1) + (if (haskell-inside-of-inline-comment) + () + (if (looking-at haskell-open-comment) + (setq count (1+ count)) + (setq count (1- count))))) + (> count 0)))) + +(defun haskell-inside-of-comment () + (or (haskell-inside-of-inline-comment) + (haskell-inside-of-nested-comment))) + +;;;stolen from sml-mode.el +(defun haskell-comment-indent () + "Compute indentation for Haskell comments" + (if (looking-at "^--") + 0 + (save-excursion + (skip-chars-backward " \t") + (max (1+ (current-column)) + comment-column)))) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; +;;; INFERIOR SHELL +;;; +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(defvar haskell-shell-map nil "The mode map for haskell-shell.") + +(defun haskell-shell () + "Inferior shell invoking Haskell. +It is not possible to have more than one shell running Haskell. +Like the shell mode with the additional command: + +\\[haskell-run-on-file]\t Runs haskell on the file. +\\{haskell-shell-map} +Variables controlling the mode: + +haskell-prog-name (default \"hbi\") + The string used to invoke the haskell program. + +haskell-use-right-delim (default \"\\\"\") +haskell-use-left-delim (default \"\\\"\") + The left and right delimiter used by your version of haskell, for + \"load file-name\". + +haskell-process-name (default \"Haskell\") + The name of the process running haskell. + +haskell-shell-prompt-pattern (default \"^> *\") + The prompt pattern. + +Runs haskell-shell-hook if not nil." + (interactive) + (if (not (process-status haskell-process-name)) + (save-excursion ; Process is not running + (message "Starting Haskell...") ; start up a new process + (require 'shell) + (set-buffer (make-comint haskell-process-name haskell-prog-name)) + (erase-buffer) ; Erase the buffer if a previous + (if haskell-shell-map ; process died in there + () + (setq haskell-shell-map (copy-keymap shell-mode-map)) + (define-key haskell-shell-map "\C-c\C-f" 'haskell-run-on-file)) + (use-local-map haskell-shell-map) + (make-local-variable 'shell-prompt-pattern) + (setq shell-prompt-pattern haskell-shell-prompt-pattern) + (setq major-mode 'haskell-shell) + (setq mode-name "Haskell Shell") + (setq mode-line-format + "-----Emacs: %17b %M %[(%m: %s)%]----%3p--%-") + (set-process-filter (get-process haskell-process-name) 'haskell-process-filter) + (message "Starting Haskell...done.") + (run-hooks 'haskell-shell-hook)))) + +(defun haskell-process-filter (proc str) + (let ((cur (current-buffer)) + (pop-up-windows t)) + (pop-to-buffer (concat "*" haskell-process-name "*")) + (goto-char (point-max)) + (if (string= str "\b\b\b \b\b\b") + (backward-delete-char 4) + (insert str)) + (set-marker (process-mark proc) (point-max)) + (pop-to-buffer cur))) + +(defun haskell-pop-to-shell () + (interactive) + (haskell-shell) + (pop-to-buffer (concat "*" haskell-process-name "*"))) + +(defun haskell-run-on-file (fil) + (interactive "FRun Haskell on : ") + (haskell-shell) + (save-some-buffers) + (process-send-string haskell-process-name + (concat "load " haskell-use-left-delim (expand-file-name fil) + haskell-use-right-delim ";\n"))) + +(defun haskell-save-buffer-use-file () + "Save the buffer, and send a `use file' to the inferior shell +running Haskell." + (interactive) + (let (file) + (if (setq file (buffer-file-name)) ; Is the buffer associated + (progn ; with file ? + (save-buffer) + (haskell-shell) + (process-send-string haskell-process-name + (concat "load " haskell-use-left-delim + (expand-file-name file) + haskell-use-right-delim ";\n"))) + (error "Buffer not associated with file.")))) + +(defvar haskell-tmp-files-list nil + "List of all temporary files created by haskell-simulate-send-region. +Each element in the list is a list with the format: + + (\"tmp-filename\" buffer start-line)") + +(defvar haskell-simulate-send-region-called-p nil + "Has haskell-simulate-send-region been called previously.") + +(defun haskell-make-temp-name (pre) + (concat (make-temp-name pre) ".m")) + +(defun haskell-simulate-send-region (point1 point2) + "Simulate send region. As send-region only can handle what ever the +system sets as the default, we have to make a temporary file. +Updates the list of temporary files (haskell-tmp-files-list)." + (let ((file (expand-file-name (haskell-make-temp-name haskell-tmp-template)))) + ;; Remove temporary files when we leave emacs + (if (not haskell-simulate-send-region-called-p) + (progn + (setq haskell-old-kill-emacs-hook kill-emacs-hook) + (setq kill-emacs-hook 'haskell-remove-tmp-files) + (setq haskell-simulate-send-region-called-p t))) + (save-excursion + (goto-char point1) + (setq haskell-tmp-files-list + (cons (list file + (current-buffer) + (save-excursion ; Calculate line no. + (beginning-of-line) + (1+ (count-lines 1 (point))))) + haskell-tmp-files-list))) + (write-region point1 point2 file nil 'dummy) + (haskell-shell) + (message "Using temporary file: %s" file) + (process-send-string + haskell-process-name + ;; string to send: load file; + (concat "load " haskell-use-left-delim file haskell-use-right-delim ";\n")))) + +(defun haskell-remove-tmp-files () + "Remove the temporary files, created by haskell-simulate-send-region, if +they still exist. Only files recorded in haskell-tmp-files-list are removed." + (message "Removing temporary files created by haskell-mode...") + (while haskell-tmp-files-list + (condition-case () + (delete-file (car (car haskell-tmp-files-list))) + (error ())) + (setq haskell-tmp-files-list (cdr haskell-tmp-files-list))) + (message "Removing temporary files created by haskell-mode...done.") + (run-hooks 'haskell-old-kill-emacs-hook)) + +(defun haskell-send-region () + "Send region." + (interactive) + (let (start end) + (save-excursion + (setq end (point)) + (exchange-point-and-mark) + (setq start (point))) + (haskell-simulate-send-region start end))) + +(defun haskell-send-buffer () + "Send the buffer." + (interactive) + (haskell-simulate-send-region (point-min) (point-max))) + +(defun haskell-evaluate-expression (h-expr) + "Prompt for and evaluate an expression" + (interactive "sExpression: ") + (let ((str (concat h-expr ";\n")) + (buf (current-buffer))) + (haskell-pop-to-shell) + (insert str) + (process-send-string haskell-process-name str) + (pop-to-buffer buf))) + + +;; +;; font-lock-mode patterns, based on specs. in an earlier version +;; of haskell-mode.el +;; (these patterns have only been tested with 19.30) + +(defconst haskell-font-lock-keywords nil + "Conservative highlighting of a Haskell buffer +(using font-lock.)") + +(let ((haskell-id "[a-z_][a-zA-Z0-9_'#]+") + (haskell-reserved-ids + (concat "\\b\\(" + (mapconcat + 'identity + '("case" "class" "data" + "default" "deriving" "else" + "hiding" "if" "import" "in" + "instance" "interface" "let" + "module" "of" "renaming" + "then" "to" "type" "where" "infix[rl]?") + "\\|") + "\\)[ \t\n:,]")) + (haskell-basic-types + (concat "\\b\\(" + (mapconcat 'identity + '("Bool" "()" "String" "Char" "Int" + "Integer" "Float" "Double" "Ratio" + "Assoc" "Rational" "Array") + "\\|") + "\\)\\b")) + (haskell-prelude-classes + (concat "\\b\\(" + (mapconcat 'identity + '("Eq" "Ord" "Text" "Num" "Real" "Fractional" + "Integral" "RealFrac" "Floating" "RealFloat" + "Complex" "Ix" "Enum" + ;; ghc-isms + "_CCallable" "_CReturnable") + "\\|") + "\\)\\b")) + (haskell-reserved-ops + (mapconcat 'identity + '("\\.\\." "::" + "=>" "/=" "@" + "<-" "->") + "\\|")) + (glasgow-haskell-ops + (concat "\\b\\(" + (mapconcat + 'identity + '(">>" ">>=" "thenPrimIO" + "seqPrimIO" "returnPrimIO" + "return" "_ccall_" "_casm_" + "thenST" "seqST" "returnST" + "thenStrictlyST" "seqStrictlyST" "returnStrictlyST" + "unsafeInterleavePrimIO" "unsafePerformIO") + "\\|") + "\\)\\b")) + (glasgow-haskell-types + (concat "\\b\\(" + (mapconcat + 'identity + '("IO" "PrimIO" "_?ST" + "_Word" "_Addr" "_?MVar" + "_?IVar" "_RealWorld" + "_?MutableByteArray" + "_?ByteArray") + "\\|") + "\\)\\b"))) + (setq haskell-font-lock-keywords + (list + '("--.*$" . font-lock-comment-face) + (list "[ \t\n]*\\([A-Za-z[(_][]A-Za-z0-9_$', ~@|:[)(#]*[ \t\n]*\\)=" 1 font-lock-function-name-face) + (list (concat "^>?[ \t\n]*\\(" haskell-id "\\)[ \t]*::") 1 'font-lock-function-name-face) + (list haskell-reserved-ids 0 'font-lock-function-name-face) + (list glasgow-haskell-ops 0 'font-lock-function-name-face) + (list glasgow-haskell-types 0 'font-lock-type-face) + (list haskell-basic-types 0 'font-lock-type-face) + (list haskell-prelude-classes 0 'font-lock-type-face) + (list "^[ \t\n]*\\([A-Za-z[(_][]A-Za-z0-9_$', @:[)(#]*[ \t\n]*\\)->" 1 font-lock-variable-name-face) + ))) + +;; +;; To enable font-lock-mode for Haskell buffers, add something +;; like this to your ~/.emacs + +;(cond (window-system +; (require 'font-lock) +; (add-hook 'haskell-mode-hook +; '(lambda () (make-local-variable 'font-lock-defaults) +; (make-local-variable 'font-lock-mode-hook) ; don't affect other buffers +; (setq font-lock-mode-hook nil) +; (add-hook 'font-lock-mode-hook +; '(lambda () +; (setq font-lock-keywords haskell-font-lock-keywords))) +; (font-lock-mode 1)))) + + + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;;; +;;;; END OF Haskell-MODE +;;;; +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +(provide 'haskell-mode) diff --git a/ghc/CONTRIB/haskell-modes/chalmers/thiemann/haskell-mode.el b/ghc/CONTRIB/haskell-modes/chalmers/thiemann/haskell-mode.el new file mode 100644 index 0000000000..e900f01a76 --- /dev/null +++ b/ghc/CONTRIB/haskell-modes/chalmers/thiemann/haskell-mode.el @@ -0,0 +1,764 @@ +;; haskell-mode.el. Major mode for editing Haskell. +;; Copyright (C) 1989, Free Software Foundation, Inc., Lars Bo Nielsen +;; and Lennart Augustsson +;; modified by Peter Thiemann, March 1994 + +;; This file is not officially part of GNU Emacs. + +;; GNU Emacs is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY. No author or distributor +;; accepts responsibility to anyone for the consequences of using it +;; or for whether it serves any particular purpose or works at all, +;; unless he says so in writing. Refer to the GNU Emacs General Public +;; License for full details. + +;; Everyone is granted permission to copy, modify and redistribute +;; GNU Emacs, but only under the conditions described in the +;; GNU Emacs General Public License. A copy of this license is +;; supposed to have been given to you along with GNU Emacs so you +;; can know your rights and responsibilities. It should be in a +;; file named COPYING. Among other things, the copyright notice +;; and this notice must be preserved on all copies. + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; +;; Haskell Mode. A major mode for editing and running Haskell. (Version 0.0) +;; ================================================================= +;; +;; This is a mode for editing and running Haskell. +;; It is very much based on the sml mode for GNU Emacs. It +;; features: +;; +;; - Inferior shell running Haskell. No need to leave emacs, just +;; keep right on editing while Haskell runs in another window. +;; +;; - Automatic "load file" in inferior shell. Send regions of code +;; to the Haskell program. +;; +;; +;; 1. HOW TO USE THE Haskell-MODE +;; ========================== +;; +;; Here is a short introduction to the mode. +;; +;; 1.1 GETTING STARTED +;; ------------------- +;; +;; If you are an experienced user of Emacs, just skip this section. +;; +;; To use the haskell-mode, insert this in your "~/.emacs" file (Or ask your +;; emacs-administrator to help you.): +;; +;; (setq auto-mode-alist (cons '("\\.hs$" . haskell-mode) (cons '("\\.lhs$" . haskell-mode) +;; auto-mode-alist))) +;; (autoload 'haskell-mode "haskell-mode" "Major mode for editing Haskell." t) +;; +;; Now every time a file with the extension `.hs' or `.lhs' is found, it is +;; automatically started up in haskell-mode. +;; +;; You will also have to specify the path to this file, so you will have +;; to add this as well: +;; +;; (setq load-path (cons "/usr/me/emacs" load-path)) +;; +;; where "/usr/me/emacs" is the directory where this file is. +;; +;; You may also want to compile the this file (M-x byte-compile-file) +;; for speed. +;; +;; You are now ready to start using haskell-mode. If you have tried other +;; language modes (like lisp-mode or C-mode), you should have no +;; problems. There are only a few extra functions in this mode. +;; +;; 1.2. EDITING COMMANDS. +;; ---------------------- +;; +;; The following editing and inferior-shell commands can ONLY be issued +;; from within a buffer in haskell-mode. +;; +;; LFD (haskell-newline-and-indent). +;; This is probably the function you will be using the most (press +;; CTRL while you press Return, press C-j or press Newline). It +;; makes a new line and performs indentation based on the last +;; preceding non-comment line. +;; +;; M-; (indent-for-comment). +;; Like in other language modes, this command will give you a comment +;; at the of the current line. The column where the comment starts is +;; determined by the variable comment-column (default: 40). +;; +;; C-c C-v (haskell-mode-version). +;; Get the version of the haskell-mode. +;; +;; +;; 1.3. COMMANDS RELATED TO THE INFERIOR SHELL +;; ------------------------------------------- +;; +;; C-c C-s (haskell-pop-to-shell). +;; This command starts up an inferior shell running haskell. If the shell +;; is running, it will just pop up the shell window. +;; +;; C-c C-u (haskell-save-buffer-use-file). +;; This command will save the current buffer and send a "load file", +;; where file is the file visited by the current buffer, to the +;; inferior shell running haskell. +;; +;; C-c C-f (haskell-run-on-file). +;; Will send a "load file" to the inferior shell running haskell, +;; prompting you for the file name. +;; +;; C-c C-r (haskell-send-region). +;; Will send region, from point to mark, to the inferior shell +;; running haskell. +;; +;; C-c C-b (haskell-send-buffer). +;; Will send whole buffer to inferior shell running haskell. +;; +;; 2. INDENTATION +;; ================ +;; +;; The first indentation command (using C-j or TAB) on a given line +;; indents like the last preceding non-comment line. The next TAB +;; indents to the indentation of the innermost enclosing scope. Further +;; TABs get you to further enclosing scopes. After indentation has +;; reached the first column, the process restarts using the indentation +;; of the preceding non-comment line, again. +;; +;; 3. INFERIOR SHELL. +;; ================== +;; +;; The mode for Standard ML also contains a mode for an inferior shell +;; running haskell. The mode is the same as the shell-mode, with just one +;; extra command. +;; +;; 3.1. INFERIOR SHELL COMMANDS +;; ---------------------------- +;; +;; C-c C-f (haskell-run-on-file). Send a `load file' to the process running +;; haskell. +;; +;; 3.2. CONSTANTS CONTROLLING THE INFERIOR SHELL MODE +;; -------------------------------------------------- +;; +;; Because haskell is called differently on various machines, and the +;; haskell-systems have their own command for reading in a file, a set of +;; constants controls the behavior of the inferior shell running haskell (to +;; change these constants: See CUSTOMIZING YOUR Haskell-MODE below). +;; +;; haskell-prog-name (default "hbi"). +;; This constant is a string, containing the command to invoke +;; Standard ML on your system. +;; +;; haskell-use-right-delim (default "\"") +;; haskell-use-left-delim (default "\"") +;; The left and right delimiter used by your version of haskell, for +;; `use file-name'. +;; +;; haskell-process-name (default "Haskell"). +;; The name of the process running haskell. (This will be the name +;; appearing on the mode line of the buffer) +;; +;; NOTE: The haskell-mode functions: haskell-send-buffer, haskell-send-function and +;; haskell-send-region, creates temporary files (I could not figure out how +;; to send large amounts of data to a process). These files will be +;; removed when you leave emacs. +;; +;; 4. FONTIFICATION +;; +;; There is support for Jamie Zawinski's font-lock-mode through the +;; variable "haskell-font-lock-keywords". +;; +;; 5. CUSTOMIZING YOUR Haskell-MODE +;; ============================ +;; +;; If you have to change some of the constants, you will have to add a +;; `hook' to the haskell-mode. Insert this in your "~/.emacs" file. +;; +;; (setq haskell-mode-hook 'my-haskell-constants) +;; +;; Your function "my-haskell-constants" will then be executed every time +;; "haskell-mode" is invoked. Now you only have to write the emacs-lisp +;; function "my-haskell-constants", and put it in your "~/.emacs" file. +;; +;; Say you are running a version of haskell that uses the syntax `load +;; ["file"]', is invoked by the command "OurHaskell" and you don't want the +;; indentation algorithm to indent according to open parenthesis, your +;; function should look like this: +;; +;; (defun my-haskell-constants () +;; (setq haskell-prog-name "OurHaskell") +;; (setq haskell-use-left-delim "[\"") +;; (setq haskell-use-right-delim "\"]") +;; (setq haskell-paren-lookback nil)) +;; +;; The haskell-shell also runs a `hook' (haskell-shell-hook) when it is invoked. +;; +;; +;; +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; +;; +;; ORIGINAL AUTHOR +;; Lars Bo Nielsen +;; Aalborg University +;; Computer Science Dept. +;; 9000 Aalborg +;; Denmark +;; +;; lbn@iesd.dk +;; or: ...!mcvax!diku!iesd!lbn +;; or: mcvax!diku!iesd!lbn@uunet.uu.net +;; +;; MODIFIED FOR Haskell BY +;; Lennart Augustsson +;; indentation stuff by Peter Thiemann +;; +;; +;; Please let me know if you come up with any ideas, bugs, or fixes. +;; +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(defconst haskell-mode-version-string + "HASKELL-MODE, Version 0.2, PJT indentation") + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; +;;; CONSTANTS CONTROLLING THE MODE. +;;; +;;; These are the constants you might want to change +;;; + +;; The command used to start up the haskell-program. +(defconst haskell-prog-name "hbi" "*Name of program to run as haskell.") + +;; The left delimmitter for `load file' +(defconst haskell-use-left-delim "\"" + "*The left delimiter for the filename when using \"load\".") + +;; The right delimmitter for `load file' +(defconst haskell-use-right-delim "\"" + "*The right delimiter for the filename when using \"load\".") + +;; A regular expression matching the prompt pattern in the inferior +;; shell +(defconst haskell-shell-prompt-pattern "^> *" + "*The prompt pattern for the inferion shell running haskell.") + +;; The template used for temporary files, created when a region is +;; send to the inferior process running haskell. +(defconst haskell-tmp-template "/tmp/haskell.tmp." + "*Template for the temporary file, created by haskell-simulate-send-region.") + +;; The name of the process running haskell (This will also be the name of +;; the buffer). +(defconst haskell-process-name "Haskell" "*The name of the Haskell-process") + +;;; +;;; END OF CONSTANTS CONTROLLING THE MODE. +;;; +;;; If you change anything below, you are on your own. +;;; +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + + +(defvar haskell-mode-syntax-table nil "The syntax table used in haskell-mode.") + +(defvar haskell-mode-map nil "The mode map used in haskell-mode.") + +(defvar haskell-mode-abbrev-table nil "The abbrev-table used in haskell-mode.") + +(defvar haskell-old-kill-emacs-hook nil "Old value of kill-emacs-hook") + +(defun haskell-mode () + "Major mode for editing Haskell code. +Tab indents for Haskell code. +Comments are delimited with -- +Paragraphs are separated by blank lines only. +Delete converts tabs to spaces as it moves back. + +Key bindings: +============= + +\\[haskell-pop-to-shell]\t Pop to the haskell window. +\\[haskell-save-buffer-use-file]\t Save the buffer, and send a \"load file\". +\\[haskell-send-region]\t Send region (point and mark) to haskell. +\\[haskell-run-on-file]\t Send a \"load file\" to haskell. +\\[haskell-send-buffer]\t Send whole buffer to haskell. +\\[haskell-mode-version]\t Get the version of haskell-mode. +\\[haskell-evaluate-expression]\t Prompt for an expression and evalute it. + + +Mode map +======== +\\{haskell-mode-map} +Runs haskell-mode-hook if non nil." + (interactive) + (kill-all-local-variables) + (if haskell-mode-map + () + (setq haskell-mode-map (make-sparse-keymap)) + (define-key haskell-mode-map "\C-c\C-v" 'haskell-mode-version) + (define-key haskell-mode-map "\C-c\C-u" 'haskell-save-buffer-use-file) + (define-key haskell-mode-map "\C-c\C-s" 'haskell-pop-to-shell) + (define-key haskell-mode-map "\C-c\C-r" 'haskell-send-region) + (define-key haskell-mode-map "\C-c\C-m" 'haskell-region) + (define-key haskell-mode-map "\C-c\C-f" 'haskell-run-on-file) + (define-key haskell-mode-map "\C-c\C-b" 'haskell-send-buffer) + (define-key haskell-mode-map "\C-ce" 'haskell-evaluate-expression) + (define-key haskell-mode-map "\C-j" 'haskell-newline-and-indent) + (define-key haskell-mode-map "\177" 'backward-delete-char-untabify)) + (use-local-map haskell-mode-map) + (setq major-mode 'haskell-mode) + (setq mode-name "Haskell") + (define-abbrev-table 'haskell-mode-abbrev-table ()) + (setq local-abbrev-table haskell-mode-abbrev-table) + (if haskell-mode-syntax-table + () + (setq haskell-mode-syntax-table (make-syntax-table)) + (modify-syntax-entry ?{ "(}1" haskell-mode-syntax-table) + (modify-syntax-entry ?} "){4" haskell-mode-syntax-table) +; partain: out +; (modify-syntax-entry ?- "_ 2356" haskell-mode-syntax-table) +; (modify-syntax-entry ?\f "> b" haskell-mode-syntax-table) +; (modify-syntax-entry ?\n "> b" haskell-mode-syntax-table) +; partain: end out +; partain: in + (modify-syntax-entry ?- "_ 23" haskell-mode-syntax-table) +; (modify-syntax-entry ?\f "> b" haskell-mode-syntax-table) +; (modify-syntax-entry ?\n "> b" haskell-mode-syntax-table) +; partain: end in + (modify-syntax-entry ?\\ "\\" haskell-mode-syntax-table) + (modify-syntax-entry ?* "_" haskell-mode-syntax-table) + (modify-syntax-entry ?_ "_" haskell-mode-syntax-table) + (modify-syntax-entry ?' "_" haskell-mode-syntax-table) + (modify-syntax-entry ?: "_" haskell-mode-syntax-table) + (modify-syntax-entry ?| "." haskell-mode-syntax-table) + ) + (set-syntax-table haskell-mode-syntax-table) + (make-local-variable 'require-final-newline) ; Always put a new-line + (setq require-final-newline t) ; in the end of file + (make-local-variable 'indent-line-function) + (setq indent-line-function 'haskell-indent-line) + (make-local-variable 'comment-start) + (setq comment-start "-- ") + (make-local-variable 'comment-end) + (setq comment-end "") + (make-local-variable 'comment-column) + (setq comment-column 60) ; Start of comment in this column + (make-local-variable 'comment-start-skip) + (setq comment-start-skip "--[^a-zA-Z0-9]*") ; This matches a start of comment + (make-local-variable 'comment-indent-function) + (setq comment-indent-function 'haskell-comment-indent) + ;; + ;; Adding these will fool the matching of parens. I really don't + ;; know why. It would be nice to have comments treated as + ;; white-space + ;; + ;; (make-local-variable 'parse-sexp-ignore-comments) + ;; (setq parse-sexp-ignore-comments t) + ;; + (run-hooks 'haskell-mode-hook)) ; Run the hook + +(defun haskell-mode-version () + (interactive) + (message haskell-mode-version-string)) + + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; +;;; INDENTATION +;;; +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +;;; some variables for later use + +(defvar haskell-open-comment "{-") +(defvar haskell-close-comment "-}") +(defvar haskell-indentation-counter 0 + "count repeated invocations of indent-for-tab-command") +(defvar haskell-literate-flag nil + "used to guide literate/illiterate behavior, set automagically") + +(defun haskell-newline-and-indent () + (interactive) + (setq haskell-literate-flag + (save-excursion + (beginning-of-line) + (= (following-char) ?>))) + (newline) + (if haskell-literate-flag (insert ">")) + (haskell-indent-line)) + +(defun haskell-indent-line () + "Indent current line of ordinary or literate Haskell code." + (interactive) + (let ((indent (haskell-calculate-indentation-pjt-2))) + (if (/= (current-indentation) indent) + (let ((beg (progn + (beginning-of-line) + (if (= (following-char) ?>) (forward-char 1)) ;LITERATE + (point)))) + (skip-chars-forward "\t ") + (delete-region beg (point)) + (indent-to indent)) + ;; If point is before indentation, move point to indentation + (if (< (current-column) (current-indentation)) + (skip-chars-forward "\t "))))) + +(defun haskell-calculate-indentation () + (save-excursion + (let ((col (current-column))) + (while (and (not (bobp)) ;skip over empty and comment-only lines + (= col (current-column))) + (previous-line 1) + (beginning-of-line) ; Go to first non whitespace + (if (= (following-char) ?>) ;LITERATE + (forward-char 1) + (if haskell-literate-flag ;ignore illiterate lines + (end-of-line))) + (skip-chars-forward "\t ") ; on the line. + (setq col (current-column)) + (search-forward-regexp (concat haskell-open-comment "\\|--\\|\n") nil 0) + (goto-char (match-beginning 0))) + (search-backward-regexp "\\b\\(where\\|let\\|of\\|in\\)\\b\\|\n" nil 0) + (if (looking-at "\n") + () + (setq col (current-column)) + (forward-word 1) + (skip-chars-forward "\t ") + (if (looking-at "\\w") + (setq col (current-column)) + (setq col (+ 2 col)))) + col))) + +(defun haskell-calculate-indentation-pjt-2 () + "Calculate indentation for Haskell program code, versatile version" + (save-excursion + (if (eq last-command 'haskell-indentation) + (setq haskell-indentation-counter (1+ haskell-indentation-counter)) + (setq haskell-indentation-counter -1)) + (setq this-command 'haskell-indentation) + (let* ((simple-indent (haskell-calculate-indentation)) + (count haskell-indentation-counter) + (min-indent simple-indent) ; minimum indentation found in a non-comment line + (last-indent simple-indent) ; indentation of the following non-comment line + (return-indent nil) ; computed indentation + (comment-depth 0)) + (previous-line 1) + (if (< haskell-indentation-counter 0) ; 1st tab gives simple indentation + (setq return-indent simple-indent)) + (while (not return-indent) + (if (search-backward-regexp "\\b\\(where\\|let\\|of\\)\\b\\|\n\\|{-\\|-}" nil t 1) + (cond + ((looking-at haskell-open-comment) + (setq comment-depth (1- comment-depth))) + ((looking-at haskell-close-comment) + (setq comment-depth (1+ comment-depth))) + ((= 0 comment-depth) + (cond + ((looking-at "\n") + (save-excursion + (forward-char 1) + (if (= (following-char) ?>) + (forward-char 1) + (if haskell-literate-flag + (end-of-line))) ;LITERATE: ignore lines w/o > + (skip-chars-forward "\t ") + (if (looking-at (concat haskell-open-comment "\\|--\\|\n")) + () + (setq last-indent (current-column)) + (if (< last-indent min-indent) + (setq min-indent last-indent))))) + (t ; looking at a keyword + (save-excursion + (forward-word 1) + (skip-chars-forward " \t") + (if (and haskell-literate-flag ;LITERATE: ignore lines w/o > + (save-excursion + (beginning-of-line) + (/= (following-char) ?>))) + (end-of-line)) + (if (looking-at (concat haskell-open-comment "\\|--\\|\n")) + () + (setq last-indent (current-column))) + (if (<= last-indent min-indent) + (if (> count 0) + (setq count (1- count)) + (setq return-indent last-indent))) + (if (< last-indent min-indent) + (setq min-indent last-indent))))))) + (setq return-indent simple-indent) + (setq haskell-indentation-counter -1))) + return-indent))) + +(defun haskell-skip-nested-comment () + ;; point looks at opening {-, move over closing -} + ;; todo: specify what happens on failure, bounds check ... + (forward-char 2) + (let ((comment-depth 1)) + (while (> comment-depth 0) + (search-forward-regexp "{-\\|-}") + (goto-char (match-beginning 0)) + (setq comment-depth + (if (= (following-char) 123) ; code for opening brace + (1+ comment-depth) + (1- comment-depth))) + (goto-char (match-end 0))))) + + +;;;seemingly obsolete functions +(defun haskell-inside-of-inline-comment () + (let ((bolp (save-excursion + (beginning-of-line) + (point)))) + (search-backward comment-start bolp t 1))) + +(defun haskell-inside-of-nested-comment () + (save-excursion + (let ((count 0)) + (while + (search-backward-regexp "\\({-\\|-}\\)" 0 t 1) + (if (haskell-inside-of-inline-comment) + () + (if (looking-at haskell-open-comment) + (setq count (1+ count)) + (setq count (1- count))))) + (> count 0)))) + +(defun haskell-inside-of-comment () + (or (haskell-inside-of-inline-comment) + (haskell-inside-of-nested-comment))) + +;;;stolen from sml-mode.el +(defun haskell-comment-indent () + "Compute indentation for Haskell comments" + (if (looking-at "^--") + 0 + (save-excursion + (skip-chars-backward " \t") + (max (1+ (current-column)) + comment-column)))) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; +;;; INFERIOR SHELL +;;; +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(defvar haskell-shell-map nil "The mode map for haskell-shell.") + +(defun haskell-shell () + "Inferior shell invoking Haskell. +It is not possible to have more than one shell running Haskell. +Like the shell mode with the additional command: + +\\[haskell-run-on-file]\t Runs haskell on the file. +\\{haskell-shell-map} +Variables controlling the mode: + +haskell-prog-name (default \"hbi\") + The string used to invoke the haskell program. + +haskell-use-right-delim (default \"\\\"\") +haskell-use-left-delim (default \"\\\"\") + The left and right delimiter used by your version of haskell, for + \"load file-name\". + +haskell-process-name (default \"Haskell\") + The name of the process running haskell. + +haskell-shell-prompt-pattern (default \"^> *\") + The prompt pattern. + +Runs haskell-shell-hook if not nil." + (interactive) + (if (not (process-status haskell-process-name)) + (save-excursion ; Process is not running + (message "Starting Haskell...") ; start up a new process + (require 'shell) + (set-buffer (make-comint haskell-process-name haskell-prog-name)) + (erase-buffer) ; Erase the buffer if a previous + (if haskell-shell-map ; process died in there + () + (setq haskell-shell-map (copy-keymap shell-mode-map)) + (define-key haskell-shell-map "\C-c\C-f" 'haskell-run-on-file)) + (use-local-map haskell-shell-map) + (make-local-variable 'shell-prompt-pattern) + (setq shell-prompt-pattern haskell-shell-prompt-pattern) + (setq major-mode 'haskell-shell) + (setq mode-name "Haskell Shell") + (setq mode-line-format + "-----Emacs: %17b %M %[(%m: %s)%]----%3p--%-") + (set-process-filter (get-process haskell-process-name) 'haskell-process-filter) + (message "Starting Haskell...done.") + (run-hooks 'haskell-shell-hook)))) + +(defun haskell-process-filter (proc str) + (let ((cur (current-buffer)) + (pop-up-windows t)) + (pop-to-buffer (concat "*" haskell-process-name "*")) + (goto-char (point-max)) + (if (string= str "\b\b\b \b\b\b") + (backward-delete-char 4) + (insert str)) + (set-marker (process-mark proc) (point-max)) + (pop-to-buffer cur))) + +(defun haskell-pop-to-shell () + (interactive) + (haskell-shell) + (pop-to-buffer (concat "*" haskell-process-name "*"))) + +(defun haskell-run-on-file (fil) + (interactive "FRun Haskell on : ") + (haskell-shell) + (save-some-buffers) + (process-send-string haskell-process-name + (concat "load " haskell-use-left-delim (expand-file-name fil) + haskell-use-right-delim ";\n"))) + +(defun haskell-save-buffer-use-file () + "Save the buffer, and send a `use file' to the inferior shell +running Haskell." + (interactive) + (let (file) + (if (setq file (buffer-file-name)) ; Is the buffer associated + (progn ; with file ? + (save-buffer) + (haskell-shell) + (process-send-string haskell-process-name + (concat "load " haskell-use-left-delim + (expand-file-name file) + haskell-use-right-delim ";\n"))) + (error "Buffer not associated with file.")))) + +(defvar haskell-tmp-files-list nil + "List of all temporary files created by haskell-simulate-send-region. +Each element in the list is a list with the format: + + (\"tmp-filename\" buffer start-line)") + +(defvar haskell-simulate-send-region-called-p nil + "Has haskell-simulate-send-region been called previously.") + +(defun haskell-make-temp-name (pre) + (concat (make-temp-name pre) ".m")) + +(defun haskell-simulate-send-region (point1 point2) + "Simulate send region. As send-region only can handle what ever the +system sets as the default, we have to make a temporary file. +Updates the list of temporary files (haskell-tmp-files-list)." + (let ((file (expand-file-name (haskell-make-temp-name haskell-tmp-template)))) + ;; Remove temporary files when we leave emacs + (if (not haskell-simulate-send-region-called-p) + (progn + (setq haskell-old-kill-emacs-hook kill-emacs-hook) + (setq kill-emacs-hook 'haskell-remove-tmp-files) + (setq haskell-simulate-send-region-called-p t))) + (save-excursion + (goto-char point1) + (setq haskell-tmp-files-list + (cons (list file + (current-buffer) + (save-excursion ; Calculate line no. + (beginning-of-line) + (1+ (count-lines 1 (point))))) + haskell-tmp-files-list))) + (write-region point1 point2 file nil 'dummy) + (haskell-shell) + (message "Using temporary file: %s" file) + (process-send-string + haskell-process-name + ;; string to send: load file; + (concat "load " haskell-use-left-delim file haskell-use-right-delim ";\n")))) + +(defun haskell-remove-tmp-files () + "Remove the temporary files, created by haskell-simulate-send-region, if +they still exist. Only files recorded in haskell-tmp-files-list are removed." + (message "Removing temporary files created by haskell-mode...") + (while haskell-tmp-files-list + (condition-case () + (delete-file (car (car haskell-tmp-files-list))) + (error ())) + (setq haskell-tmp-files-list (cdr haskell-tmp-files-list))) + (message "Removing temporary files created by haskell-mode...done.") + (run-hooks 'haskell-old-kill-emacs-hook)) + +(defun haskell-send-region () + "Send region." + (interactive) + (let (start end) + (save-excursion + (setq end (point)) + (exchange-point-and-mark) + (setq start (point))) + (haskell-simulate-send-region start end))) + +(defun haskell-send-buffer () + "Send the buffer." + (interactive) + (haskell-simulate-send-region (point-min) (point-max))) + +(defun haskell-evaluate-expression (h-expr) + "Prompt for and evaluate an expression" + (interactive "sExpression: ") + (let ((str (concat h-expr ";\n")) + (buf (current-buffer))) + (haskell-pop-to-shell) + (insert str) + (process-send-string haskell-process-name str) + (pop-to-buffer buf))) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; +;;; keywords for jwz's font-look-mode (lemacs 19) +;;; +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +(setq haskell-font-lock-keywords + (list (concat "\\b\\(" + (mapconcat 'identity + '("case" "class" "data" "default" "deriving" "else" "hiding" + "if" "import" "in" "infix" "infixl" "infixr" "instance" + "interface" "let" "module" "of" "renaming" "then" "to" + "type" "where") + "\\|") + "\\)\\b") + (list "^\\(#[ \t]*\\(if\\|ifdef\\|ifndef\\|else\\|endif\\|include\\)\\)") + (list "\\(^>?\\|\\bwhere\\b\\|\\blet\\b\\)[ \t]*\\(\\(\\w\\|\\s_\\)+\\)\\(\\([^=\n]*\\S.\\)?=\\(\\S.\\|$\\)\\|[ \t]*::\\S.\\).*$" + 2 'font-lock-function-name-face) + (list "\\b\\(data\\|type\\)\\b[ \t]+\\(\\(\\w\\|\\s_\\)+\\)" + 2 'font-lock-type-face) + (list (concat "'\\([^\\]\\|\\\\\\([0-9]+\\|" + (mapconcat 'identity + '("a" "b" "f" "n" "r" "t" "v" "\\\\" "\"" "'" "&") + "\\|") + "\\|\\^\\([][_^A-Z@\\\\]\\)" + "\\)\\)'") 1 'font-lock-string-face))) + +;;; font-lock-keywords for literate style files + +(setq haskell-font-lock-keywords-2 + (list (concat "^>.*\\b\\(" + (mapconcat 'identity + '("case" "class" "data" "default" "deriving" "else" "hiding" + "if" "import" "in" "infix" "infixl" "infixr" "instance" + "interface" "let" "module" "of" "renaming" "then" "to" + "type" "where") + "\\|") + "\\)\\b") + (list "^>\\(.*\\(\\bwhere\\b\\|\\blet\\b\\)\\|\\)[ \t]*\\(\\(\\w\\|\\s_\\)+\\)\\(\\([^=\n]*\\S.\\)?=\\(\\S.\\|$\\)\\|[ \t]*::\\S.\\).*$" + 3 'font-lock-function-name-face) + (list "^>.*\\b\\(data\\|type\\)\\b[ \t]+\\(\\(\\w\\|\\s_\\)+\\)" + 2 'font-lock-type-face) + (list (concat "^>.*'\\([^\\]\\|\\\\\\([0-9]+\\|" + (mapconcat 'identity + '("a" "b" "f" "n" "r" "t" "v" "\\\\" "\"" "'" "&") + "\\|") + "\\|\\^\\([][_^A-Z@\\\\]\\)" + "\\)\\)'") 1 'font-lock-string-face))) +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; +;;; END OF Haskell-MODE +;;; +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +(provide 'haskell-mode) diff --git a/ghc/CONTRIB/haskell-modes/glasgow/original/haskell-mode.el b/ghc/CONTRIB/haskell-modes/glasgow/original/haskell-mode.el new file mode 100644 index 0000000000..b9a490ffd1 --- /dev/null +++ b/ghc/CONTRIB/haskell-modes/glasgow/original/haskell-mode.el @@ -0,0 +1,1935 @@ +;; Haskell major mode +;; (c) Copyright, Richard McPhee et al. +;; University of Glasgow, February 1993 + + + +;; if .hs is not recognised then put the extension in auto-mode-list + +(if (assoc "\\.hs" auto-mode-alist) + nil + (nconc auto-mode-alist '(("\\.hs". haskell-mode)))) + +(if (assoc "\\.hi" auto-mode-alist) + nil + (nconc auto-mode-alist '(("\\.hi". haskell-mode)))) + +(if (assoc "\\.gs" auto-mode-alist) + nil + (nconc auto-mode-alist '(("\\.gs". haskell-mode)))) + +(defvar haskell-mode-syntax-table nil + "Syntax table for haskell-mode buffers.") + +(defvar haskell-mode-abbrev-table nil + "Abbrev table for haskell-mode buffers.") + +(defvar haskell-mode-map (make-sparse-keymap) + "Keymap for haskell-mode-buffers.") + + + +;;; Here are the keymaps used in haskell-mode + +(define-key haskell-mode-map "\M-;" 'haskell-insert-comment) +(define-key haskell-mode-map "\C-c=" 'haskell-insert-concat) +(define-key haskell-mode-map "\C-c;" 'set-haskell-comment-column) +(define-key haskell-mode-map "\C-c+" 'set-haskell-concat-column) +(define-key haskell-mode-map "\C-cn" 'set-haskell-indent-offset) +(define-key haskell-mode-map "\C-cl" 'set-haskell-list-offset) +(define-key haskell-mode-map "\C-ci" 'set-haskell-if-offset) +(define-key haskell-mode-map "\C-ce" 'set-haskell-let-offset) +(define-key haskell-mode-map "\C-cc" 'set-haskell-case-offset) +(define-key haskell-mode-map "\C-ct" 'set-haskell-then-offset) +(define-key haskell-mode-map "\C-co" 'set-haskell-comp-offset) +(define-key haskell-mode-map "\C-cw" 'set-haskell-where-offset) +(define-key haskell-mode-map "\C-cg" 'goto-line) +(define-key haskell-mode-map "\C-j" 'haskell-reindent-then-newline-and-indent) +(define-key haskell-mode-map "\t" 'haskell-indent-line) +(define-key haskell-mode-map "}" 'electric-haskell-brace) +(define-key haskell-mode-map "]" 'electric-haskell-brace) +(define-key haskell-mode-map ")" 'haskell-insert-round-paren) +(define-key haskell-mode-map "\C-cr" 'haskell-indent-region) +(define-key haskell-mode-map "\C-cf" 'haskell-further-indent) +(define-key haskell-mode-map "\C-cb" 'haskell-lesser-indent) +(define-key haskell-mode-map "\177" 'backward-delete-char-untabify) +(define-key haskell-mode-map "\M-\C-\177" 'delete-horizontal-space) + +(defun haskell-set-local-vars () + "Set the local variables for haskell-mode." + (kill-all-local-variables) + + (setq indent-line-function 'haskell-indent-line) + + (make-local-variable 'haskell-std-list-indent) + ;;Non-nil means indent to the offset, 'haskell-list-offset' in a bracket rather than + ;; moving to the next word afer a function name + (setq haskell-std-list-indent t) + + (make-local-variable 'haskell-nest-ifs) + ;;Non-nil means that 'if' statements are nested ie. lined up with `if' not `else'. + (setq haskell-nest-ifs nil) + + (make-local-variable 'haskell-align-else-with-then) + ;;Non-nil means align an `else' under it's corresponding `then' + (setq haskell-align-else-with-then nil) + + + ;;The local vars for 'where' indentation + + (make-local-variable 'haskell-align-where-with-eq) + ;;Non-nil means align a 'where' under it's corresponding equals sign + (setq haskell-align-where-with-eq t) + + (make-local-variable 'haskell-align-where-after-eq) + ;;Non-nil means align a 'where' after it's corresponding equals sign + (setq haskell-align-where-after-eq nil) + + (make-local-variable 'haskell-std-indent-where) + ;;put the 'where' the standard offset ie. 'haskell-indent-offset' + (setq haskell-std-indent-where nil) + + + (make-local-variable 'haskell-always-fixup-comment-space) + ;;Non-nil means always insert a (single) space after a comment, even + ;; if there is more or less than one. + (setq haskell-always-fixup-comment-space t) + + + (make-local-variable 'haskell-indent-offset) + ;;Extra indentation for a line continued after a keyword. + (setq haskell-indent-offset 4) + + (make-local-variable 'haskell-list-offset) + ;;Extra indentation for continuing a list. + (setq haskell-list-offset 4) + + (make-local-variable 'haskell-comp-offset) + ;;Extra indentation for a list comprehension. + (setq haskell-comp-offset 4) + + (make-local-variable 'haskell-case-offset) + (setq haskell-case-offset 4) + + (make-local-variable 'haskell-where-offset) + (setq haskell-where-offset 4) + + (make-local-variable 'haskell-let-offset) + (setq haskell-let-offset 4) + + (make-local-variable 'haskell-then-offset) + (setq haskell-then-offset 0) + + (make-local-variable 'haskell-if-offset) + (setq haskell-if-offset 4) + + (make-local-variable 'haskell-comment-column) + (setq haskell-comment-column 35) + + (make-local-variable 'haskell-concat-column) + (setq haskell-concat-column 69) + + (make-local-variable 'haskell-where-threshold) + (setq haskell-where-threshold 35) + + (make-local-variable 'line-comment) + (setq line-comment "-- ") + + (make-local-variable 'haskell-indent-style) + (setq haskell-indent-style "none")) + + +(defun haskell-set-syntax-table () + "Set the syntax table for Haskell-mode." + (setq haskell-mode-syntax-table (make-syntax-table)) + (set-syntax-table haskell-mode-syntax-table) + (modify-syntax-entry ?\" "\"") + (modify-syntax-entry ?\\ "\\") + (modify-syntax-entry ?\' "w") + (modify-syntax-entry ?_ "w") + (modify-syntax-entry ?# "_") + (modify-syntax-entry ?$ "_") + (modify-syntax-entry ?% "_") + (modify-syntax-entry ?: "_") + (modify-syntax-entry ?? "_") + (modify-syntax-entry ?@ "_") + (modify-syntax-entry ?! "_") + (modify-syntax-entry ?^ "_") + (modify-syntax-entry ?~ "_") + (modify-syntax-entry ?- "_ 12") + (modify-syntax-entry ?\n ">") + (modify-syntax-entry ?{ "(}") + (modify-syntax-entry ?} "){") + (set-syntax-table haskell-mode-syntax-table)) + + + +(defun haskell-mode () + "Major mode for editing Haskell code. +Linefeed reindents current line, takes newline and indents. +Tab indents current line for Haskell code. +Functions are seperated by blank lines. +Delete converts tabs to spaces as it moves back. +\\{haskell-mode-map} +Variables controlling indentation style: + haskell-indent-offset + Standard extra indentation for continuing Haskell + code under the scope of an expression. The default is 4. + + haskell-list-offset + Extra indentation for indenting in a list. Used if variable + haskell-std-list-indent is non-nil. The default is 4. + + haskell-comp-offset + Extra indentation for continuing a list comprehension. + The default is 4. + + haskell-case-offset + Standard extra indentation for continuing Haskell + code under the scope of an expression. The default is 4. + + haskell-where-offset + Standard extra indentation for continuing Haskell + code under the scope of a `where'. The default is 4. + + haskell-let-offset + Standard extra indentation for continuing Haskell + code under the scope of a `let'. The default is 4. + + haskell-then-offset + Standard extra indentation for a `then' beyond + its corresponding `if'. The default is 0. + + haskell-if-offset + Standard extra indentation for continuing Haskell + code under the scope of an `if'. The default is 4. + + haskell-comment-column + Column to which line comments `--' will be inserted. + The default is 35. + + haskell-concat-column + Column to which concatenation operator `++' will be inserted. + The default is 69. + + haskell-where-threshold + Column beyond which a `where' will be indented to the + start of a line (to avoid spilling over lines). + The default is 35. + + set-haskell-indent-offset (C-c i) + Changes the default value of the local variable, + haskell-indent-offset. May be a number from 0-10. + + set-haskell-list-indent (C-c l) + Change the value of the local variable, + haskell-list-offset. May be a number from 0-100. + + set-haskell-comment-column (C-x ;) + Changes the value of the local variable, + haskell-comment-column. May be any number from 0-100." + + (interactive) + (haskell-set-local-vars) + (haskell-set-syntax-table) + (use-local-map haskell-mode-map) + (setq major-mode 'haskell-mode) + (setq mode-name "Haskell") + (define-abbrev-table 'haskell-mode-abbrev-table ())) + + + + +;;; Returns the indentation column for a comment on this line. +;;; The point is positioned at the last char of any code on the line. + +(defun haskell-comment-indent () + "Returns the indentation for a comment on the given line. +If the line has code on it or the point is not at the beginning of the line, +then indent to indent-column. +Otherwise, don't indent." + (cond ((or (haskell-code-on-linep) + (not (bolp))) + ;;There is code before the haskell-comment-column + ;; or not at the beginning of the line + ;;Return the largest of + ;; the current column +1 and the haskell-comment-column + (max (1+ (current-column)) + haskell-comment-column)) + (t + ;;Otherwise, return 0 + 0))) + + + +;;; Returns whether a comment is on the current line +;;; Search from bol, and beware of "--", {-- etc! +;;; DOES NOT RECOGNISE {- COMMENTS YET or -- within a string + +(defun haskell-comment-on-linep () + "Returns the truth value of whether there is a '--' comment on the current line." + (save-excursion + (beginning-of-line) + (looking-at ".*--"))) + + +;;; This doesn't account for comments '{-'. Test explicitly if you use this function! + +(defun haskell-code-on-linep () + "Returns a truth value as to whether there is code on the current line." + (save-excursion + (beginning-of-line) + (not + ;; Code on line if not looking at a comment directly + ;; and the line is not blank + (or + (looking-at "^[ \t]*--") + (looking-at "^[ \t]*$"))))) + + +;;; Insert a Haskell "--" comment on the current line. +;;; Move to the comment position if there's already a comment here. +;;; Otherwise, the comment is inserted either at the comment column +;;; or one column after the last non-space character, whichever is further +;;; to the right. +;;; This function is executed by M-; + +(defun haskell-insert-comment () + "Inserts a '--' comment on the given line." + (interactive) + (cond ((haskell-comment-on-linep) + ;;There is a comment on the line + ;;Just reindent existing comment + (haskell-reindent-comment)) + (t + (if (haskell-code-on-linep) + ;;There is code on the line + ;; and guarenteed that a comment + ;; does not already exist. + ;;Move to the last nonspace char + ;; (there may be spaces after the last char) + (progn + (end-of-line) + (skip-chars-backward " \t"))) + ;;Indent to required level + ;; and insert the line comment '--' + (indent-to (haskell-comment-indent)) + (insert line-comment)))) + + +;;; Reindents a comment. +;;; The comment is indented according to the normal rules. +;;; Skips over ---- and following spaces or tabs + +(defun haskell-reindent-comment () + "Indents a comment on a line to keep it at haskell-comment-column, +if possible. +It is guaranteed that a comment exists on the current line." + (beginning-of-line) + ;;Go back to beginning of comment + (re-search-forward "--") + (forward-char -2) + ;;Delete all spaces and reindent to + ;; the correct location. + (delete-horizontal-space) + (indent-to (haskell-comment-indent)) + ;;Move past the comment and insert + ;; only one space between it and the text. + ;;Leave point just after comment. + (skip-chars-forward "- \t") + (if haskell-always-fixup-comment-space + (progn + (fixup-whitespace) + (forward-char 1)))) + + + +;;; Inserts a haskell concatenation operator, `++', at the +;;; column dictated by haskell-concat-column + +(defun haskell-insert-concat() + "Inserts a `++' operator on the given line." + (interactive) + (end-of-line) + (skip-chars-backward " \t") + ;;Indent to required level + ;; and insert the concat operator `++' + (indent-to (haskell-concat-indent)) + (insert "++")) + + + +;;; Returns the indentation column for a concatenation operator on this line. +;;; The point is positioned at the last char of any code on the line. + +(defun haskell-concat-indent () + "Returns the indentation for a concat operator on the given line." + (max (1+ (current-column)) + haskell-concat-column)) + + + +;;; Returns the indentation of the current line of haskell code. +;;; A blank line has ZERO indentation + +(defun haskell-current-indentation () + "Returns the indentation for the current haskell line. A blank line has +indentation zero." + (save-excursion + (beginning-of-line) + (if (looking-at "^[ \t]*$") + ;;The line is empty + ;; so the indentation is zero + 0 + ;;Otherwise find the normal value of indentation + (current-indentation)))) + + + +;;; Returns the indentation of the previous line of haskell code. +;;; A blank line has ZERO indentation + +(defun haskell-previous-indentation () + "Returns the previous line's indentation as Haskell indentation." + (save-excursion + (if (not (bobp)) + ;;Not at the start of the buffer + ;; so get the previous lines indentation + (progn + (forward-line -1) + (haskell-current-indentation)) + ;;We are at the start of buffer + ;;There is no previous line; Indent is zero + 0))) + + + +;;; Move back to the last line which is aligned in the left column. +;;; Ignores comments and blank lines. +;;; The point is left at the beginning of the line. + +(defun haskell-back-to-zero-indent () + "Moves point to last line which has zero as indentation." + ;;Not at the beginning of buffer. + ;;Continue to go to the previous line until + ;; we find a line whose indentation is non-zero. + ;;Blank lines and lines containing only comments + ;; are ignored. + (beginning-of-line) + (while (and + (or (not (zerop (haskell-current-indentation))) + (looking-at "^[ \t]*\\($\\|--\\)")) + (not (bobp))) + (haskell-backward-to-noncomment) + (beginning-of-line))) + + + +;;; Find the last symbol, usually an equality. + +;;; Note: we check for "=" as a complete WORD (and ignore +;;; comments) when searching for this. Ie. an `=' may be +;;; surrounded only by a letter, digit, or whitespace . +;;; Strings are not considered. +;;; Don't go beyond the first character in the (possibly narrowed) buffer. +;;; From the beginning of the line, +;;; find the comment position (or end-of-line) +;;; search forward to this position, looking for a "where" +;;; If one's found, then search forward for "\b=\b" +;;; If there's no equality sign then +;;; search forward from the start of the line for an equals +;;; Otherwise we found it. +;;; If there's no where then search forward for an equals, as above. + +(defun haskell-back-to-symbol (exp) + "Goes backward from point until a symbol, EXP, is found. +The point is left at the first symbol matching the context +of the haskell code." + (let* ((found nil) + (symbol (concat "[ \ta-z0-9A-Z]" exp "[ \t\na-z0-9A-Z]")) + eol-limit + bol-limit + (zero-indent (save-excursion + (haskell-back-to-zero-indent) + (point))) + (initial-depth (car (parse-partial-sexp + (point) + zero-indent)))) + + (while (and (not found) + (> (point) zero-indent)) + ;;Not found and point > point min + ;;Record the limit of search for the beginning and + ;; end of the line. + (setq eol-limit (point)) + (beginning-of-line) + (setq bol-limit (point)) + (goto-char eol-limit) + (re-search-backward "\\bwhere\\b" bol-limit 't) + ;;Search back from the end of the line + ;; to find the most recent 'where'. + + (cond ((and (re-search-backward symbol bol-limit 't) + (= initial-depth + (car (parse-partial-sexp + (point) + zero-indent)))) + ;;Found a symbol sign surrounded by + ;; a letter, digit or space only, or at the + ;; beginning of the buffer and they are at + ;; the same depth level + (setq found 't)) + ((and (re-search-backward symbol bol-limit 't) + (zerop + (car (parse-partial-sexp + (point) + zero-indent)))) + ;; Found a symbol and it is not in any parens + (setq found 't)) + ;;Otherwise, go back a line. + (t (haskell-backward-to-noncomment)))) + (if found + (forward-char 1)))) + + +;;; Goes back to the last keyword. The point is left at the +;;; beginning of the keyword. +;;; The words recognised are: +;;; `case',`of',`where',`let',`in',`if',`then',`else' + +(defun haskell-back-to-keyword () + "Goes backward from point until a keyword is found. +The point is left after the first keyword." + (let* ((found nil) + eol-limit + bol-limit + (zero-indent (save-excursion + (haskell-back-to-zero-indent) + (point))) + (initial-depth (car (parse-partial-sexp + (point) + zero-indent)))) + + (while (and (not found) + (>= (point) zero-indent)) + ;;Not found and point > point min + ;;Go back past any comment. + ;;Record the limit of search for the beginning and + ;; end of the line. + (setq eol-limit (point)) + (beginning-of-line) + (setq bol-limit (point)) + (goto-char eol-limit) + (if (and (re-search-backward + "\\b\\(case\\|of\\|where\\|let\\|in\\|if\\|then\\|else\\)\\b" + bol-limit 't) + (= initial-depth + (car (parse-partial-sexp + (point) + zero-indent)))) + ;;Found a keyword and it is at the same level as the initial position + (progn + (setq found 't) + (forward-word 1)) + ;;Otherwise, go back a line. + (haskell-backward-to-noncomment))))) + + + +;;; Returns the end of line (point) of the current line, excluding any +;;; line comments on it. + +(defun haskell-eol () + "Returns the end (point) of the current line, excluding any line comments." + (save-excursion + (end-of-line) + (let ((eol-limit (point))) + (beginning-of-line) + (if (search-forward "--" eol-limit 'move-to-eol) + ;;Found a '--' + ;;So move to the beginning of the comment + ;;If fail then move to end of line + (forward-char -2))) + (point))) + + + +;;; Returns whether or not the current line contains an equality outwith a +;;; comment. The equality may only be surrounded by a letter, digit or +;;; whitespace. + +(defun haskell-looking-at-eqp () + "Returns whether or not the current line contains an equality outwith a +comment." + (save-excursion + (beginning-of-line) + (re-search-forward "[ \ta-z0-9A-Z]=[ \t\na-z0-9A-Z]" (1+ (haskell-eol)) 't))) + + +;;; This function does not require all keywords, just those which +;;; may have a bracket before them. +(defun haskell-looking-at-keywordp () + "Returns whether or not there is a keyword after the point outwith a +comment." + (save-excursion + (re-search-forward + "\\(\\(=>\\|=\\|++\\|->\\|<-\\|::\\)\\|\\b\\(case\\|of\\|if\\|then\\|else\\|let\\|in\\)\\b\\)" + (haskell-eol) 't))) + + +;;; This function returns whether or not there is a keyword contained in +;;; the region START END. START < END. + +(defun haskell-keyword-in-regionp (start end) + "Returns whether or not there is a keyword between START and END." + (save-excursion + (goto-char start) + (let ((found nil) + (eol-limit (haskell-eol))) + (while (and (not found) (< (point) end)) + (if (> eol-limit end) + (setq eol-limit end)) + (if (re-search-forward + "\\b\\(case\\|of\\|if\\|then\\|else\\|let\\|in\\)\\b" + eol-limit 'move) + (setq found t) + ;;Otherwise, have not found a keyword. Now at haskell-eol. + (if (< (point) end) + ;;We still have an area to search + ;; so go forward one line + (progn + (beginning-of-line) + (forward-line 1) + (setq eol-limit (haskell-eol)))))) + ;;found is `t' or point >= end + found))) + + +;;; Goes back to the last line which is not entirely commented out. +;;; The point is left just before the comment. + +(defun haskell-backward-to-noncomment () + "Sets the point to the last char on the line of Haskell code before a comment." + (let ((comment 't) + (limit (point-min))) + (while (and comment (> (point) limit)) + ;; comment is true and point > limit + (beginning-of-line) + (if (< (forward-line -1) 0) + ;;This was the first line in the buffer + (setq comment nil) + ;;Otherwise, this was not the first line + (if (not (looking-at "^[ \t]*\\($\\|--\\)")) + ;;There is not a comment at the beginning of the line + ;; and the line is not blank + (progn + ;;The line is either blank or has code on it. + (setq comment nil) + (goto-char (haskell-eol)))))) + + ;;return point + (point))) + + + +;;; Indents a region (by applying "tab" to each line). +;;; The marker upper-marker is set to the end of the region. +;;; We indent from the beginning of the region to this marker. +;;; Implements C-c r. + +(defun haskell-indent-region () + "Indents the region between the point and mark." + (interactive) + (let ((lower-limit (min (point) (mark))) + (upper-limit (max (point) (mark)))) + (indent-region lower-limit upper-limit 'nil))) + + + +;;; Implements TAB. +;;; This actually indents a line. +;;; Eventually it will handle a line split at any point, + +(defun haskell-indent-line () + "Indent current line as Haskell code. +Keeps the point at the same position on the line unless the +point is less then the current indentation, in which case the +point is moved to the first char." + (interactive) + (save-excursion + (let ((indent (haskell-calculate-indentation))) + (beginning-of-line) + (delete-horizontal-space) + ;;Kill any spaces that may preceed the code + ;; and reindent to the correct level. + (indent-to indent))) + (if (< (current-column) (current-indentation)) + ;;The point is in the indentation + ;; so move to the first char on the line + (move-to-column (current-indentation)))) + + + +;;; This is the haskell version of the Emacs function +;;; reindent-then-newline-and-indent. It was necessary +;;; to write this because the Emacs version has the +;;; terrible property of deleting whitespace BEFORE +;;; reindenting the original line. + +(defun haskell-reindent-then-newline-and-indent () + "Reidents the current line of Haskell code then takes a +newline and indents this new line." + (interactive) + (skip-chars-backward " \t") + (haskell-indent-line) + (newline) + (delete-horizontal-space) + (haskell-indent-line)) + + + +;;; Returns whether the first word of the last line with zero indentation +;;; is the same as the first word of the current line. +;;; This function is based on the (reasonable?) assumption that +;;; a function definition occurs on the left hand margin. +;;; This is not quit reasonable since recusive functions are not +;;; recognised. + +(defun haskell-continued-fn-defp () + "Returns whether the first word on the last line with zero indentation +matches the first word on the current line." + (save-excursion + (beginning-of-line) + (skip-chars-forward " \t") + ;;Goto the first non space char + (haskell-word-eq (point) + (save-excursion + (forward-line -1) + (haskell-back-to-zero-indent) + (point))))) + + +;;; Returns whether two words are the same. +;;; The beginning of both words are given as their +;;; respective points in the buffer. + +(defun haskell-word-eq (current-pos previous-pos) + (let ((OK 't)) + (goto-char previous-pos) + ;;We shall compare the two words starting + ;; at previous-pos and current-pos. + (while (and OK (looking-at "\\S-")) + ;;OK and looking at a word constituent + (if (eq (char-after current-pos) + (char-after previous-pos)) + ;;The two chars are the same + (progn + ;;Increment the two postions + ;; and update location of point + (setq current-pos (1+ current-pos)) + (setq previous-pos (1+ previous-pos)) + (goto-char previous-pos)) + ;;The two chars are different + ;; so set OK to be false + (setq OK 'nil))) + + ;;Return the value of OK + OK)) + + + + +;;; This function returns the column of the last unbalanced +;;; expression. +;;; It is called when an keyword is found. The point is +;;; initially placed before the corresponding keyword. +;;; The function looks at every word to see if it is a +;;; `let' or `in'. Each word must be outwith a comment. + +(defun haskell-last-unbalanced-key-column (open close) + "Returns the column of the last unbalanced keyword, open." + (save-excursion + (let ((original-pos (point)) + (bol-limit (save-excursion + (beginning-of-line) + (setq bol-limit (point)))) + (depth 1)) + (setq open (concat "\\b" open "\\b")) + (setq close (concat "\\b" close "\\b")) + (while (and + (> depth 0) + (> (point) (point-min))) + (forward-word -1) + (if (< (point) bol-limit) + ;;Moved past the beginning of line limit + ;; so go back to the previous line past + ;; any comments. + (progn + (goto-char original-pos) + (haskell-backward-to-noncomment) + (setq original-pos (point)) + (setq bol-limit (save-excursion + (beginning-of-line) + (point)))) + ;;Otherwise, still on the same line + (if (looking-at open) + ;;This word is an open keyword + (setq depth (1- depth)) + ;;Otherwise, + (if (looking-at close) + ;;This word is a close keyword + (setq depth (1+ depth)))))) + + (if (string= open "\\bif\\b") + ;;The argument is `if' + (if (not (save-excursion (skip-chars-backward " \t") (bolp))) + ;;There is something before the `if' + (if (and (save-excursion + (forward-word -1) + (looking-at "\\belse\\b")) + (not haskell-nest-ifs)) + ;;There is an `else' before the 'if' + (forward-word -1)))) + + + (current-column)))) + + + +;;; Return the indentation for a line given that we expect a `where'. +;;; The point lies on the corresponding symbol +;;; that the `where' scopes over. + +(defun haskell-indent-where () + "Return the indentation for a line, given that we expect a `where' +clause." + (let ((symbol (if (looking-at "=") + "=" + "->"))) + + (cond ((or haskell-std-indent-where + (> (current-column) haskell-where-threshold)) + ;;Set indentation as the sum of the previous + ;; line's layout column and the standard offset + ;; (ie. 'haskell-where-offset) + (save-excursion + (beginning-of-line) + (cond ((looking-at (concat "^[ \t]*" symbol)) + ;;The line starts with the symbol + (setq indent (current-indentation))) + ((looking-at "^[ \t]*where\\b") + ;;The line starts with a 'where' + (forward-word 1) + (skip-chars-forward " \t") + (setq indent (+ (current-column) haskell-where-offset))) + (t + ;;The line begins on the layout column + (setq indent (+ (current-indentation) + haskell-indent-offset)))))) + ((or haskell-align-where-with-eq + haskell-align-where-after-eq) + (if (looking-at (concat symbol "[ \t]*$")) + ;;The symbol is at the end of the line + (setq indent (+ (current-indentation) + haskell-where-offset)) + (save-excursion + ;;Set the indentation as required + (if haskell-align-where-after-eq + (skip-chars-forward (concat symbol " \t"))) + (setq indent (current-column)))))))) + + + +;;; Calculates the indentation for the current line. +;;; When we come here, we are in a line which we want to indent. +;;; We should leave the point at the same relative position it +;;; was in before we called the function, that is, if a line +;;; is already correctly indented, nothing happens! + +;;; The main problems are handling "where" definitions +;;; and the syntax of expressions when these are continued +;;; over multiple lines (e.g. tuples, lists, or just plain +;;; bracketed expressions). Watch out for let ... in, too! + +;;; For example, think about the following tricky cases: + +;;; f x = x + <NL> + +;;; f x = [ x + y, <NL> + +;;; f x = [ <NL> + +;;; f x = [ -- start of a large list +;;; -- which I'm commenting in as I go +;;; <TAB> + +(defun haskell-calculate-indentation () + "Returns the indentation level for the current line of haskell code." + (save-excursion + (let ((indent 0) + (eol-position (point))) + (beginning-of-line) + (cond ((bobp) + ;;We are at the beginning of the buffer so do nothing at all + (setq indent 0)) + + ((looking-at "^[ \t]*--") + ;;There is a comment on the line by itself + ;;Leave it the way it is + (setq indent (current-indentation))) + + ((looking-at "^[ \t]*\\(data\\|type\\|module\\|import\\|instance\\)\\b") + ;;There is a 'data', 'type', 'module' or 'import' at start of line + (setq indent 0)) + + ((haskell-continued-fn-defp) + ;;This is clearly same function + ;; so set indent to be 0 + (setq indent 0)) + + ((looking-at "^[ \t]*[]}]") + ;;There is a "]" or "}" at the start of the line + (let ((state (parse-partial-sexp (match-end 0) + (save-excursion + (haskell-back-to-zero-indent) + (point))))) + (if (>= (car state) 0) + ;;Since the point is just after a parenthesis + ;; it has a match if the depth is >= 0 + (save-excursion + (goto-char (nth 2 state)) + ;;Move to the match. + (if (not + (save-excursion + (skip-chars-backward " \t") + (bolp))) + ;;There is something before the brace. + (progn + (let ((initial-pos (point))) + (forward-word -1) + (if (not (looking-at + "\\(let\\|where\\)")) + ;;The word is not `where' or `let' + ;; so go back. + (progn + (goto-char initial-pos) + (skip-chars-forward " \t")))))) + (setq indent (current-column))) + (setq indent 0)))) + + ((looking-at "^[ \t]*\\(->\\|=>\\)") + ;; '->' or '=>' at start of line + (save-excursion + (haskell-backward-to-noncomment) + ;;Go back to previous line + (let ((eol-limit (point))) + (beginning-of-line) + (if (re-search-forward "::" eol-limit 't) + ;;There is a '::' on this (previous) line + ;; set indent to be at the start of it + (setq indent (- (current-column) 2)) + ;;Otherwise copy this (previous) line's indentation + (setq indent (current-indentation)))))) + + ((looking-at "^[ \t]*where\\b") + ;;There is a 'where' at the start of the line + ;;Look for the equality (which will not + ;; be on this line). + (haskell-backward-to-noncomment) + (goto-char (max (save-excursion + (haskell-back-to-symbol "=") + (point)) + (save-excursion + (haskell-back-to-symbol "->") + (point)))) + (setq indent (haskell-indent-where))) + + ((looking-at "^[ \t]*then\\b") + ;;The first thing on the line is a `then' + (setq indent (+ (haskell-last-unbalanced-key-column "if" "then") + haskell-then-offset))) + + ((looking-at "^[ \t]*else\\b") + ;;The first thing on the line is a `else' + (if haskell-align-else-with-then + (setq indent (haskell-last-unbalanced-key-column "then" "else")) + (setq indent (haskell-last-unbalanced-key-column "if" "else")))) + + ((looking-at "^[ \t]*|") + ;;There is a `|' at beginning of line + (save-excursion + (let ((state + (parse-partial-sexp (save-excursion + (haskell-back-to-zero-indent) + (point)) + (point)))) + (if (not (or (nth 3 state) (nth 4 state))) + ;;Not in a comment or string + (if (> (car state) 0) + ;;In an unbalanced parenthesis. + (progn + (goto-char (nth 1 state)) + ;;Move to the beginning of the unbalanced parentheses + (if (and (looking-at "\\[") + (search-forward "|" (haskell-eol) 't)) + ;;It is a list comprehension + (setq indent (1- (current-column))) + (setq indent (+ (current-column) + haskell-comp-offset)))) + ;;Otherwise, not in an unbalanced parenthesis + (setq indent (save-excursion + (haskell-back-to-symbol "=") + (cond ((not (looking-at "=")) + ;;Did not find an equals + (+ (haskell-previous-indentation) + haskell-indent-offset)) + ((save-excursion + (beginning-of-line) + (looking-at "^[ \t]*data\\b")) + ;;There is a `data' at beginning + (setq indent (current-column))) + ((save-excursion + (beginning-of-line) + (search-forward + "|" (haskell-eol) 't)) + ;;There is a `|' on this line + ;; so set this to be the indent + (save-excursion + (goto-char (match-beginning 0)) + (current-column))) + (t + ;;Otherwise, set `=' as indent + (current-column)))))))))) + + ((looking-at "^[ \t]*=") + ;;There is an equals at the start of the line + ;;Set the indentation to be the previous line's + ;; indentation plus the standard offset + (setq indent (+ haskell-indent-offset + (haskell-previous-indentation)))) + + ((looking-at "^[ \t]*in\\b") + ;;The line starts with 'in' + (beginning-of-line) + (setq indent (haskell-last-unbalanced-key-column "let" "in"))) + + ((looking-at "^[ \t]*of\\b") + ;;The line starts with `of' + (beginning-of-line) + (setq indent (haskell-last-unbalanced-key-column "case" "of"))) + + ((looking-at "^.*::") + ;;There is a '::' in the line + ;;There are several possibilities for indentation + (if (looking-at "[ \t]*::") + ;;The '::' is the first thing on the line + ;; so set indent to be the previous line's + ;; indentation plus the standard offset + (setq indent (+ (haskell-previous-indentation) + haskell-indent-offset)) + (save-excursion + ;;Otherwise, the '::' is contained in the line somewhere + ;; so use contextual indentation + (setq indent (haskell-context-indent))))) + + (t + ;;Do not recognise the first word on the line. + (setq indent (haskell-context-indent)))) + + indent))) ;return indent as indentation value + + + +;;; Returns the indentation for the current line by looking at the +;;; previous line to give clues to the indentation. + +(defun haskell-context-indent () + "Returns the indentation for the current line by looking at +the previous line to dictate the indentation." + (save-excursion + (let ((original-position (point)) + indent) + (beginning-of-line) + (if (bobp) + ;;At the beginning of the buffer + (setq indent 0) + ;;Otherwise, we are not at the beginning of the buffer + (haskell-backward-to-noncomment) + (let ((eol-limit (point)) + ;;Record the (upper) limit for any search on this line + bol-limit + (paren-indent 'nil)) + ;;`paren-indent' flags whether we are indenting a list or not + (beginning-of-line) + (setq bol-limit (point)) + ;;Record the (lower) limit for any search on this line + (goto-char eol-limit) ;goto the end of the line + (flag) + (if (save-excursion + (goto-char eol-limit) + (and (re-search-backward + "[])][^][()]*" bol-limit 't) + (save-excursion + (goto-char (match-beginning 0)) + (not (haskell-looking-at-keywordp))))) + + ;;There is a close parenthesis at the end of the line + ;; followed by anything except "(", ")", "[", "]" + ;; or a keyword + (progn + ;;Search back for the close parenthesis + ;; and move to just after it. + (re-search-backward "[])]" bol-limit 't) + (forward-char 1) + (let ((state + (parse-partial-sexp (save-excursion + (haskell-back-to-zero-indent) + (point)) + (point)))) + (if (not (or (nth 3 state) (nth 4 state))) + ;;Not in a comment or string + (if (>= (car state) 0) + ;;The parenthesis has a match + (progn + (goto-char (nth 2 state)) + ;;Move to the beginning of the parentheses + ;; as this new line will determine + ;; further indentation + (if (zerop (car state)) + ;;This paren closes all unbalanced parens + ;; so move to + ;; the eol of last line with an equality. + (progn + (setq eol-limit (point)) + (goto-char + (max (save-excursion + (haskell-back-to-symbol "=") + (point)) + (save-excursion + (haskell-back-to-keyword) + (point)))) + (goto-char eol-limit)) + ;;esle just go to the end of the line + (goto-char (haskell-eol))) + (setq paren-indent 't) + ;;Set 'paren-indent' to true to indicate we + ;; are indenting a list. + (setq eol-limit (point)) + (beginning-of-line) + (setq bol-limit (point)) + ;;Reduce the scope of any later + ;; indentation to + ;; exclude the balanced parentheses + ;; by making this point + ;; be the eol-limit. + (goto-char eol-limit))))))) + (flag) + ;;This cond expression is structured, to an + ;; extent, such that the keywords with highest + ;; indentation precedence come first. Order is important. + ;;In each condition, the point of match is noted so + ;; that we can see if this point is in a string. + (let ((indent-point (point))) + (cond ((re-search-backward "\\bof\\b" bol-limit 't) + ;; `of' is contained in previous line + (setq indent-point (point)) + (if (looking-at "of[ \t]*$") + ;;`of' at end of line + (setq indent (+ (haskell-last-unbalanced-key-column + "case" "of") + haskell-case-offset)) + ;;Otherwise, `of' is in line + (forward-word 1) + (skip-chars-forward " \t") + (setq indent (current-column)) + (setq indent (list indent)))) + + ((re-search-backward + "\\bthen[ \t]*$" bol-limit 't) + ;;There is a `then' at the end of the line. + (setq indent-point (point)) + (if haskell-align-else-with-then + ;;We want to align the `else' (to follow) with the `then' + (setq indent (+ (current-column) + haskell-if-offset)) + (setq indent (+ (haskell-last-unbalanced-key-column + "if" "then") + haskell-if-offset)))) + ;; This was here but don't know why (setq indent (list indent)))) + + ((save-excursion + (and (re-search-backward "\\bif\\b" bol-limit 't) + (setq indent-point (point)) + (not (re-search-forward "\\bthen\\b" eol-limit 't)))) + ;;There is an `if' on the (previous) line and the line does + ;; not have a `then' on it. + (setq indent (+ (haskell-last-unbalanced-key-column + "if" "then") + haskell-then-offset))) + + ((save-excursion + (and (re-search-backward "\\bif\\b" bol-limit 't) + (setq indent-point (point)) + (not (re-search-forward "\\belse\\b" eol-limit 't)))) + ;;There is an `if' on the (previous) line (the line may + ;; have a `then' on it) and does not have an else on it. + (if (re-search-backward "\\bthen\\b" bol-limit 't) + ;;There is a then on the line and it is followed by + ;; some code. + (progn + (forward-word 1) + (skip-chars-forward " \t") + (setq indent (current-column))) + (if haskell-align-else-with-then + ;;We want to align the `else' with the `then' + (setq indent (haskell-last-unbalanced-key-column + "then" "else")) + (setq indent (haskell-last-unbalanced-key-column + "if" "else"))))) + + ((re-search-backward "\\b\\(let\\|in\\)\\b" bol-limit 't) + ;; 'let' or 'in' is contained in the (previous) line + (setq indent-point (point)) + (forward-word 1) ;skip past the word + (skip-chars-forward " \t{") + (if (looking-at "\\($\\|--\\)") + ;;looking-at eol or comment + (progn + (forward-word -1) + (setq indent (+ (current-column) + haskell-let-offset))) + (setq indent (current-column)))) + + ((re-search-backward + "\\belse[ \t]*$" bol-limit 't) + ;;There is a `else' at end of line + (setq indent-point (point)) + (save-excursion + (goto-char eol-limit) + (forward-word -1) + (setq indent (+ (current-column) + haskell-if-offset)))) + + ((re-search-backward + "\\belse\\b" bol-limit 't) + ;;There is a `else' on the line with no if or then + (setq indent-point (point)) + (save-excursion + (forward-word 1) + (skip-chars-forward " \t") + (setq indent (current-column)))) + + ((save-excursion + (beginning-of-line) + (looking-at + "^[ \t]*then\\b")) + ;;There is a 'then' at beginning of line + (setq indent-point (point)) + (setq indent (current-indentation))) + + ((save-excursion + (beginning-of-line) + (looking-at "^[ \t]*else[ \t]*if\\b")) + (setq indent-point (point)) + ;;There is an 'else if' at start of (previous) line + (save-excursion + (beginning-of-line) + (if haskell-nest-ifs + (save-excursion + (forward-word 1) + (skip-chars-forward " \t") + (setq indent (current-column))) + (skip-chars-forward " \t") + (setq indent (current-column))))) + + ((re-search-backward "\\bcase\\b" bol-limit 't) + ;;There is a 'case' on the previous line + ;; so copy this line's indentation and add on + ;; the offset unless there is not an of. + (setq indent-point (point)) + (setq indent (+ (current-column) + haskell-case-offset))) + + ((save-excursion + (beginning-of-line) + (looking-at "^\\(instance\\|class\\)\\b")) + ;;This (previous) line has an 'instance' or 'class' at start + ;; so just set indentation to be this line indentation + ;; plus the standard offset + (setq indent-point (point)) + (setq indent (+ (current-indentation) + haskell-indent-offset))) + + ((re-search-backward "where\\b" bol-limit 't) + ;;There is a 'where' on the (previous) line + (setq indent-point (point)) + (if (looking-at "where[ \t]*$") + ;;There is nothing after the 'where' + ;; so set indent to be this column + ;; (ie. the column of the 'w') + ;; plus the standard offset + (if (save-excursion + (skip-chars-backward " \t") + (bolp)) + ;;The 'where' is the only thing on the line. + (setq indent (+ (current-column) + haskell-where-offset)) + ;;Otherwise, the 'where' is at the end + ;; of the line and there is code before it. + ;;Look before the 'where' for the symbol + ;; it scopes over. + (forward-word -1) + (goto-char (max (save-excursion + (haskell-back-to-symbol "=") + (point)) + (save-excursion + (haskell-back-to-symbol "->") + (point)))) + (setq indent (haskell-indent-where))) + + ;;Otherwise, go past the 'where' + ;; and goto the last non space character. + ;;Set this column to be the indentation. + (forward-word 1) + (skip-chars-forward " \t") + (setq indent (current-column)))) + + ((re-search-backward + "[ \ta-z0-9A-Z]=[ \t]*$" bol-limit 't) + ;;There is an equals is at the end of line + ;; so make the indentation be this line's indentation + ;; plus the standard offset + (setq indent-point (point)) + (setq indent (+ (current-indentation) + haskell-indent-offset))) + + ((re-search-backward + "[ \ta-z0-9A-Z]\\+\\+[ \t]*$" bol-limit 't) + ;;There is a concat operator at the end of line + ;; so make the indentation be this line's indentation + (setq indent-point (point)) + (setq indent (current-indentation))) + + ((save-excursion + (beginning-of-line) + (looking-at + "^[ \t]*=[ \ta-z0-9A-Z]")) + ;;There is an equals is at the beginning of line + ;; so make the indentation be the previous line's + ;; indentation unless the previous line's + ;; indentation is zero. + (setq indent-point (point)) + (save-excursion + (haskell-backward-to-noncomment) + (if (zerop (current-indentation)) + (setq indent (+ (current-indentation) + haskell-indent-offset)) + (setq indent (haskell-current-indentation))))) + + ((re-search-backward "|" bol-limit 't) + ;;There is an `|' on this line. + (setq indent-point (point)) + (if (save-excursion + (goto-char original-position) + (looking-at "^[ \t]*\\($\\|--\\||\\)")) + ;;The original line is empty or has a `|' at the + ;; start. So set indent to be first `|' on this line + (save-excursion + (goto-char bol-limit) + (re-search-forward "|" eol-limit 't) + (setq indent (1- (current-column)))) + ;;Otherwise set indent to be this (previous) line's + (setq indent 0))) + + ((re-search-backward "->" bol-limit 't) + ;;There is a `->' in the line. + ;;This may be from a `case' or a + ;; type declaration. + (setq indent-point (point)) + (save-excursion + (if (re-search-backward "::" bol-limit 't) + ;;There is a '::' on this line + (if (looking-at ".*->[ \t]*$") + ;;The '->' is at the end of line. + ;;Move past the '::' and any spaces + ;; and set indent to be this column. + (progn + (skip-chars-forward ": \t") + (setq indent (current-column))) + ;;Otherwise, the '->' is not at end of line + ;; so copy the indentation + (setq indent (haskell-context-indent))) + + ;;Otherwise, there is not a + ;; `::' on this line so copy this + ;; (previous) indentation. + (setq indent (haskell-context-indent))))) + + ((re-search-backward "::" bol-limit 't) + ;;There is an '::' on this line. + ;;We know that the line does not end with '->'. + (setq indent-point (point)) + (if (looking-at "::[ \t]*$") + ;;The '::' is at the end of the line + ;; so set indent to be this line's + ;; indentation plus the offset. + (setq indent (+ (current-indentation) + haskell-indent-offset)) + ;;Otherwise the `::' is in the line + (setq indent (current-indentation)))) + + ((re-search-backward + "\\b\\(import\\|class\\)\\b" + bol-limit 't) + ;;There is an `import' or `class' on the line. + ;;Copy this indentation. + (setq indent-point (point)) + (setq indent (current-indentation))) + + ((or + (haskell-looking-at-eqp) + (save-excursion + (beginning-of-line) + (looking-at "^[ \t]*$"))) + ;;There is an '=' on the line + ;; or it is blank + (setq indent-point (point)) + (cond ((save-excursion + (beginning-of-line) + (looking-at "^[ \t]*data\\b")) + ;;`data' at start of line + ;; so expect a `|' + (haskell-back-to-symbol "=") + (setq indent (current-column))) + ((zerop (current-indentation)) + ;;If the indentation is zero, we expect a `where' + (goto-char eol-limit) + (haskell-back-to-symbol "=") + (setq indent (haskell-indent-where))) + ((looking-at "^[ \t]*=[ \t\na-z0-9A-Z]") + ;;The equality is the first thing on the line + ;; so copy the last lines indentation + (save-excursion + (haskell-backward-to-noncomment) + (setq indent (current-indentation)))) + (t + ;;Otherwise, copy the indentation + (setq indent (current-indentation))))) + + ((save-excursion + (beginning-of-line) + (and (zerop (current-indentation)) + (not (looking-at "^[ \t]*$")))) + ;;The line is not blank and its indentation is zero + ;;It is a function definition. We know that + ;; there is not an equals on the line + (goto-char eol-limit) + ;;We expect a keyword + ;; so set indent to be this line's indentation + ;; plus the offset + (setq indent-point (point)) + (setq indent (+ (current-indentation) + haskell-indent-offset))) + + ((bobp) + ;;At the beginning of buffer + (setq indent 0)) + + (paren-indent + ;;We are indenting a list and none + ;; of the above indentations are applicable + ;; so copy the indentation of this line + (setq indent (current-indentation))) + + (t + (save-excursion + (setq indent (haskell-context-indent))))) + + (if (nth 3 (parse-partial-sexp + (save-excursion + (goto-char indent-point) + (haskell-back-to-zero-indent) + (point)) + (save-excursion + (goto-char indent-point)))) + ;;The point we determined indentation at is in a + ;; string so go to this point and go back one line to + ;; find indentation. + (setq indent (haskell-context-indent)))) + + + ;;HOWEVER, we may have to override any indentation if we are in + ;; an unbalanced parenthesis (on the original line). + (flag) + (save-excursion + (goto-char original-position) + (let* ((eq-point (save-excursion + (haskell-back-to-symbol "=") + (point))) + (state (parse-partial-sexp + eq-point + (point)))) + (if (> (car state) 0) + ;;There is an unbalanced parenthesis between + ;; the function and here. + (if (not (or (nth 3 state) (nth 4 state))) + ;;We are not in a string or comment + ;; so goto the parenthesis + (progn + (goto-char (nth 1 state)) + (if (not (haskell-keyword-in-regionp + (point) + original-position)) + ;;There is not a keyword after the open + ;; bracket so we override the indentation + (progn + (if (not (looking-at "{")) + ;;The parenthesis is not a `{' + (if (or (looking-at "\\[") + (save-excursion + (goto-char (haskell-eol)) + (skip-chars-backward " \t") + (and + (char-equal (preceding-char) ?,) + (= (car state) + (car (parse-partial-sexp + eq-point + (point))))))) + ;;The paren is a square one + ;; or it is a tuple. + ;;Don't ignore what is after it. + (setq indent (haskell-list-align (haskell-eol))) + ;;Otherwise, ignore what comes after it. + (setq indent (haskell-list-align (point)))))))))))) + )) + + indent))) + + +;;; Inserts the close parenthesis and reindents the line. +;;; We want to reindent the line if the parenthesis is +;;; the first character on the line. The parenthesis +;;; recognised by this function are `]', `}'. + +(defun electric-haskell-brace () + "Inserts the character `]' or `}' and reindents the current line." + "Insert character and correct line's indentation." + (interactive) + (if (save-excursion + (skip-chars-backward " \t") + (bolp)) + ;;The parenthesis is at the beginning of the line. + (progn + (insert last-command-char) + (haskell-indent-line)) + ;;Otherwise it is not at the beginning of line. + (insert last-command-char)) + ;; Match its beginning. + (haskell-blink-open)) + + + + +;;; This function returns the indentation for the next line given +;;; that it is contained in a bracket or we are extending a functions +;;; parameters over a line. For the case of being in an unbalanced +;;; parenthesis list, the point lies on the unbalanced parenthesis. +;;; The parameter eol-limit is used to delimit the end of the line. + +(defun haskell-list-align (eol-limit) + "Returns the indentation for the next line given that +the point lies on an unbalanced open parenthesis." + (save-excursion + (let ((indent (1+ (current-column)))) + ;;Set indent to be the next char (at least). + + (cond ((not + (looking-at ".[ \t]*\\($\\|--\\)")) + ;;There is something after the parenthesis + ;;ie. the line is not empty and ignore comments + (cond ((save-excursion + (goto-char eol-limit) + (skip-chars-backward " \t") + (and (char-equal (preceding-char) ?,) + (save-excursion + (beginning-of-line) + (not (search-forward "|" eol-limit 't))))) + ;;This is a normal list since a `,' at end + ;; and there is no a `|' on the line. + (forward-char 1) + (skip-chars-forward " \t") + (setq indent (current-column))) + + ((looking-at "\\[") + ;;It is a list comp we are looking at + ;;Goto the bar. + (forward-char 1) + (search-forward "|" eol-limit 't) + (skip-chars-forward " \t") + (setq indent (current-column))) + + ((looking-at ".[ \t]*(") + ;;We are looking at an open parenthesis + ;; after this character. + ;;It must be balanced so + ;; move to the start of this paren + ;; and set indent to be here + (forward-char 1) + (skip-chars-forward " \t") + (setq indent (current-column))) + + (t + (forward-word 1) + ;;We are not looking at another open + ;; parenthesis, so move forward past the + ;; (assumed) function name. + (if (or + haskell-std-list-indent + (looking-at"[ \t]*\\($\\|--\\)")) + ;;There is nothing after the name + ;; or haskell-std-list-offset is set + ;; so set indent to be its original + ;; value plus the offset minus 1 + ;; since we added one on earlier. + (setq indent + (+ indent + (1- haskell-list-offset))) + + ;;Otherwise there is something after the + ;; name, so skip to the first non space + ;; character. + (skip-chars-forward " \t") + (setq indent (current-column))))))) + + + indent))) + + + +(defun haskell-insert-round-paren () + "Inserts a `(' and blinks to its matching parenthesis." + (interactive) + (insert last-command-char) + (haskell-blink-open)) + + + +;;; This function is called when a close parenthesis +;;; `)', `]', or `}' is typed. +;;; Blinks the cursor on the corresponding open parnethesis. +;;; The point lies just after the close parenthesis. + +(defun haskell-blink-open () + "Blinks the cursor to the matching open parenthesis. +The point lies just after a parenthesis." + (let ((state (parse-partial-sexp (point) + (save-excursion + (haskell-back-to-zero-indent) + (point))))) + (if (and + (>= (car state) 0) + (not (or (nth 3 state) (nth 4 state)))) + ;;The parenthesis just inserted has a match + ;; and is not in a string or a comment + ;; so blink on its match + (save-excursion + (goto-char (nth 2 state)) + (sit-for 1))))) + + + +;;; This function indents the line expecting the line to be a +;;; continued function application. + +;;; foo a = bar a +;;; b {haskell-further-indent applied to this line +;;; indents the line as shown} + +;;; The line would look like this if only tab had been applied: +;;; foo a = bar a +;;; b + +(defun haskell-further-indent () + "Indents the line more than the ordinary indentation in order to +extend function arguments over multiple lines." + (interactive) + (let (indent + (new-point (max (save-excursion + (haskell-back-to-symbol "=") + (point)) + (save-excursion + (haskell-back-to-keyword) + (point))))) + (save-excursion + ;;This may be a continuation of a function + ;; application so go back to the last '=' + ;; and set indent as designated by the style chosen + (goto-char new-point) + (skip-chars-forward "= \t") + (setq indent (haskell-list-align (haskell-eol)))) + ;;The argument to haskell-list-align is not important here. + (save-excursion + (beginning-of-line) + (delete-horizontal-space) + (indent-to indent)) + (if (< (current-column) indent) + (move-to-column indent)))) + + +;;; This function indents the current line to the first previous +;;; indentation value which is less than the current indentation. + +(defun haskell-lesser-indent () + "Indents the current line to the first previous indentation +value which is less than the current indentation." + (interactive) + (let ((original-indent + (current-indentation)) + (indent (haskell-context-indent)) + (done nil)) + (save-excursion + (while (not done) + (while (and (not (bobp)) + (not (zerop (current-indentation))) + (>= indent original-indent)) + (haskell-backward-to-noncomment) + (setq indent (current-indentation))) + ;;bobp or indent < original-indent + (if (>= indent original-indent) + ;;indent is still greater than or equal to original indent + (progn + (setq indent 0) + (setq done t)) + ;;Otherwise, indent is less than orignal indent. + (forward-line 1) + (setq indent (haskell-context-indent)) + (if (< indent original-indent) + ;;The new indent is an improvement + (setq done t) + ;;Otherwise, indent is still >= original + ;; so go back to the line and keep typing. + (forward-line -1))))) + (save-excursion + (beginning-of-line) + (delete-horizontal-space) + (indent-to indent)) + (if (< (current-column) indent) + (move-to-column indent)))) + + + +;;; Here are the functions which change the local variables +;;; to facilitate tailorability. + +(defun default-mode () + "Calls the function haskell-mode." + (interactive) + (haskell-mode) + (message haskell-indent-style)) + +(defun wadler-mode () + "Sets defaults according to Dr. Philip L. Wadler's preferences. + - Aligns `where' clauses with the corresponding equality. + - Aligns `else' keyword with the corresponding `then' + - haskell-list-offset 2 + - haskell-indent-offset 8 + - haskell-if-indent 2 + - haskell-comment-column 0 + - haskell-case-offset 2 + - haskell-let-offset 5." + ;;Preferences: + ;;'haskell-align-where-with-eq non-nil + ;;'haskell-list-offset 2 + (interactive) + (haskell-mode) + (or haskell-align-where-with-eq + (progn + (setq haskell-align-where-with-eq t) + (setq haskell-std-indent-where nil))) + (setq haskell-align-else-with-then t) + (setq haskell-list-offset 2) + (setq haskell-indent-offset 8) + (setq haskell-if-offset 2) + (setq haskell-case-offset 2) + (setq haskell-let-offset 5) + (setq haskell-comment-column 0) + (setq haskell-indent-style "Wadler") + (message haskell-indent-style)) + + +(defun report-mode () + "Sets defaults according to the style of the Haskell Report. + - Aligns `where' clauses after the corresponding equality. + - Aligns `else' with `then'. + - haskell-then-offset = 3 + - haskell-where-offset = 0. + - haskell-case-offset = 5." + ;;Preferences: + ;; haskell-align-where-after-eq non-nil + ;; haskell-then-offset 3 + ;; haskell-where-offset 0 + ;; haskell-case-offset 5 + (interactive) + (haskell-mode) + (haskell-align-where-after-eq) + (or haskell-align-else-with-then + (haskell-align-else-with-then)) + (setq haskell-then-offset 3) + (setq haskell-where-offset 0) + (setq haskell-case-offset 5) + (setq haskell-indent-style "Report") + (message haskell-indent-style)) + + +(defun haskell-align-where-with-eq () + "Sets indentation so that a 'where' clause lines up underneath +its corresponding equals sign." + (interactive) + (or haskell-align-where-with-eq + (progn + (setq haskell-align-where-after-eq nil) + (setq haskell-std-indent-where nil) + (setq haskell-align-where-with-eq t) + haskell-align-where-with-eq))) + + + +(defun haskell-align-where-after-eq () + "Sets indentation so that a 'where' clause lines up underneath +the first nonspace character after its corresponding equals sign." + (interactive) + (or haskell-align-where-after-eq + (progn + (setq haskell-align-where-with-eq nil) + (setq haskell-std-indent-where nil) + (setq haskell-align-where-after-eq t) + haskell-align-where-after-eq))) + + +(defun haskell-std-indent-where () + "Sets indentation so that a `where' clause lines up underneath +its corresponding equals sign." + (interactive) + (or haskell-std-indent-where + (progn + (setq haskell-align-where-after-eq nil) + (setq haskell-align-where-with-eq nil) + (setq haskell-std-indent-where t) + haskell-std-indent-where))) + + +(defun haskell-align-else-with-then () + "Sets indentation so that an `else' lines up underneath +it's corresponding `then'." + (interactive) + (setq haskell-align-else-with-then + (not haskell-align-else-with-then)) + (setq haskell-nest-ifs nil)) + +(defun haskell-nest-ifs () + "Sets indentation so that an `if' is lined up +under an `if' in an `else ." + (interactive) + (setq haskell-nest-ifs + (not haskell-nest-ifs)) + (setq haskell-align-else-with-then nil)) + + +(defun haskell-always-fixup-comment-space () + "Non-nil means always position one space after a line comment `--', +when reindenting or inserting a comment, +whether or not one space exists." + (setq haskell-always-fixup-comment-space + (not haskell-always-fixup-comment-space)) + haskell-always-fixup-comment-space) + +(defun haskell-indent-style () + "Echos the chosen indentation style in the mini-buffer." + (interactive) + (message haskell-indent-style)) + +(defun set-haskell-let-offset (offset) + "Changes the value of haskell-let-offset, the variable which +determines extra indentation after a `let' and `in'." + (interactive "nSet haskell-let-offset to: ") + (if (and (>= offset 0) (<= offset 10)) + (setq haskell-let-offset offset))) + +(defun set-haskell-if-offset (offset) + "Changes the value of haskell-let-offset, the variable which +determines extra indentation after an `if', `then' and `else'." + (interactive "nSet haskell-if-offset to: ") + (if (and (>= offset 0) (<= offset 10)) + (setq haskell-if-offset offset))) + +(defun set-haskell-case-offset (offset) + "Changes the value of haskell-case-offset, the variable which +determines extra indentation after a `case' and `of'." + (interactive "nSet haskell-case-offset to: ") + (if (and (>= offset 0) (<= offset 10)) + (setq haskell-case-offset offset))) + + +(defun set-haskell-where-offset (offset) + "Changes the value of haskell-where-offset, the variable which +determines extra indentation after a line of haskell code." + (interactive "nSet haskell-where-offset to: ") + (if (and (>= offset 0) (<= offset 10)) + (setq haskell-where-offset offset))) + + +(defun set-haskell-indent-offset (offset) + "Changes the value of haskell-indent-offset, the variable which +determines extra indentation after a line of haskell code." + (interactive "nSet haskell-indent-offset to: ") + (if (and (>= offset 1) (<= offset 10)) + (setq haskell-indent-offset offset))) + + +(defun set-haskell-list-offset (offset) + "Changes the value of haskell-list-offset, the variable which +determines extra indentation after a line of haskell code for a list." + (interactive "nSet haskell-list-offset to: ") + (if (and (>= offset 0) (<= offset 10)) + (setq haskell-list-offset offset))) + + +(defun set-haskell-comp-offset (offset) + "Changes the value of haskell-comp-offset, the variable which +determines extra indentation after a list comprehension." + (interactive "nSet haskell-comp-offset to: ") + (if (and (>= offset 0) (<= offset 10)) + (setq haskell-comp-offset offset))) + + +(defun set-haskell-then-offset (offset) + "Changes the value of haskell-then-offset, the variable which +determines extra indentation for a `then' keyword after an `if'." + (interactive "nSet haskell-then-offset to: ") + (if (and (>= offset 0) (<= offset 10)) + (setq haskell-then-offset offset))) + + +(defun set-haskell-comment-column (column) + "Changes the value of haskell-comment-column, the variable which +determines where to postition a line comment `--'." + (interactive "nSet haskell-comment-column to: ") + (if (and (>= column 0) (<= column 100)) + (setq haskell-comment-column column))) + +(defun set-haskell-concat-column (column) + "Changes the value of haskell-concat-column, the variable which +determines where to postition a concatenation operator `++'." + (interactive "nSet haskell-concat-column to: ") + (if (and (>= column 0) (<= column 100)) + (setq haskell-concat-column column))) + +(defun set-haskell-where-threshold (column) + "Changes the value of haskell-where-threshold, the variable which +determines when to override positioning a `where' under or after +its corresponding equality." + (interactive "nSet haskell-where-threshold to: ") + (if (and (>= column 0) (<= column 100)) + (setq haskell-where-threshold column))) + +(defun flag ())
\ No newline at end of file diff --git a/ghc/CONTRIB/haskell-modes/glasgow/original/manual.dvi b/ghc/CONTRIB/haskell-modes/glasgow/original/manual.dvi Binary files differnew file mode 100644 index 0000000000..616b0fcb84 --- /dev/null +++ b/ghc/CONTRIB/haskell-modes/glasgow/original/manual.dvi diff --git a/ghc/CONTRIB/haskell-modes/glasgow/original/report.dvi b/ghc/CONTRIB/haskell-modes/glasgow/original/report.dvi Binary files differnew file mode 100644 index 0000000000..5f7aaebabf --- /dev/null +++ b/ghc/CONTRIB/haskell-modes/glasgow/original/report.dvi diff --git a/ghc/CONTRIB/haskell-modes/simonm/ghc/haskell.el b/ghc/CONTRIB/haskell-modes/simonm/ghc/haskell.el new file mode 100644 index 0000000000..43461eb69f --- /dev/null +++ b/ghc/CONTRIB/haskell-modes/simonm/ghc/haskell.el @@ -0,0 +1,185 @@ +;;; Haskell mode for emacs (c) Simon Marlow 11/1/92 + +;;; To: partain@dcs.gla.ac.uk +;;; Subject: Haskell mode for emacs +;;; Date: Mon, 14 Dec 92 17:41:56 +0000 +;;; From: Simon Marlow <simonm@dcs.gla.ac.uk> +;;; +;;; ... What it buys you: very little actually, but the nice things are +;;; +;;; (i) Pressing line feed indents the next line according to the +;;; previous one, +;;; (ii) Pressing Meta-; gives you a comment on the current line, +;;; (iii) For literate scripts, pressing line feed gives you a bird +;;; track on the next line if there was one on the previous +;;; line, and does the indentation +;;; (iv) For literate scripts, pressing Meta-Tab toggles a bird track +;;; on or off at the beginning of the current line, +;;; (v) There's a function for toggling bird tracks on all lines in a +;;; region. +;;; (vi) Emacs says "Haskell" or "Literate Haskell" in the mode line :-) +;;; +;;; You'll have to make the necessary changes in .emacs to load in the +;;; library automatically (you probably know what to do). ... + +(defvar haskell-mode-map () + "Keymap used in Haskell mode.") + +(defvar haskell-literate-mode-map () + "Keymap used in Haskell literate script mode.") + +(defvar haskell-mode-syntax-table () + "Syntax table for haskell mode.") + +(if haskell-mode-map + () + (setq haskell-mode-map (make-sparse-keymap)) + (define-key haskell-mode-map "\C-j" 'haskell-newline-and-indent)) + +(if haskell-literate-mode-map + () + (setq haskell-literate-mode-map (make-sparse-keymap)) + (define-key haskell-literate-mode-map "\C-j" 'haskell-literate-newline-and-indent) + (define-key haskell-literate-mode-map "\M-\C-i" 'haskell-literate-toggle-bird-track-line)) + +(if haskell-mode-syntax-table + () + (let ((i 0)) + (setq haskell-mode-syntax-table (make-syntax-table)) + (while (< i ?0) + (modify-syntax-entry i "." haskell-mode-syntax-table) + (setq i (1+ i))) + (while (< i (1+ ?9)) + (modify-syntax-entry i "_" haskell-mode-syntax-table) + (setq i (1+ i))) + (while (< i ?A) + (modify-syntax-entry i "." haskell-mode-syntax-table) + (setq i (1+ i))) + (while (< i (1+ ?Z)) + (modify-syntax-entry i "w" haskell-mode-syntax-table) + (setq i (1+ i))) + (while (< i ?a) + (modify-syntax-entry i "." haskell-mode-syntax-table) + (setq i (1+ i))) + (while (< i (1+ ?z)) + (modify-syntax-entry i "w" haskell-mode-syntax-table) + (setq i (1+ i))) + (while (< i 128) + (modify-syntax-entry i "." haskell-mode-syntax-table) + (setq i (1+ i))) + (modify-syntax-entry ? " " haskell-mode-syntax-table) + (modify-syntax-entry ?\t " " haskell-mode-syntax-table) + (modify-syntax-entry ?\n ">" haskell-mode-syntax-table) + (modify-syntax-entry ?\f ">" haskell-mode-syntax-table) + (modify-syntax-entry ?\" "\"" haskell-mode-syntax-table) + (modify-syntax-entry ?\' "w" haskell-mode-syntax-table) + (modify-syntax-entry ?_ "w" haskell-mode-syntax-table) + (modify-syntax-entry ?\\ "." haskell-mode-syntax-table) + (modify-syntax-entry ?\( "()" haskell-mode-syntax-table) + (modify-syntax-entry ?\) ")(" haskell-mode-syntax-table) + (modify-syntax-entry ?\[ "(]" haskell-mode-syntax-table) + (modify-syntax-entry ?\] ")[" haskell-mode-syntax-table) + (modify-syntax-entry ?{ "(}1" haskell-mode-syntax-table) + (modify-syntax-entry ?} "){4" haskell-mode-syntax-table) + (modify-syntax-entry ?- "_ 123" haskell-mode-syntax-table) + )) + +(defun haskell-vars () + (kill-all-local-variables) + (make-local-variable 'paragraph-start) + (setq paragraph-start (concat "^$\\|" page-delimiter)) + (make-local-variable 'paragraph-separate) + (setq paragraph-separate paragraph-start) + (make-local-variable 'comment-start) + (setq comment-start "--") + (make-local-variable 'comment-start-skip) + (setq comment-start-skip "--[^a-zA-Z0-9]*") + (make-local-variable 'comment-column) + (setq comment-column 40) + (make-local-variable 'comment-indent-hook) + (setq comment-indent-hook 'haskell-comment-indent)) + +(defun haskell-mode () + "Major mode for editing Haskell programs. +Blank lines separate paragraphs, Comments start with '--'. +Use Linefeed to do a newline and indent to the level of the previous line. +Tab simply inserts a TAB character. +Entry to this mode calls the value of haskell-mode-hook if non-nil." + (interactive) + (haskell-vars) + (setq major-mode 'haskell-mode) + (setq mode-name "Haskell") + (use-local-map haskell-mode-map) + (set-syntax-table haskell-mode-syntax-table) + (run-hooks 'haskell-mode-hook)) + +(defun haskell-literate-mode () + "Major mode for editing haskell programs in literate script form. +Linefeed produces a newline, indented maybe with a bird track on it. +M-TAB toggles the state of the bird track on the current-line. +Entry to this mode calls haskell-mode-hook and haskell-literate-mode-hook." + (interactive) + (haskell-vars) + (setq major-mode 'haskell-literate-mode) + (setq mode-name "Literate Haskell") + (use-local-map haskell-literate-mode-map) + (set-syntax-table haskell-mode-syntax-table) + (run-hooks 'haskell-mode-hook) + (run-hooks 'haskell-literate-mode-hook)) + +;; Find the indentation level for a comment.. +(defun haskell-comment-indent () + (skip-chars-backward " \t") + ;; if the line is blank, put the comment at the beginning, + ;; else at comment-column + (if (bolp) 0 (max (1+ (current-column)) comment-column))) + +;; Newline, and indent according to the previous line's indentation. +;; Don't forget to use 'indent-tabs-mode' if you require tabs to be used +;; for indentation. +(defun haskell-newline-and-indent () + (interactive) + (newline) + (let ((c 0)) + (save-excursion + (forward-line -1) + (back-to-indentation) + (setq c (if (eolp) 0 (current-column)))) + (indent-to c))) ;ident new line to this level + +;;; Functions for literate scripts + +;; Newline and maybe add a bird track, indent +(defun haskell-literate-newline-and-indent () + (interactive) + (newline) + (let ((bird-track nil) (indent-column 0)) + (save-excursion + (forward-line -1) + (if (= (following-char) ?>) (setq bird-track t)) + (skip-chars-forward "^ \t") + (skip-chars-forward " \t") + (setq indent-column (if (eolp) 0 (current-column)))) + (if bird-track (insert-char ?> 1)) + (indent-to indent-column))) + +;; Toggle bird-track ][ +(defun haskell-literate-toggle-bird-track-line () + (interactive) + (save-excursion + (beginning-of-line) + (if (= (following-char) ? ) + (progn (delete-char 1) (insert-char ?> 1)) + (if (= (following-char) ?>) + (progn (delete-char 1) (insert-char ? 1)) + (progn (insert-char ?> 1) (insert-char ? 1)))))) + +(defun haskell-literate-toggle-bird-track-region (start end) + (interactive "r") + (save-excursion + (goto-char start) + (while (<= (point) end) + (beginning-of-line) + (haskell-literate-toggle-bird-track-line) + (forward-line 1)))) + diff --git a/ghc/CONTRIB/haskell-modes/simonm/real/haskell.el b/ghc/CONTRIB/haskell-modes/simonm/real/haskell.el new file mode 100644 index 0000000000..c1dd5f1eab --- /dev/null +++ b/ghc/CONTRIB/haskell-modes/simonm/real/haskell.el @@ -0,0 +1,201 @@ +;;; Haskell mode for emacs (c) Simon Marlow 11/1/92 + +(defvar haskell-mode-map () + "Keymap used in Haskell mode.") + +(defvar haskell-literate-mode-map () + "Keymap used in Haskell literate script mode.") + +(defvar haskell-mode-syntax-table () + "Syntax table for haskell mode.") + +(if haskell-mode-map + () + (setq haskell-mode-map (make-sparse-keymap)) + (define-key haskell-mode-map "\C-j" 'haskell-newline-and-indent)) + +(if haskell-literate-mode-map + () + (setq haskell-literate-mode-map (make-sparse-keymap)) + (define-key haskell-literate-mode-map "\C-j" + 'haskell-literate-newline-and-indent) + (define-key haskell-literate-mode-map "\M-\C-i" + 'haskell-literate-toggle-bird-track-line) + (define-key haskell-literate-mode-map "\M-m" + 'haskell-literate-back-to-indentation)) + + +(if haskell-mode-syntax-table + () + (let ((i 0)) + (setq haskell-mode-syntax-table (make-syntax-table)) +; (while (< i ?0) +; (modify-syntax-entry i "." haskell-mode-syntax-table) +; (setq i (1+ i))) +; (while (< i (1+ ?9)) +; (modify-syntax-entry i "_" haskell-mode-syntax-table) +; (setq i (1+ i))) +; (while (< i ?A) +; (modify-syntax-entry i "." haskell-mode-syntax-table) +; (setq i (1+ i))) +; (while (< i (1+ ?Z)) +; (modify-syntax-entry i "w" haskell-mode-syntax-table) +; (setq i (1+ i))) +; (while (< i ?a) +; (modify-syntax-entry i "." haskell-mode-syntax-table) +; (setq i (1+ i))) +; (while (< i (1+ ?z)) +; (modify-syntax-entry i "w" haskell-mode-syntax-table) +; (setq i (1+ i))) +; (while (< i 128) +; (modify-syntax-entry i "." haskell-mode-syntax-table) +; (setq i (1+ i))) + (modify-syntax-entry ? " " haskell-mode-syntax-table) + (modify-syntax-entry ?\t " " haskell-mode-syntax-table) + (modify-syntax-entry ?\f "> b" haskell-mode-syntax-table) + (modify-syntax-entry ?\n "> b" haskell-mode-syntax-table) + (modify-syntax-entry ?\" "\"" haskell-mode-syntax-table) + (modify-syntax-entry ?\' "_" haskell-mode-syntax-table) + (modify-syntax-entry ?_ "_" haskell-mode-syntax-table) + (modify-syntax-entry ?\\ "." haskell-mode-syntax-table) + (modify-syntax-entry ?\( "()" haskell-mode-syntax-table) + (modify-syntax-entry ?\) ")(" haskell-mode-syntax-table) + (modify-syntax-entry ?\[ "(]" haskell-mode-syntax-table) + (modify-syntax-entry ?\] ")[" haskell-mode-syntax-table) + (modify-syntax-entry ?{ "(}1" haskell-mode-syntax-table) + (modify-syntax-entry ?} "){4" haskell-mode-syntax-table) + (modify-syntax-entry ?- ". 12b" haskell-mode-syntax-table) + )) + +(defun haskell-vars () + (kill-all-local-variables) + (make-local-variable 'paragraph-start) + (setq paragraph-start (concat "^$\\|" page-delimiter)) + (make-local-variable 'paragraph-separate) + (setq paragraph-separate paragraph-start) + (make-local-variable 'comment-start) + (setq comment-start "--") + (make-local-variable 'comment-start-skip) + (setq comment-start-skip "--[^a-zA-Z0-9]*") + (make-local-variable 'comment-column) + (setq comment-column 40) + (make-local-variable 'comment-indent-function) + (setq comment-indent-function 'haskell-comment-indent) + ;(make-local-variable 'font-lock-keywords) + ;(setq font-lock-keywords haskell-literate-font-lock-keywords) + ) + +(defun haskell-mode () + "Major mode for editing Haskell programs. +Blank lines separate paragraphs, Comments start with '--'. +Use Linefeed to do a newline and indent to the level of the previous line. +Tab simply inserts a TAB character. +Entry to this mode calls the value of haskell-mode-hook if non-nil." + (interactive) + (haskell-vars) + (setq major-mode 'haskell-mode) + (setq mode-name "Haskell") + (use-local-map haskell-mode-map) + (set-syntax-table haskell-mode-syntax-table) + (run-hooks 'haskell-mode-hook)) + +(defun haskell-literate-mode () + "Major mode for editing haskell programs in literate script form. +Linefeed produces a newline, indented maybe with a bird track on it. +M-TAB toggles the state of the bird track on the current-line. +Entry to this mode calls haskell-mode-hook and haskell-literate-mode-hook." + (interactive) + (haskell-vars) + (setq major-mode 'haskell-literate-mode) + (setq mode-name "Literate Haskell") + (use-local-map haskell-literate-mode-map) + (set-syntax-table haskell-mode-syntax-table) + (run-hooks 'haskell-mode-hook) + (run-hooks 'haskell-literate-mode-hook)) + +;; Find the indentation level for a comment.. +(defun haskell-comment-indent () + (skip-chars-backward " \t") + ;; if the line is blank, put the comment at the beginning, + ;; else at comment-column + (if (bolp) 0 (max (1+ (current-column)) comment-column))) + +;; Newline, and indent according to the previous line's indentation. +;; Don't forget to use 'indent-tabs-mode' if you require tabs to be used +;; for indentation. +(defun haskell-newline-and-indent () + (interactive) + (newline) + (let ((c 0)) + (save-excursion + (forward-line -1) + (back-to-indentation) + (setq c (if (eolp) 0 (current-column)))) + (indent-to c))) ;ident new line to this level + +;;; Functions for literate scripts + +;; Newline and maybe add a bird track, indent +(defun haskell-literate-newline-and-indent () + (interactive) + (newline) + (let ((bird-track nil) (indent-column 0)) + (save-excursion + (forward-line -1) + (if (= (following-char) ?>) (setq bird-track t)) + (skip-chars-forward "^ \t") + (skip-chars-forward " \t") + (setq indent-column (if (eolp) 0 (current-column)))) + (if bird-track (insert-char ?> 1)) + (indent-to indent-column))) + +;; Toggle bird-track ][ +(defun haskell-literate-toggle-bird-track-line () + (interactive) + (save-excursion + (beginning-of-line) + (if (= (following-char) ? ) + (progn (delete-char 1) (insert-char ?> 1)) + (if (= (following-char) ?>) + (progn (delete-char 1) (insert-char ? 1)) + (progn (insert-char ?> 1) (insert-char ? 1)))))) + +(defun haskell-literate-toggle-bird-track-region (start end) + (interactive "r") + (save-excursion + (goto-char start) + (while (<= (point) end) + (beginning-of-line) + (haskell-literate-toggle-bird-track-line) + (forward-line 1)))) + +(defun haskell-literate-back-to-indentation () + (interactive) + (beginning-of-line) + (if (= (following-char) ?>) + (forward-char 1)) + (skip-chars-forward " \t")) + + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; +;;; keywords for jwz's font-look-mode (lemacs 19) +;;; +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(defvar haskell-literate-font-lock-keywords () + "Font definitions for Literate Haskell files.") + +(setq haskell-literate-font-lock-keywords + (list + '("^[^>\n].*$" . font-lock-comment-face) + (concat "\\b\\(" + (mapconcat 'identity + '("case" "class" "data" "default" "deriving" "else" "hiding" + "if" "import" "in" "infix" "infixl" "infixr" "instance" + "interface" "let" "module" "of" "renaming" "then" "to" + "type" "where") + "\\|") + "\\)\\b") + )) + diff --git a/ghc/CONTRIB/haskell-modes/yale/chak/haskell.el b/ghc/CONTRIB/haskell-modes/yale/chak/haskell.el new file mode 100644 index 0000000000..4470553ce9 --- /dev/null +++ b/ghc/CONTRIB/haskell-modes/yale/chak/haskell.el @@ -0,0 +1,1866 @@ +;;; ================================================================== +;;; File: haskell.el ;;; +;;; ;;; +;;; Author: A. Satish Pai ;;; +;;; Maria M. Gutierrez ;;; +;;; Dan Rabin (Jul-1991) ;;; +;;; ================================================================== +;;; Time-stamp: <Sat Oct 7 1995 17:48:39 Stardate: [-31]6403.50 hwloidl> +;;; ================================================================== +;;; +;;; extended by Manuel M.T. Chakravarty with rudimentary editing features +;;; (including better syntax table) and support for the font-lock-mode; +;;; changes are marked with !chak! +;;; +;;; using this mode on a 19.x Emacs running under a window system automagically +;;; applies the font-lock-mode; this feature can be switched off by setting +;;; `haskell-auto-font-lock' to `nil' + +;;; Description: Haskell mode for GNU Emacs. + +;;; Related files: comint.el + +;;; Contents: + +;;; Update Log + +;;; Known bugs / problems +;;; - the haskell editing mode (indentation, etc) is still missing. +;;; - the handling for errors from haskell needs to be rethought. +;;; - general cleanup of code. + + +;;; Errors generated + +;;; ================================================================== +;;; Haskell mode for editing files, and an Inferior Haskell mode to +;;; run a Haskell process. This file contains stuff snarfed and +;;; modified from tea.el, scheme.el, etc. This file may be freely +;;; modified; however, if you have any bug-corrections or useful +;;; improvements, I'd appreciate it if you sent me the mods so that +;;; I can merge them into the version I maintain. +;;; +;;; The inferior Haskell mode requires comint.el. +;;; +;;; You might want to add this to your .emacs to go automagically +;;; into Haskell mode while finding .hs files. +;;; +;;; (setq auto-mode-alist +;;; (cons '("\\.hs$" . haskell-mode) +;;; auto-mode-alist)_) +;;; +;;; To use this file, set up your .emacs to autoload this file for +;;; haskell-mode. For example: +;;; +;;; (autoload 'haskell-mode "$HASKELL/emacs-tools/haskell.elc" +;;; "Load Haskell mode" t) +;;; +;;; (autoload 'run-mode "$HASKELL/emacs-tools/haskell.elc" +;;; "Load Haskell mode" t) +;;; +;;; [Note: The path name given above is Yale specific!! Modify as +;;; required.] +;;; ================================================================ + +;;; Announce your existence to the world at large. + +(provide 'haskell) + + +;;; Load these other files. + +(require 'comint) ; Olin Shivers' comint mode is the substratum + +;;; !chak! +;;; +(if (and window-system (string-match "19." emacs-version)) + (require 'font-lock)) + + + +;;; ================================================================ +;;; Declare a bunch of variables. +;;; ================================================================ + + +;;; User settable (via M-x set-variable and M-x edit-options) + +(defvar haskell-program-name (getenv "HASKELLPROG") + "*Program invoked by the haskell command.") + +(defvar haskell-auto-create-process t + "*If not nil, create a Haskell process automatically when required to evaluate or compile Haskell code.") + +(defvar haskell-auto-switch-input t + "*If not nil, jump to *haskell* buffer automatically on input request.") + +(defvar haskell-ask-before-saving t + "*If not nil, ask before saving random haskell-mode buffers.") + +(defvar haskell-initial-printers '("interactive") + "*Printers to set when starting a new Haskell process.") + + +;;; Pad/buffer Initialization variables + +(defvar *haskell-buffer* "*haskell*" + "Name of the haskell process buffer") + +(defvar haskell-main-pad "\*Main-pad\*" + "Scratch pad associated with module Main") + +(defvar haskell-main-module "Main") + + +(defvar *last-loaded* nil) +(defvar *last-module* haskell-main-module) +(defvar *last-pad* haskell-main-pad) + + +;;; These are used for haskell-tutorial mode. + +(defvar *ht-source-file* "$HASKELL/progs/tutorial/tutorial.lhs") +(defvar *ht-temp-buffer* nil) +(defvar *ht-file-buffer* "Haskell-Tutorial-Master") + +;;; !chak! variables for font-lock-mode support +;;; + +(defvar haskell-auto-font-lock t + "Use font-lock-mode by default.") + +(defvar haskell-font-lock-keywords + (list + "\\bcase\\b" "\\bclass\\b" "\\bdata\\b" "\\bdefault\\b" "\\bderiving\\b" + "\\belse\\b" "\\bhiding\\b" "\\bif\\b" "\\bimport\\b" "\\bin\\b" + "\\binfix\\b" "\\binfixl\\b" "\\binfixr\\b" "\\binstance\\b" + "\\binterface\\b" "\\blet\\b" "\\bmodule\\b" "\\bof\\b" "\\brenaming\\b" + "\\bthen\\b" "\\bto\\b" "\\btype\\b" "\\bwhere\\b" + ;'("\\S_\\(\\.\\.\\|::\\|=>\\|=\\|@\\||\\|~\\|-\\|<-\\|->\\)\\S_" . 1) + '("\\bdata\\b\\s *\\(\\w+\\)\\(\\w\\|\\s \\)*=[^>]" 1 font-lock-type-face) + '("\\bdata\\b\\(\\s \\|(\\|)\\|\\w\\)*=>\\s *\n?\\s *\\(\\w+\\)" 2 + font-lock-type-face) + '("\\btype\\b\\s *\\(\\w+\\)" 1 font-lock-type-face) + '("\\(\\w+\\)\\s *::\\(\\s \\|$\\)" 1 font-lock-function-name-face) + '("(\\(\\s_+\\))\\s *::\\(\\s \\|$\\)" 1 font-lock-function-name-face) +; '("\\($\\|[^\\\\]\\)\\('[^\\\\]'\\)" 2 font-lock-string-face t) + '("\\('\\([^\\\\]\\|\\\\'\\)'\\)" 1 font-lock-string-face t) + ) + "Additional expressions to highlight in Haskell mode.") + + + +;;; ================================================================ +;;; Haskell editing mode stuff +;;; ================================================================ + +;;; Leave this place alone... +;;; The definitions below have been pared down to the bare +;;; minimum; they will be restored later. +;;; +;;; -Satish 2/5. + +;;; Keymap for Haskell mode +(defvar haskell-mode-map (make-sparse-keymap) + "Keymap used for haskell-mode") + +(defun haskell-establish-key-bindings (keymap) + (define-key keymap "\C-ce" 'haskell-eval) + (define-key keymap "\C-cr" 'haskell-run) + (define-key keymap "\C-ct" 'haskell-report-type) + (define-key keymap "\C-cm" 'haskell-run-main) + (define-key keymap "\C-c\C-r" 'haskell-run-file) + (define-key keymap "\C-cp" 'haskell-get-pad) + (define-key keymap "\C-c\C-o" 'haskell-optimizers) + (define-key keymap "\C-c\C-p" 'haskell-printers) + (define-key keymap "\C-cc" 'haskell-compile) + (define-key keymap "\C-cl" 'haskell-load) + (define-key keymap "\C-ch" 'haskell-switch) + (define-key keymap "\C-c\C-k" 'haskell-kill) + (define-key keymap "\C-c:" 'haskell-command) + (define-key keymap "\C-cq" 'haskell-exit) + (define-key keymap "\C-ci" 'haskell-interrupt) + (define-key keymap "\C-cu" 'haskell-edit-unit)) + + +(haskell-establish-key-bindings haskell-mode-map) + + +(defvar haskell-mode-syntax-table nil + "Syntax table used for haskell-mode") + +;; !chak! taken from lisp-mode +;; +(defvar haskell-mode-abbrev-table nil + "Abbrev table used for the haskell-mode") + +;; !chak! took syntax table from haskell mode distributed with GHC and modified +;; it; we treat numbers as parts of words and operators as elements of +;; the syntactic class `_' +;; +(if haskell-mode-syntax-table + () + (let ((i 0)) + (setq haskell-mode-syntax-table (make-syntax-table)) + (while (< i ?0) + (modify-syntax-entry i "." haskell-mode-syntax-table) + (setq i (1+ i))) + (while (< i (1+ ?9)) + (modify-syntax-entry i "w" haskell-mode-syntax-table) + (setq i (1+ i))) + (while (< i ?A) + (modify-syntax-entry i "." haskell-mode-syntax-table) + (setq i (1+ i))) + (while (< i (1+ ?Z)) + (modify-syntax-entry i "w" haskell-mode-syntax-table) + (setq i (1+ i))) + (while (< i ?a) + (modify-syntax-entry i "." haskell-mode-syntax-table) + (setq i (1+ i))) + (while (< i (1+ ?z)) + (modify-syntax-entry i "w" haskell-mode-syntax-table) + (setq i (1+ i))) + (while (< i 128) + (modify-syntax-entry i "." haskell-mode-syntax-table) + (setq i (1+ i))) + (modify-syntax-entry ? " " haskell-mode-syntax-table) + (modify-syntax-entry ?\t " " haskell-mode-syntax-table) + (modify-syntax-entry ?\n ">" haskell-mode-syntax-table) + (modify-syntax-entry ?\f ">" haskell-mode-syntax-table) + (modify-syntax-entry ?! "_" haskell-mode-syntax-table) + (modify-syntax-entry ?# "_" haskell-mode-syntax-table) + (modify-syntax-entry ?$ "_" haskell-mode-syntax-table) + (modify-syntax-entry ?% "_" haskell-mode-syntax-table) + (modify-syntax-entry ?& "_" haskell-mode-syntax-table) + (modify-syntax-entry ?* "_" haskell-mode-syntax-table) + (modify-syntax-entry ?+ "_" haskell-mode-syntax-table) + (modify-syntax-entry ?. "_" haskell-mode-syntax-table) + (modify-syntax-entry ?/ "_" haskell-mode-syntax-table) + (modify-syntax-entry ?< "_" haskell-mode-syntax-table) + (modify-syntax-entry ?= "_" haskell-mode-syntax-table) + (modify-syntax-entry ?> "_" haskell-mode-syntax-table) + (modify-syntax-entry ?? "_" haskell-mode-syntax-table) + (modify-syntax-entry ?@ "_" haskell-mode-syntax-table) + (modify-syntax-entry ?^ "_" haskell-mode-syntax-table) + (modify-syntax-entry ?| "_" haskell-mode-syntax-table) + (modify-syntax-entry ?~ "_" haskell-mode-syntax-table) + (modify-syntax-entry ?\" "\"" haskell-mode-syntax-table) + (modify-syntax-entry ?\' "w" haskell-mode-syntax-table) + (modify-syntax-entry ?_ "w" haskell-mode-syntax-table) + (modify-syntax-entry ?\\ "_" haskell-mode-syntax-table) + (modify-syntax-entry ?\( "()" haskell-mode-syntax-table) + (modify-syntax-entry ?\) ")(" haskell-mode-syntax-table) + (modify-syntax-entry ?\[ "(]" haskell-mode-syntax-table) + (modify-syntax-entry ?\] ")[" haskell-mode-syntax-table) + (modify-syntax-entry ?{ "(}1" haskell-mode-syntax-table) + (modify-syntax-entry ?} "){4" haskell-mode-syntax-table) + (modify-syntax-entry ?- "_ 123" haskell-mode-syntax-table) + )) + +;; !chak! taken from lisp-mode +;; +(define-abbrev-table 'haskell-mode-abbrev-table ()) + +;; !chak! adapted from lisp-mode +;; +(defun haskell-mode-variables (haskell-syntax) + (cond (haskell-syntax + (set-syntax-table haskell-mode-syntax-table))) + (setq local-abbrev-table haskell-mode-abbrev-table) + (make-local-variable 'paragraph-start) + (setq paragraph-start (concat "^$\\|" page-delimiter)) + (make-local-variable 'paragraph-separate) + (setq paragraph-separate paragraph-start) + (make-local-variable 'paragraph-ignore-fill-prefix) + (setq paragraph-ignore-fill-prefix t) + (make-local-variable 'indent-line-function) + (setq indent-line-function 'haskell-indent-line) +; (make-local-variable 'indent-region-function) +; (setq indent-region-function 'haskell-indent-region) + (make-local-variable 'parse-sexp-ignore-comments) + (setq parse-sexp-ignore-comments t) +; (make-local-variable 'outline-regexp) +; (setq outline-regexp ";;; \\|(....") + (make-local-variable 'comment-start) + (setq comment-start "--") + (make-local-variable 'comment-start-skip) + (setq comment-start-skip "-- *") + (make-local-variable 'comment-column) + (setq comment-column 40) +; (make-local-variable 'comment-indent-function) +; (setq comment-indent-function 'haskell-comment-indent) + (make-local-variable 'font-lock-keywords) + (setq font-lock-keywords haskell-font-lock-keywords) + ) + +;; !chak! +;; +(defun haskell-indent-line () + "Simple indentation function using `indent-relative'." + (interactive) + (save-excursion + (beginning-of-line) + (delete-horizontal-space) + (indent-relative) + ) + ) + +;;; Command for invoking the Haskell mode +(defun haskell-mode nil + "Major mode for editing Haskell code to run in Emacs +The following commands are available: +\\{haskell-mode-map} + +A Haskell process can be fired up with \"M-x haskell\". + +Customization: Entry to this mode runs the hooks that are the value of variable +haskell-mode-hook. + +Windows: + +There are 3 types of windows associated with Haskell mode. They are: + *haskell*: which is the process window. + Pad: which are buffers available for each module. It is here + where you want to test things before preserving them in a + file. Pads are always associated with a module. + When issuing a command: + The pad and its associated module are sent to the Haskell + process prior to the execution of the command. + .hs: These are the files where Haskell programs live. They + have .hs as extension. + When issuing a command: + The file is sent to the Haskell process prior to the + execution of the command. + +Commands: + +Each command behaves differently according to the type of the window in which +the cursor is positioned when the command is issued . + +haskell-eval: \\[haskell-eval] + Always promts user for a Haskell expression to be evaluated. If in a + .hs file buffer, then the cursor tells which module is the current + module and the pad for that module (if any) gets loaded as well. + +haskell-run: \\[haskell-run] + Always queries for a variable of type Dialogue to be evaluated. + +haskell-run-main: \\[haskell-run-main] + Run Dialogue named main in the current module. + +haskell-report-type: \\[haskell-report-type] + Like haskell-eval, but prints the type of the expression without + evaluating it. + +haskell-mode: \\[haskell-mode] + Puts the current buffer in haskell mode. + +haskell-compile: \\[haskell-compile] + Compiles file in current buffer. + +haskell-load: \\[haskell-load] + Loads file in current buffer. + +haskell-run-file: \\[haskell-run-file] + Runs file in the current buffer. + +haskell-pad: \\[haskell-pad] + Creates a scratch pad for the current module. + +haskell-optimizers: \\[haskell-optimizers] + Shows the list of available optimizers. Commands for turning them on/off. + +haskell-printers: \\[haskell-printers] + Shows the list of available printers. Commands for turning them on/off. + +haskell-command: \\[haskell-command] + Prompts for a command to be sent to the command interface. You don't + need to put the : before the command. + +haskell-quit: \\[haskell-quit] + Terminates the haskell process. + +haskell-switch: \\[haskell-switch] + Switches to the inferior Haskell buffer (*haskell*) and positions the + cursor at the end of the buffer. + +haskell-kill: \\[haskell-kill] + Kill the current contents of the *haskell* buffer. + +haskell-interrupt: \\[haskell-interrupt] + Interrupts haskell process and resets it. + +haskell-edit-unit: \\[haskell-edit-unit] + Edit the .hu file for the unit containing this file. +" + (interactive) + (kill-all-local-variables) + (use-local-map haskell-mode-map) + (setq major-mode 'haskell-mode) + (setq mode-name "Haskell") + (make-local-variable 'indent-line-function) + (setq indent-line-function 'indent-relative-maybe) + ;(setq local-abbrev-table haskell-mode-abbrev-table) + (set-syntax-table haskell-mode-syntax-table) + ;(setq tab-stop-list haskell-tab-stop-list) ;; save old list?? + (haskell-mode-variables t) ; !chak! + (cond (haskell-auto-font-lock ; !chak! + (font-lock-mode 1) ; !chak! + )) ; !chak! + (run-hooks 'haskell-mode-hook)) + + + +;;;================================================================ +;;; Inferior Haskell stuff +;;;================================================================ + + +(defvar inferior-haskell-mode-map (copy-keymap comint-mode-map)) + +(haskell-establish-key-bindings inferior-haskell-mode-map) +(define-key inferior-haskell-mode-map "\C-m" 'haskell-send-input) + +(defvar haskell-source-modes '(haskell-mode) + "*Used to determine if a buffer contains Haskell source code. +If it's loaded into a buffer that is in one of these major modes, +it's considered a Haskell source file.") + +(defvar haskell-prompt-pattern "^[A-Z]\\([A-Z]\\|[a-z]\\|[0-9]\\)*>\\s-*" + "Regular expression capturing the Haskell system prompt.") + +(defvar haskell-prompt-ring () + "Keeps track of input to haskell process from the minibuffer") + +(defun inferior-haskell-mode-variables () + nil) + + +;;; INFERIOR-HASKELL-MODE (adapted from comint.el) + +(defun inferior-haskell-mode () + "Major mode for interacting with an inferior Haskell process. + +The following commands are available: +\\{inferior-haskell-mode-map} + +A Haskell process can be fired up with \"M-x haskell\". + +Customization: Entry to this mode runs the hooks on comint-mode-hook and +inferior-haskell-mode-hook (in that order). + +You can send text to the inferior Haskell process from other buffers containing +Haskell source. + + +Windows: + +There are 3 types of windows in the inferior-haskell-mode. They are: + *haskell*: which is the process window. + Pad: which are buffers available for each module. It is here + where you want to test things before preserving them in a + file. Pads are always associated with a module. + When issuing a command: + The pad and its associated module are sent to the Haskell + process prior to the execution of the command. + .hs: These are the files where Haskell programs live. They + have .hs as extension. + When issuing a command: + The file is sent to the Haskell process prior to the + execution of the command. + +Commands: + +Each command behaves differently according to the type of the window in which +the cursor is positioned when the command is issued. + +haskell-eval: \\[haskell-eval] + Always promts user for a Haskell expression to be evaluated. If in a + .hs file, then the cursor tells which module is the current module and + the pad for that module (if any) gets loaded as well. + +haskell-run: \\[haskell-run] + Always queries for a variable of type Dialogue to be evaluated. + +haskell-run-main: \\[haskell-run-main] + Run Dialogue named main. + +haskell-report-type: \\[haskell-report-type] + Like haskell-eval, but prints the type of the expression without + evaluating it. + +haskell-mode: \\[haskell-mode] + Puts the current buffer in haskell mode. + +haskell-compile: \\[haskell-compile] + Compiles file in current buffer. + +haskell-load: \\[haskell-load] + Loads file in current buffer. + +haskell-run-file: \\[haskell-run-file] + Runs file in the current buffer. + +haskell-pad: \\[haskell-pad] + Creates a scratch pad for the current module. + +haskell-optimizers: \\[haskell-optimizers] + Shows the list of available optimizers. Commands for turning them on/off. + +haskell-printers: \\[haskell-printers] + Shows the list of available printers. Commands for turning them on/off. + +haskell-command: \\[haskell-command] + Prompts for a command to be sent to the command interface. You don't + need to put the : before the command. + +haskell-quit: \\[haskell-quit] + Terminates the haskell process. + +haskell-switch: \\[haskell-switch] + Switches to the inferior Haskell buffer (*haskell*) and positions the + cursor at the end of the buffer. + +haskell-kill: \\[haskell-kill] + Kill the current contents of the *haskell* buffer. + +haskell-interrupt: \\[haskell-interrupt] + Interrupts haskell process and resets it. + +haskell-edit-unit: \\[haskell-edit-unit] + Edit the .hu file for the unit containing this file. + +The usual comint functions are also available. In particular, the +following are all available: + +comint-bol: Beginning of line, but skip prompt. Bound to C-a by default. +comint-delchar-or-maybe-eof: Delete char, unless at end of buffer, in + which case send EOF to process. Bound to C-d by default. + +Note however, that the default keymap bindings provided shadow some of +the default comint mode bindings, so that you may want to bind them +to your choice of keys. + +Comint mode's dynamic completion of filenames in the buffer is available. +(Q.v. comint-dynamic-complete, comint-dynamic-list-completions.) + +If you accidentally suspend your process, use \\[comint-continue-subjob] +to continue it." + + (interactive) + (comint-mode) + (setq comint-prompt-regexp haskell-prompt-pattern) + ;; Customise in inferior-haskell-mode-hook + (inferior-haskell-mode-variables) + (setq major-mode 'inferior-haskell-mode) + (setq mode-name "Inferior Haskell") + (setq mode-line-process '(": %s : busy")) + (use-local-map inferior-haskell-mode-map) + (setq comint-input-filter 'haskell-input-filter) + (setq comint-input-sentinel 'ignore) + (setq comint-get-old-input 'haskell-get-old-input) + (run-hooks 'inferior-haskell-mode-hook) + ;Do this after the hook so the user can mung INPUT-RING-SIZE w/his hook. + ;The test is so we don't lose history if we run comint-mode twice in + ;a buffer. + (setq haskell-prompt-ring (make-ring comint-input-ring-size))) + + +(defun haskell-input-filter (str) + "Don't save whitespace." + (not (string-match "\\s *" str))) + + + +;;; ================================================================== +;;; Random utilities +;;; ================================================================== + + +;;; This keeps track of the status of the haskell process. +;;; Values are: +;;; busy -- The process is busy. +;;; ready -- The process is ready for a command. +;;; input -- The process is waiting for input. +;;; debug -- The process is in the debugger. + +(defvar *haskell-status* 'busy + "Status of the haskell process") + +(defun set-haskell-status (value) + (setq *haskell-status* value) + (haskell-update-mode-line)) + +(defun get-haskell-status () + *haskell-status*) + +(defun haskell-update-mode-line () + (save-excursion + (set-buffer *haskell-buffer*) + (cond ((eq *haskell-status* 'ready) + (setq mode-line-process '(": %s: ready"))) + ((eq *haskell-status* 'input) + (setq mode-line-process '(": %s: input"))) + ((eq *haskell-status* 'busy) + (setq mode-line-process '(": %s: busy"))) + ((eq *haskell-status* 'debug) + (setq mode-line-process '(": %s: debug"))) + (t + (haskell-mode-error "Confused about status of haskell process!"))) + ;; Yes, this is the officially sanctioned technique for forcing + ;; a redisplay of the mode line. + (set-buffer-modified-p (buffer-modified-p)))) + + +(defun haskell-send-to-process (string) + (process-send-string "haskell" string) + (process-send-string "haskell" "\n")) + + + +;;; ================================================================== +;;; Handle input in haskell process buffer; history commands. +;;; ================================================================== + +(defun haskell-get-old-input () + "Get old input text from Haskell process buffer." + (save-excursion + (if (re-search-forward haskell-prompt-pattern (point-max) 'move) + (goto-char (match-beginning 0))) + (cond ((re-search-backward haskell-prompt-pattern (point-min) t) + (comint-skip-prompt) + (let ((temp (point))) + (end-of-line) + (buffer-substring temp (point))))))) + + +(defun haskell-send-input () + "Send input to Haskell while in the process buffer" + (interactive) + (if (eq (get-haskell-status) 'debug) + (comint-send-input) + (haskell-send-input-aux))) + +(defun haskell-send-input-aux () + ;; Note that the input string does not include its terminal newline. + (let ((proc (get-buffer-process (current-buffer)))) + (if (not proc) + (haskell-mode-error "Current buffer has no process!") + (let* ((pmark (process-mark proc)) + (pmark-val (marker-position pmark)) + (input (if (>= (point) pmark-val) + (buffer-substring pmark (point)) + (let ((copy (funcall comint-get-old-input))) + (goto-char pmark) + (insert copy) + copy)))) + (insert ?\n) + (if (funcall comint-input-filter input) + (ring-insert input-ring input)) + (funcall comint-input-sentinel input) + (set-marker (process-mark proc) (point)) + (set-marker comint-last-input-end (point)) + (haskell-send-to-process input))))) + + + +;;; ================================================================== +;;; Minibuffer input stuff +;;; ================================================================== + +;;; Haskell input history retrieval commands (taken from comint.el) +;;; M-p -- previous input M-n -- next input + +(defvar haskell-minibuffer-local-map nil + "Local map for minibuffer when in Haskell") + +(if haskell-minibuffer-local-map + nil + (progn + (setq haskell-minibuffer-local-map + (copy-keymap minibuffer-local-map)) + ;; Haskell commands + (define-key haskell-minibuffer-local-map "\ep" 'haskell-previous-input) + (define-key haskell-minibuffer-local-map "\en" 'haskell-next-input) + )) + +(defun haskell-previous-input (arg) + "Cycle backwards through input history." + (interactive "*p") + (let ((len (ring-length haskell-prompt-ring))) + (cond ((<= len 0) + (message "Empty input ring.") + (ding)) + (t + (cond ((eq last-command 'haskell-previous-input) + (delete-region (mark) (point)) + (set-mark (point))) + (t + (setq input-ring-index + (if (> arg 0) -1 + (if (< arg 0) 1 0))) + (push-mark (point)))) + (setq input-ring-index (comint-mod (+ input-ring-index arg) len)) + (insert (ring-ref haskell-prompt-ring input-ring-index)) + (setq this-command 'haskell-previous-input)) + ))) + +(defun haskell-next-input (arg) + "Cycle forwards through input history." + (interactive "*p") + (haskell-previous-input (- arg))) + +(defvar haskell-last-input-match "" + "Last string searched for by Haskell input history search, for defaulting. +Buffer local variable.") + +(defun haskell-previous-input-matching (str) + "Searches backwards through input history for substring match" + (interactive (let ((s (read-from-minibuffer + (format "Command substring (default %s): " + haskell-last-input-match)))) + (list (if (string= s "") haskell-last-input-match s)))) + (setq haskell-last-input-match str) ; update default + (let ((str (regexp-quote str)) + (len (ring-length haskell-prompt-ring)) + (n 0)) + (while (and (<= n len) + (not (string-match str (ring-ref haskell-prompt-ring n)))) + (setq n (+ n 1))) + (cond ((<= n len) (haskell-previous-input (+ n 1))) + (t (haskell-mode-error "Not found."))))) + + +;;; Actually read an expression from the minibuffer using the new keymap. + +(defun haskell-get-expression (prompt) + (let ((exp (read-from-minibuffer prompt nil haskell-minibuffer-local-map))) + (ring-insert haskell-prompt-ring exp) + exp)) + + + +;;; ================================================================== +;;; Handle output from Haskell process +;;; ================================================================== + +;;; The haskell process produces output with embedded control codes. +;;; These control codes are used to keep track of what kind of input +;;; the haskell process is expecting. Ordinary output is just displayed. +;;; +;;; This is kind of complicated because control sequences can be broken +;;; across multiple batches of text received from the haskell process. +;;; If the string ends in the middle of a control sequence, save it up +;;; for the next call. + +(defvar *haskell-saved-output* nil) + +;;; On the Next, there is some kind of race condition that causes stuff +;;; sent to the Haskell subprocess before it has really started to be lost. +;;; The point of this variable is to force the Emacs side to wait until +;;; Haskell has started and printed out its banner before sending it +;;; anything. See start-haskell below. + +(defvar *haskell-process-alive* nil) + +(defun haskell-output-filter (process str) + "Filter for output from Yale Haskell command interface" + ;; *** debug + ;;(let ((buffer (get-buffer-create "haskell-output"))) + ;; (save-excursion + ;; (set-buffer buffer) + ;; (insert str))) + (setq *haskell-process-alive* t) + (let ((next 0) + (start 0) + (data (match-data))) + (unwind-protect + (progn + ;; If there was saved output from last time, glue it in front of the + ;; newly received input. + (if *haskell-saved-output* + (progn + (setq str (concat *haskell-saved-output* str)) + (setq *haskell-saved-output* nil))) + ;; Loop, looking for complete command sequences. + ;; Set next to point to the first one. + ;; start points to first character to be processed. + (while (setq next + (string-match *haskell-message-match-regexp* + str start)) + ;; Display any intervening ordinary text. + (if (not (eq next start)) + (haskell-display-output (substring str start next))) + ;; Now dispatch on the particular command sequence found. + ;; Handler functions are called with the string and start index + ;; as arguments, and should return the index of the "next" + ;; character. + (let ((end (match-end 0))) + (haskell-handle-message str next) + (setq start end))) + ;; Look to see whether the string ends with an incomplete + ;; command sequence. + ;; If so, save the tail of the string for next time. + (if (and (setq next + (string-match *haskell-message-prefix-regexp* str start)) + (eq (match-end 0) (length str))) + (setq *haskell-saved-output* (substring str next)) + (setq next (length str))) + ;; Display any leftover ordinary text. + (if (not (eq next start)) + (haskell-display-output (substring str start next)))) + (store-match-data data)))) + +(defvar *haskell-message-match-regexp* + "EMACS:.*\n") + +(defvar *haskell-message-prefix-regexp* + "E\\(M\\(A\\(C\\(S\\(:.*\\)?\\)?\\)?\\)?\\)?") + +(defvar *haskell-message-dispatch* + '(("EMACS:debug\n" . haskell-got-debug) + ("EMACS:busy\n" . haskell-got-busy) + ("EMACS:input\n" . haskell-got-input) + ("EMACS:ready\n" . haskell-got-ready) + ("EMACS:printers .*\n" . haskell-got-printers) + ("EMACS:optimizers .*\n" . haskell-got-optimizers) + ("EMACS:message .*\n" . haskell-got-message) + ("EMACS:error\n" . haskell-got-error) + )) + +(defun haskell-handle-message (str idx) + (let ((list *haskell-message-dispatch*) + (fn nil)) + (while (and list (null fn)) + (if (eq (string-match (car (car list)) str idx) idx) + (setq fn (cdr (car list))) + (setq list (cdr list)))) + (if (null fn) + (haskell-mode-error "Garbled message from Haskell!") + (let ((end (match-end 0))) + (funcall fn str idx end) + end)))) + + +(defun haskell-message-data (string start end) + (let ((real-start (+ (string-match " " string start) 1)) + (real-end (- end 1))) + (substring string real-start real-end))) + +(defun haskell-got-debug (string start end) + (beep) + (message "In the debugger!") + (set-haskell-status 'debug)) + +(defun haskell-got-busy (string start end) + (set-haskell-status 'busy)) + +(defun haskell-got-input (string start end) + (if haskell-auto-switch-input + (progn + (haskell-switch) + (beep))) + (set-haskell-status 'input) + (message "Waiting for input...")) + +(defun haskell-got-ready (string start end) + (set-haskell-status 'ready)) + +(defun haskell-got-printers (string start end) + (haskell-printers-update (haskell-message-data string start end))) + +(defun haskell-got-optimizers (string start end) + (haskell-optimizers-update (haskell-message-data string start end))) + +(defun haskell-got-message (string start end) + (message "%s" (haskell-message-data string start end))) + +(defun haskell-got-error (string start end) +; [[!chak! I found that annoying]] (beep) + (message "Haskell error.")) + + +;;; Displays output at end of given buffer. +;;; This function only ensures that the output is visible, without +;;; selecting the buffer in which it is displayed. +;;; Note that just using display-buffer instead of all this rigamarole +;;; won't work; you need to temporarily select the window containing +;;; the *haskell-buffer*, or else the display won't be scrolled to show +;;; the new output. +;;; *** This should really position the window in the buffer so that +;;; *** the point is on the last line of the window. + +(defun haskell-display-output (str) + (let ((window (selected-window))) + (unwind-protect + (progn + (pop-to-buffer *haskell-buffer*) + (haskell-display-output-aux str)) + (select-window window)))) + +(defun haskell-display-output-aux (str) + (haskell-move-marker) + (insert str) + (haskell-move-marker)) + + + +;;; ================================================================== +;;; Interactive commands +;;; ================================================================== + + +;;; HASKELL +;;; ------- +;;; +;;; This is the function that fires up the inferior haskell process. + +(defun haskell () + "Run an inferior Haskell process with input and output via buffer *haskell*. +Takes the program name from the variable haskell-program-name. +Runs the hooks from inferior-haskell-mode-hook +(after the comint-mode-hook is run). +\(Type \\[describe-mode] in the process buffer for a list of commands.)" + (interactive) + (if (not (haskell-process-exists-p)) + (start-haskell))) + +(defun start-haskell () + (message "Starting haskell subprocess...") + ;; Kill old haskell process. Normally this routine is only called + ;; after checking haskell-process-exists-p, but things can get + ;; screwed up if you rename the *haskell* buffer while leaving the + ;; old process running. This forces it to get rid of the old process + ;; and start a new one. + (if (get-process "haskell") + (delete-process "haskell")) + (let ((haskell-buffer + (apply 'make-comint + "haskell" + (or haskell-program-name + (haskell-mode-error "Haskell-program-name undefined!")) + nil + nil))) + (save-excursion + (set-buffer haskell-buffer) + (inferior-haskell-mode)) + (haskell-session-init) + ;; Wait for process to get started before sending it anything + ;; to avoid race condition on NeXT. + (setq *haskell-process-alive* nil) + (while (not *haskell-process-alive*) + (sleep-for 1)) + (haskell-send-to-process ":(use-emacs-interface)") + (haskell-printers-set haskell-initial-printers nil) + (display-buffer haskell-buffer)) + (message "Starting haskell subprocess... Done.")) + + +(defun haskell-process-exists-p () + (let ((haskell-buffer (get-buffer *haskell-buffer*))) + (and haskell-buffer (comint-check-proc haskell-buffer)))) + + + +;;; Initialize things on the emacs side, and tell haskell that it's +;;; talking to emacs. + +(defun haskell-session-init () + (set-haskell-status 'busy) + (setq *last-loaded* nil) + (setq *last-module* haskell-main-module) + (setq *last-pad* haskell-main-pad) + (setq *haskell-saved-output* nil) + (haskell-create-main-pad) + (set-process-filter (get-process "haskell") 'haskell-output-filter) + ) + + +(defun haskell-create-main-pad () + (let ((buffer (get-buffer-create haskell-main-pad))) + (save-excursion + (set-buffer buffer) + (haskell-mode)) + (haskell-record-pad-mapping + haskell-main-pad haskell-main-module nil) + buffer)) + + +;;; Called from evaluation and compilation commands to start up a Haskell +;;; process if none is already in progress. + +(defun haskell-maybe-create-process () + (cond ((haskell-process-exists-p) + t) + (haskell-auto-create-process + (start-haskell)) + (t + (haskell-mode-error "No Haskell process!")))) + + + +;;; HASKELL-GET-PAD +;;; ------------------------------------------------------------------ + +;;; This always puts the pad buffer in the "other" window. +;;; Having it wipe out the .hs file window is clearly the wrong +;;; behavior. + +(defun haskell-get-pad () + "Creates a new scratch pad for the current module. +Signals an error if the current buffer is not a .hs file." + (interactive) + (let ((fname (buffer-file-name))) + (if fname + (do-get-pad fname (current-buffer)) + (haskell-mode-error "Not in a .hs buffer!")))) + + +(defun do-get-pad (fname buff) + (let* ((mname (or (haskell-get-modname buff) + (read-no-blanks-input "Scratch pad for module? " nil))) + (pname (haskell-lookup-pad mname fname)) + (pbuff nil)) + ;; Generate the base name of the pad buffer, then create the + ;; buffer. The actual name of the pad buffer may be something + ;; else because of name collisions. + (if (not pname) + (progn + (setq pname (format "*%s-pad*" mname)) + (setq pbuff (generate-new-buffer pname)) + (setq pname (buffer-name pbuff)) + (haskell-record-pad-mapping pname mname fname) + ) + (setq pbuff (get-buffer pname))) + ;; Make sure the pad buffer is in haskell mode. + (pop-to-buffer pbuff) + (haskell-mode))) + + + +;;; HASKELL-SWITCH +;;; ------------------------------------------------------------------ + +(defun haskell-switch () + "Switches to \*haskell\* buffer." + (interactive) + (haskell-maybe-create-process) + (pop-to-buffer *haskell-buffer*) + (push-mark) + (goto-char (point-max))) + + + +;;; HASKELL-KILL +;;; ------------------------------------------------------------------ + +(defun haskell-kill () + "Kill contents of *haskell* buffer. \\[haskell-kill]" + (interactive) + (save-excursion + (set-buffer *haskell-buffer*) + (beginning-of-buffer) + (let ((mark (point))) + (end-of-buffer) + (kill-region mark (point))))) + + + +;;; HASKELL-COMMAND +;;; ------------------------------------------------------------------ + +(defun haskell-command (str) + "Format STRING as a haskell command and send it to haskell process. \\[haskell-command]" + (interactive "sHaskell command: ") + (haskell-send-to-process (format ":%s" str))) + + +;;; HASKELL-EVAL and HASKELL-RUN +;;; ------------------------------------------------------------------ + +(defun haskell-eval () + "Evaluate expression in current module. \\[haskell-eval]" + (interactive) + (haskell-maybe-create-process) + (haskell-eval-aux (haskell-get-expression "Haskell expression: ") + "emacs-eval")) + +(defun haskell-run () + "Run Haskell Dialogue in current module" + (interactive) + (haskell-maybe-create-process) + (haskell-eval-aux (haskell-get-expression "Haskell dialogue: ") + "emacs-run")) + +(defun haskell-run-main () + "Run Dialogue named main in current module" + (interactive) + (haskell-maybe-create-process) + (haskell-eval-aux "main" "emacs-run")) + +(defun haskell-report-type () + "Print the type of the expression." + (interactive) + (haskell-maybe-create-process) + (haskell-eval-aux (haskell-get-expression "Haskell expression: ") + "emacs-report-type")) + +(defun haskell-eval-aux (exp fn) + (cond ((equal *haskell-buffer* (buffer-name)) + ;; In the *haskell* buffer. + (let* ((pname *last-pad*) + (mname *last-module*) + (fname *last-loaded*)) + (haskell-eval-aux-aux exp pname mname fname fn))) + ((buffer-file-name) + ;; In a .hs file. + (let* ((fname (buffer-file-name)) + (mname (haskell-get-modname (current-buffer))) + (pname (haskell-lookup-pad mname fname))) + (haskell-eval-aux-aux exp pname mname fname fn))) + (t + ;; In a pad. + (let* ((pname (buffer-name (current-buffer))) + (mname (haskell-get-module-from-pad pname)) + (fname (haskell-get-file-from-pad pname))) + (haskell-eval-aux-aux exp pname mname fname fn))) + )) + +(defun haskell-eval-aux-aux (exp pname mname fname fn) + (haskell-save-modified-source-files fname) + (haskell-send-to-process (format ":(%s" fn)) + (haskell-send-to-process + (prin1-to-string exp)) + (haskell-send-to-process + (prin1-to-string (or pname fname "interactive"))) + (haskell-send-to-process + (prin1-to-string + (if (and pname (get-buffer pname)) + (save-excursion + (set-buffer pname) + (buffer-string)) + ""))) + (haskell-send-to-process + (format "'|%s|" mname)) + (haskell-send-to-process + (if fname + (prin1-to-string (haskell-maybe-get-unit-file-name fname)) + "'#f")) + (haskell-send-to-process ")") + (setq *last-pad* pname) + (setq *last-module* mname) + (setq *last-loaded* fname)) + + + +;;; HASKELL-RUN-FILE, HASKELL-LOAD, HASKELL-COMPILE +;;; ------------------------------------------------------------------ + +(defun haskell-run-file () + "Runs Dialogue named main in current file." + (interactive) + (haskell-maybe-create-process) + (let ((fname (haskell-get-file-to-operate-on))) + (haskell-save-modified-source-files fname) + (haskell-send-to-process ":(emacs-run-file") + (haskell-send-to-process (prin1-to-string fname)) + (haskell-send-to-process ")"))) + +(defun haskell-load () + "Load current file." + (interactive) + (haskell-maybe-create-process) + (let ((fname (haskell-get-file-to-operate-on))) + (haskell-save-modified-source-files fname) + (haskell-send-to-process ":(emacs-load-file") + (haskell-send-to-process (prin1-to-string fname)) + (haskell-send-to-process ")"))) + +(defun haskell-compile () + "Compile current file." + (interactive) + (haskell-maybe-create-process) + (let ((fname (haskell-get-file-to-operate-on))) + (haskell-save-modified-source-files fname) + (haskell-send-to-process ":(emacs-compile-file") + (haskell-send-to-process (prin1-to-string fname)) + (haskell-send-to-process ")"))) + + +(defun haskell-get-file-to-operate-on () + (cond ((equal *haskell-buffer* (buffer-name)) + ;; When called from the haskell process buffer, prompt for a file. + (call-interactively 'haskell-get-file/prompt)) + ((buffer-file-name) + ;; When called from a .hs file buffer, use the unit file + ;; associated with it, if there is one. + (haskell-maybe-get-unit-file-name (buffer-file-name))) + (t + ;; When called from a pad, use the file that the module the + ;; pad belongs to lives in. + (haskell-maybe-get-unit-file-name + (haskell-get-file-from-pad (buffer-name (current-buffer))))))) + +(defun haskell-get-file/prompt (filename) + (interactive "fHaskell file: ") + filename) + + + +;;; HASKELL-EXIT +;;; ------------------------------------------------------------------ + +(defun haskell-exit () + "Quit the haskell process." + (interactive) + (cond ((not (haskell-process-exists-p)) + (message "No process currently running.")) + ((y-or-n-p "Do you really want to quit Haskell? ") + (haskell-send-to-process ":quit") + ;; If we were running the tutorial, mark the temp buffer as unmodified + ;; so we don't get asked about saving it later. + (if (and *ht-temp-buffer* + (get-buffer *ht-temp-buffer*)) + (save-excursion + (set-buffer *ht-temp-buffer*) + (set-buffer-modified-p nil))) + ;; Try to remove the haskell output buffer from the screen. + (bury-buffer *haskell-buffer*) + (replace-buffer-in-windows *haskell-buffer*)) + (t + nil))) + + +;;; HASKELL-INTERRUPT +;;; ------------------------------------------------------------------ + +(defun haskell-interrupt () + "Interrupt the haskell process." + (interactive) + (if (haskell-process-exists-p) + (haskell-send-to-process "\C-c"))) + + + +;;; HASKELL-EDIT-UNIT +;;; ------------------------------------------------------------------ + +(defun haskell-edit-unit () + "Edit the .hu file." + (interactive) + (let ((fname (buffer-file-name))) + (if fname + (let ((find-file-not-found-hooks (list 'haskell-new-unit)) + (file-not-found nil) + (units-fname (haskell-get-unit-file-name fname))) + (find-file-other-window units-fname) + ;; If creating a new file, initialize it to contain the name + ;; of the haskell source file. + (if file-not-found + (save-excursion + (insert + (if (string= (file-name-directory fname) + (file-name-directory units-fname)) + (file-name-nondirectory fname) + fname) + "\n")))) + (haskell-mode-error "Not in a .hs buffer!")))) + +(defun haskell-new-unit () + (setq file-not-found t)) + + +;;; Look for a comment like "-- unit:" at top of file. +;;; If not found, assume unit file has same name as the buffer but +;;; a .hu extension. + +(defun haskell-get-unit-file-name (fname) + (or (haskell-get-unit-file-name-from-file fname) + (concat (haskell-strip-file-extension fname) ".hu"))) + +(defun haskell-maybe-get-unit-file-name (fname) + (or (haskell-get-unit-file-name-from-file fname) + (haskell-strip-file-extension fname))) + +(defun haskell-get-unit-file-name-from-file (fname) + (let ((buffer (get-file-buffer fname))) + (if buffer + (save-excursion + (beginning-of-buffer) + (if (re-search-forward "-- unit:[ \t]*" (point-max) t) + (let ((beg (match-end 0))) + (end-of-line) + (buffer-substring beg (point))) + nil)) + nil))) + + + + +;;; ================================================================== +;;; Support for printers/optimizers menus +;;; ================================================================== + +;;; This code was adapted from the standard buff-menu.el code. + +(defvar haskell-menu-mode-map nil "") + +(if (not haskell-menu-mode-map) + (progn + (setq haskell-menu-mode-map (make-keymap)) + (suppress-keymap haskell-menu-mode-map t) + (define-key haskell-menu-mode-map "m" 'hm-mark) + (define-key haskell-menu-mode-map "u" 'hm-unmark) + (define-key haskell-menu-mode-map "x" 'hm-exit) + (define-key haskell-menu-mode-map "q" 'hm-exit) + (define-key haskell-menu-mode-map " " 'next-line) + (define-key haskell-menu-mode-map "\177" 'hm-backup-unmark) + (define-key haskell-menu-mode-map "?" 'describe-mode))) + +;; Printers Menu mode is suitable only for specially formatted data. + +(put 'haskell-menu-mode 'mode-class 'special) + +(defun haskell-menu-mode () + "Major mode for editing Haskell flags. +Each line describes a flag. +Letters do not insert themselves; instead, they are commands. +m -- mark flag (turn it on) +u -- unmark flag (turn it off) +x -- exit; tell the Haskell process to update the flags, then leave menu. +q -- exit; same as x. +Precisely,\\{haskell-menu-mode-map}" + (kill-all-local-variables) + (use-local-map haskell-menu-mode-map) + (setq truncate-lines t) + (setq buffer-read-only t) + (setq major-mode 'haskell-menu-mode) + (setq mode-name "Haskell Flags Menu") + ;; These are all initialized elsewhere + (make-local-variable 'hm-current-flags) + (make-local-variable 'hm-request-fn) + (make-local-variable 'hm-update-fn) + (run-hooks 'haskell-menu-mode-hook)) + + +(defun haskell-menu (help-file buffer request-fn update-fn) + (haskell-maybe-create-process) + (if (get-buffer buffer) + (progn + (pop-to-buffer buffer) + (goto-char (point-min))) + (progn + (pop-to-buffer buffer) + (insert-file-contents help-file) + (haskell-menu-mode) + (setq hm-request-fn request-fn) + (setq hm-update-fn update-fn) + )) + (hm-mark-current) + (message "m = mark; u = unmark; x = execute; q = quit; ? = more help.")) + + + +;;; A line that starts with *hm-marked* is a menu item turned on. +;;; A line that starts with *hm-unmarked* is turned off. +;;; A line that starts with anything else is just random text and is +;;; ignored by commands that deal with menu items. + +(defvar *hm-marked* " on") +(defvar *hm-unmarked* " ") +(defvar *hm-marked-regexp* " on \\w") +(defvar *hm-unmarked-regexp* " \\w") + +(defun hm-mark () + "Mark flag to be turned on." + (interactive) + (beginning-of-line) + (cond ((looking-at *hm-marked-regexp*) + (forward-line 1)) + ((looking-at *hm-unmarked-regexp*) + (let ((buffer-read-only nil)) + (delete-char (length *hm-unmarked*)) + (insert *hm-marked*) + (forward-line 1))) + (t + (forward-line 1)))) + +(defun hm-unmark () + "Unmark flag." + (interactive) + (beginning-of-line) + (cond ((looking-at *hm-unmarked-regexp*) + (forward-line 1)) + ((looking-at *hm-marked-regexp*) + (let ((buffer-read-only nil)) + (delete-char (length *hm-marked*)) + (insert *hm-unmarked*) + (forward-line 1))) + (t + (forward-line 1)))) + +(defun hm-backup-unmark () + "Move up and unmark." + (interactive) + (forward-line -1) + (hm-unmark) + (forward-line -1)) + + +;;; Actually make the changes. + +(defun hm-exit () + "Update flags, then leave menu." + (interactive) + (hm-execute) + (hm-quit)) + +(defun hm-execute () + "Tell haskell process to tweak flags." + (interactive) + (save-excursion + (goto-char (point-min)) + (let ((flags-on nil) + (flags-off nil)) + (while (not (eq (point) (point-max))) + (cond ((looking-at *hm-unmarked-regexp*) + (setq flags-off (cons (hm-flag) flags-off))) + ((looking-at *hm-marked-regexp*) + (setq flags-on (cons (hm-flag) flags-on))) + (t + nil)) + (forward-line 1)) + (funcall hm-update-fn flags-on flags-off)))) + + +(defun hm-quit () + (interactive) + "Make the menu go away." + (bury-buffer (current-buffer)) + (replace-buffer-in-windows (current-buffer))) + +(defun hm-flag () + (save-excursion + (beginning-of-line) + (forward-char 6) + (let ((beg (point))) + ;; End of flag name marked by tab or two spaces. + (re-search-forward "\t\\| ") + (buffer-substring beg (match-beginning 0))))) + + +;;; Update the menu to mark only those items currently turned on. + +(defun hm-mark-current () + (funcall hm-request-fn) + (save-excursion + (goto-char (point-min)) + (while (not (eq (point) (point-max))) + (cond ((and (looking-at *hm-unmarked-regexp*) + (hm-item-currently-on-p (hm-flag))) + (hm-mark)) + ((and (looking-at *hm-marked-regexp*) + (not (hm-item-currently-on-p (hm-flag)))) + (hm-unmark)) + (t + (forward-line 1)))))) + + +;;; See if a menu item is turned on. + +(defun hm-item-currently-on-p (item) + (member-string= item hm-current-flags)) + +(defun member-string= (item list) + (cond ((null list) + nil) + ((string= item (car list)) + list) + (t + (member-string= item (cdr list))))) + + + +;;; Make the menu for printers. + +(defvar *haskell-printers-help* + (concat (getenv "HASKELL") "/emacs-tools/printer-help.txt") + "Help file for printers.") + +(defvar *haskell-printers-buffer* "*Haskell printers*") + +(defun haskell-printers () + "Set printers interactively." + (interactive) + (haskell-menu + *haskell-printers-help* + *haskell-printers-buffer* + 'haskell-printers-inquire + 'haskell-printers-set)) + +(defun haskell-printers-inquire () + (setq hm-current-flags t) + (haskell-send-to-process ":(emacs-send-printers)") + (while (eq hm-current-flags t) + (sleep-for 1))) + +(defun haskell-printers-update (data) + (setq hm-current-flags (read data))) + +(defun haskell-printers-set (flags-on flags-off) + (haskell-send-to-process ":(emacs-set-printers '") + (haskell-send-to-process (prin1-to-string flags-on)) + (haskell-send-to-process ")")) + + +;;; Equivalent stuff for the optimizers menu + +(defvar *haskell-optimizers-help* + (concat (getenv "HASKELL") "/emacs-tools/optimizer-help.txt") + "Help file for optimizers.") + +(defvar *haskell-optimizers-buffer* "*Haskell optimizers*") + +(defun haskell-optimizers () + "Set optimizers interactively." + (interactive) + (haskell-menu + *haskell-optimizers-help* + *haskell-optimizers-buffer* + 'haskell-optimizers-inquire + 'haskell-optimizers-set)) + +(defun haskell-optimizers-inquire () + (setq hm-current-flags t) + (haskell-send-to-process ":(emacs-send-optimizers)") + (while (eq hm-current-flags t) + (sleep-for 1))) + +(defun haskell-optimizers-update (data) + (setq hm-current-flags (read data))) + +(defun haskell-optimizers-set (flags-on flags-off) + (haskell-send-to-process ":(emacs-set-optimizers '") + (haskell-send-to-process (prin1-to-string flags-on)) + (haskell-send-to-process ")")) + + + +;;; ================================================================== +;;; Random utilities +;;; ================================================================== + + +;;; Keep track of the association between pads, modules, and files. +;;; The global variable is a list of (pad-buffer-name module-name file-name) +;;; lists. + +(defvar *haskell-pad-mappings* () + "Associates pads with their corresponding module and file.") + +(defun haskell-record-pad-mapping (pname mname fname) + (setq *haskell-pad-mappings* + (cons (list pname mname fname) *haskell-pad-mappings*))) + +(defun haskell-get-module-from-pad (pname) + (car (cdr (assoc pname *haskell-pad-mappings*)))) + +(defun haskell-get-file-from-pad (pname) + (car (cdr (cdr (assoc pname *haskell-pad-mappings*))))) + +(defun haskell-lookup-pad (mname fname) + (let ((pname (haskell-lookup-pad-aux mname fname *haskell-pad-mappings*))) + (if (and pname (get-buffer pname)) + pname + nil))) + +(defun haskell-lookup-pad-aux (mname fname list) + (cond ((null list) + nil) + ((and (equal mname (car (cdr (car list)))) + (equal fname (car (cdr (cdr (car list)))))) + (car (car list))) + (t + (haskell-lookup-pad-aux mname fname (cdr list))))) + + + +;;; Save any modified .hs and .hu files. +;;; Yes, the two set-buffer calls really seem to be necessary. It seems +;;; that y-or-n-p makes emacs forget we had temporarily selected some +;;; other buffer, and if you just do save-buffer directly it will end +;;; up trying to save the current buffer instead. The built-in +;;; save-some-buffers function has this problem.... + +(defun haskell-save-modified-source-files (filename) + (let ((buffers (buffer-list)) + (found-any nil)) + (while buffers + (let ((buffer (car buffers))) + (if (and (buffer-modified-p buffer) + (save-excursion + (set-buffer buffer) + (and buffer-file-name + (haskell-source-file-p buffer-file-name) + (setq found-any t) + (or (null haskell-ask-before-saving) + (and filename (string= buffer-file-name filename)) + (y-or-n-p + (format "Save file %s? " buffer-file-name)))))) + (save-excursion + (set-buffer buffer) + (save-buffer)))) + (setq buffers (cdr buffers))) + (if found-any + (message "") + (message "(No files need saving)")))) + +(defun haskell-source-file-p (filename) + (or (string-match "\\.hs$" filename) + (string-match "\\.lhs$" filename) + (string-match "\\.hi$" filename) + (string-match "\\.hu$" filename))) + + + +;;; Buffer utilities + +(defun haskell-move-marker () + "Moves the marker and point to the end of buffer" + (set-marker comint-last-input-end (point-max)) + (set-marker (process-mark (get-process "haskell")) (point-max)) + (goto-char (point-max))) + + + +;;; Extract the name of the module the point is in, from the given buffer. + +(defvar *haskell-re-module-hs* "^module\\s *") +(defvar *haskell-re-module-lhs* "^>\\s *module\\s *") +(defvar *haskell-re-modname* "[A-Z]\\([a-z]\\|[A-Z]\\|[0-9]\\|'\\|_\\)*") + +(defun haskell-get-modname (buff) + "Get module name in BUFFER that point is in." + (save-excursion + (set-buffer buff) + (let ((regexp (if (haskell-lhs-filename-p (buffer-file-name)) + *haskell-re-module-lhs* + *haskell-re-module-hs*))) + (if (or (looking-at regexp) + (re-search-backward regexp (point-min) t) + (re-search-forward regexp (point-max) t)) + (progn + (goto-char (match-end 0)) + (if (looking-at *haskell-re-modname*) + (buffer-substring (match-beginning 0) (match-end 0)) + (haskell-mode-error "Module name not found!!"))) + "Main")))) + + +;;; Strip file extensions. +;;; Only strip off extensions we know about; e.g. +;;; "foo.hs" -> "foo" but "foo.bar" -> "foo.bar". + +(defvar *haskell-filename-regexp* "\\(.*\\)\\.\\(hs\\|lhs\\)$") + +(defun haskell-strip-file-extension (filename) + "Strip off the extension from a filename." + (if (string-match *haskell-filename-regexp* filename) + (substring filename (match-beginning 1) (match-end 1)) + filename)) + + +;;; Is this a .lhs filename? + +(defun haskell-lhs-filename-p (filename) + (string-match ".*\\.lhs$" filename)) + + +;;; Haskell mode error + +(defun haskell-mode-error (msg) + "Show MSG in message line as an error from the haskell mode." + (error (concat "Haskell mode: " msg))) + + + +;;; ================================================================== +;;; User customization +;;; ================================================================== + +(defvar haskell-load-hook nil + "This hook is run when haskell is loaded in. +This is a good place to put key bindings." + ) + +(run-hooks 'haskell-load-hook) + + + + +;;;====================================================================== +;;; Tutorial mode setup +;;;====================================================================== + +;;; Set up additional key bindings for tutorial mode. + +(defvar ht-mode-map (make-sparse-keymap)) + +(haskell-establish-key-bindings ht-mode-map) +(define-key ht-mode-map "\C-c\C-f" 'ht-next-page) +(define-key ht-mode-map "\C-c\C-b" 'ht-prev-page) +(define-key ht-mode-map "\C-c\C-l" 'ht-restore-page) +(define-key ht-mode-map "\C-c?" 'describe-mode) + +(defun haskell-tutorial-mode () + "Major mode for running the Haskell tutorial. +You can use these commands: +\\{ht-mode-map}" + (interactive) + (kill-all-local-variables) + (use-local-map ht-mode-map) + (setq major-mode 'haskell-tutorial-mode) + (setq mode-name "Haskell Tutorial") + (set-syntax-table haskell-mode-syntax-table) + (run-hooks 'haskell-mode-hook)) + + +(defun haskell-tutorial () + "Run the haskell tutorial." + (interactive) + (ht-load-tutorial) + (ht-make-buffer) + (ht-display-page) + (haskell-maybe-create-process) + (haskell-send-to-process ":(emacs-set-printers '(interactive))") + ) + + +;;; Load the tutorial file into a read-only buffer. Do not display this +;;; buffer. + +(defun ht-load-tutorial () + (let ((buffer (get-buffer *ht-file-buffer*))) + (if buffer + (save-excursion + (set-buffer buffer) + (beginning-of-buffer)) + (save-excursion + (set-buffer (setq buffer (get-buffer-create *ht-file-buffer*))) + (let ((fname (substitute-in-file-name *ht-source-file*))) + (if (file-readable-p fname) + (ht-load-tutorial-aux fname) + (call-interactively 'ht-load-tutorial-aux))))))) + +(defun ht-load-tutorial-aux (filename) + (interactive "fTutorial file: ") + (insert-file filename) + (set-buffer-modified-p nil) + (setq buffer-read-only t) + (beginning-of-buffer)) + + +;;; Create a buffer to use for messing about with each page of the tutorial. +;;; Put the buffer into haskell-tutorial-mode. + +(defun ht-make-buffer () + (find-file (concat "/tmp/" (make-temp-name "ht") ".lhs")) + (setq *ht-temp-buffer* (buffer-name)) + (haskell-tutorial-mode)) + + +;;; Commands for loading text into the tutorial pad buffer + +(defun ht-next-page () + "Go to the next tutorial page." + (interactive) + (if (ht-goto-next-page) + (ht-display-page) + (beep))) + +(defun ht-goto-next-page () + (let ((buff (current-buffer))) + (unwind-protect + (progn + (set-buffer *ht-file-buffer*) + (search-forward "\C-l" nil t)) + (set-buffer buff)))) + +(defun ht-prev-page () + "Go to the previous tutorial page." + (interactive) + (if (ht-goto-prev-page) + (ht-display-page) + (beep))) + +(defun ht-goto-prev-page () + (let ((buff (current-buffer))) + (unwind-protect + (progn + (set-buffer *ht-file-buffer*) + (search-backward "\C-l" nil t)) + (set-buffer buff)))) + +(defun ht-goto-page (arg) + "Go to the tutorial page specified as the argument." + (interactive "sGo to page: ") + (if (ht-searchfor-page (format "Page: %s " arg)) + (ht-display-page) + (beep))) + +(defun ht-goto-section (arg) + "Go to the tutorial section specified as the argument." + (interactive "sGo to section: ") + (if (ht-searchfor-page (format "Section: %s " arg)) + (ht-display-page) + (beep))) + +(defun ht-searchfor-page (search-string) + (let ((buff (current-buffer))) + (unwind-protect + (progn + (set-buffer *ht-file-buffer*) + (let ((point (point))) + (beginning-of-buffer) + (if (search-forward search-string nil t) + t + (progn + (goto-char point) + nil)))) + (set-buffer buff)))) + +(defun ht-restore-page () + (interactive) + (let ((old-point (point))) + (ht-display-page) + (goto-char old-point))) + +(defun ht-display-page () + (set-buffer *ht-file-buffer*) + (let* ((beg (progn + (if (search-backward "\C-l" nil t) + (forward-line 1) + (beginning-of-buffer)) + (point))) + (end (progn + (if (search-forward "\C-l" nil t) + (beginning-of-line) + (end-of-buffer)) + (point))) + (text (buffer-substring beg end))) + (set-buffer *ht-temp-buffer*) + (erase-buffer) + (insert text) + (beginning-of-buffer))) + + + +;;;====================================================================== +;;; Menu bar stuff +;;;====================================================================== + +;;; This only works in Emacs version 19, so it's in a separate file for now. + +(if (featurep 'menu-bar) + (load-library "haskell-menu")) + diff --git a/ghc/CONTRIB/haskell-modes/yale/original/README b/ghc/CONTRIB/haskell-modes/yale/original/README new file mode 100644 index 0000000000..bb22105391 --- /dev/null +++ b/ghc/CONTRIB/haskell-modes/yale/original/README @@ -0,0 +1,5 @@ +This directory contains GNU Emacs support for editing Haskell files. +We don't yet have a fancy editing mode, but haskell.el contains stuff +for running Haskell as an inferior process from Emacs with key bindings +for evaluating code from buffers, etc. Look at the comments in haskell.el +for more information. diff --git a/ghc/CONTRIB/haskell-modes/yale/original/comint.el b/ghc/CONTRIB/haskell-modes/yale/original/comint.el new file mode 100644 index 0000000000..e690005aa8 --- /dev/null +++ b/ghc/CONTRIB/haskell-modes/yale/original/comint.el @@ -0,0 +1,1524 @@ +;;; -*-Emacs-Lisp-*- General command interpreter in a window stuff +;;; Copyright Olin Shivers (1988). +;;; Please imagine a long, tedious, legalistic 5-page gnu-style copyright +;;; notice appearing here to the effect that you may use this code any +;;; way you like, as long as you don't charge money for it, remove this +;;; notice, or hold me liable for its results. + +;;; The changelog is at the end of this file. + +;;; Please send me bug reports, bug fixes, and extensions, so that I can +;;; merge them into the master source. +;;; - Olin Shivers (shivers@cs.cmu.edu) + +;;; This hopefully generalises shell mode, lisp mode, tea mode, soar mode,... +;;; This file defines a general command-interpreter-in-a-buffer package +;;; (comint mode). The idea is that you can build specific process-in-a-buffer +;;; modes on top of comint mode -- e.g., lisp, shell, scheme, T, soar, .... +;;; This way, all these specific packages share a common base functionality, +;;; and a common set of bindings, which makes them easier to use (and +;;; saves code, implementation time, etc., etc.). + +;;; Several packages are already defined using comint mode: +;;; - cmushell.el defines a shell-in-a-buffer mode. +;;; - cmulisp.el defines a simple lisp-in-a-buffer mode. +;;; Cmushell and cmulisp mode are similar to, and intended to replace, +;;; their counterparts in the standard gnu emacs release (in shell.el). +;;; These replacements are more featureful, robust, and uniform than the +;;; released versions. The key bindings in lisp mode are also more compatible +;;; with the bindings of Hemlock and Zwei (the Lisp Machine emacs). +;;; +;;; - The file cmuscheme.el defines a scheme-in-a-buffer mode. +;;; - The file tea.el tunes scheme and inferior-scheme modes for T. +;;; - The file soar.el tunes lisp and inferior-lisp modes for Soar. +;;; - cmutex.el defines tex and latex modes that invoke tex, latex, bibtex, +;;; previewers, and printers from within emacs. +;;; - background.el allows csh-like job control inside emacs. +;;; It is pretty easy to make new derived modes for other processes. + +;;; For documentation on the functionality provided by comint mode, and +;;; the hooks available for customising it, see the comments below. +;;; For further information on the standard derived modes (shell, +;;; inferior-lisp, inferior-scheme, ...), see the relevant source files. + +;;; For hints on converting existing process modes (e.g., tex-mode, +;;; background, dbx, gdb, kermit, prolog, telnet) to use comint-mode +;;; instead of shell-mode, see the notes at the end of this file. + +(provide 'comint) +(defconst comint-version "2.01") + + + + + + + + + + + + + + + + + + + + + +;;; Brief Command Documentation: +;;;============================================================================ +;;; Comint Mode Commands: (common to all derived modes, like cmushell & cmulisp +;;; mode) +;;; +;;; m-p comint-previous-input Cycle backwards in input history +;;; m-n comint-next-input Cycle forwards +;;; m-s comint-previous-similar-input Previous similar input +;;; c-c r comint-previous-input-matching Search backwards in input history +;;; return comint-send-input +;;; c-a comint-bol Beginning of line; skip prompt. +;;; c-d comint-delchar-or-maybe-eof Delete char unless at end of buff. +;;; c-c c-u comint-kill-input ^u +;;; c-c c-w backward-kill-word ^w +;;; c-c c-c comint-interrupt-subjob ^c +;;; c-c c-z comint-stop-subjob ^z +;;; c-c c-\ comint-quit-subjob ^\ +;;; c-c c-o comint-kill-output Delete last batch of process output +;;; c-c c-r comint-show-output Show last batch of process output +;;; +;;; Not bound by default in comint-mode +;;; send-invisible Read a line w/o echo, and send to proc +;;; (These are bound in shell-mode) +;;; comint-dynamic-complete Complete filename at point. +;;; comint-dynamic-list-completions List completions in help buffer. +;;; comint-replace-by-expanded-filename Expand and complete filename at point; +;;; replace with expanded/completed name. +;;; comint-kill-subjob No mercy. +;;; comint-continue-subjob Send CONT signal to buffer's process +;;; group. Useful if you accidentally +;;; suspend your process (with C-c C-z). +;;; +;;; Bound for RMS -- I prefer the input history stuff, but you might like 'em. +;;; m-P comint-msearch-input Search backwards for prompt +;;; m-N comint-psearch-input Search forwards for prompt +;;; C-cR comint-msearch-input-matching Search backwards for prompt & string + +;;; comint-mode-hook is the comint mode hook. Basically for your keybindings. +;;; comint-load-hook is run after loading in this package. + + + + + +;;; Buffer Local Variables: +;;;============================================================================ +;;; Comint mode buffer local variables: +;;; comint-prompt-regexp - string comint-bol uses to match prompt. +;;; comint-last-input-end - marker For comint-kill-output command +;;; input-ring-size - integer For the input history +;;; input-ring - ring mechanism +;;; input-ring-index - marker ... +;;; comint-last-input-match - string ... +;;; comint-get-old-input - function Hooks for specific +;;; comint-input-sentinel - function process-in-a-buffer +;;; comint-input-filter - function modes. +;;; comint-input-send - function +;;; comint-eol-on-send - boolean + +(defvar comint-prompt-regexp "^" + "Regexp to recognise prompts in the inferior process. +Defaults to \"^\", the null string at BOL. + +Good choices: + Canonical Lisp: \"^[^> ]*>+:? *\" (Lucid, franz, kcl, T, cscheme, oaklisp) + Lucid Common Lisp: \"^\\(>\\|\\(->\\)+\\) *\" + franz: \"^\\(->\\|<[0-9]*>:\\) *\" + kcl: \"^>+ *\" + shell: \"^[^#$%>]*[#$%>] *\" + T: \"^>+ *\" + +This is a good thing to set in mode hooks.") + +(defvar input-ring-size 30 + "Size of input history ring.") + +;;; Here are the per-interpreter hooks. +(defvar comint-get-old-input (function comint-get-old-input-default) + "Function that submits old text in comint mode. +This function is called when return is typed while the point is in old text. +It returns the text to be submitted as process input. The default is +comint-get-old-input-default, which grabs the current line, and strips off +leading text matching comint-prompt-regexp") + +(defvar comint-input-sentinel (function ignore) + "Called on each input submitted to comint mode process by comint-send-input. +Thus it can, for instance, track cd/pushd/popd commands issued to the csh.") + +(defvar comint-input-filter + (function (lambda (str) (not (string-match "\\`\\s *\\'" str)))) + "Predicate for filtering additions to input history. +Only inputs answering true to this function are saved on the input +history list. Default is to save anything that isn't all whitespace") + +(defvar comint-input-sender (function comint-simple-send) + "Function to actually send to PROCESS the STRING submitted by user. +Usually this is just 'comint-simple-send, but if your mode needs to +massage the input string, this is your hook. This is called from +the user command comint-send-input. comint-simple-send just sends +the string plus a newline.") + +(defvar comint-eol-on-send 'T + "If non-nil, then jump to the end of the line before sending input to process. +See COMINT-SEND-INPUT") + +(defvar comint-mode-hook '() + "Called upon entry into comint-mode") + +(defvar comint-mode-map nil) + +(defun comint-mode () + "Major mode for interacting with an inferior interpreter. +Interpreter name is same as buffer name, sans the asterisks. +Return at end of buffer sends line as input. +Return not at end copies rest of line to end and sends it. +Setting mode variable comint-eol-on-send means jump to the end of the line +before submitting new input. + +This mode is typically customised to create inferior-lisp-mode, +shell-mode, etc.. This can be done by setting the hooks +comint-input-sentinel, comint-input-filter, comint-input-sender and +comint-get-old-input to appropriate functions, and the variable +comint-prompt-regexp to the appropriate regular expression. + +An input history is maintained of size input-ring-size, and +can be accessed with the commands comint-next-input [\\[comint-next-input]] and +comint-previous-input [\\[comint-previous-input]]. Commands not keybound by +default are send-invisible, comint-dynamic-complete, and +comint-list-dynamic-completions. + +If you accidentally suspend your process, use \\[comint-continue-subjob] +to continue it. + +\\{comint-mode-map} + +Entry to this mode runs the hooks on comint-mode-hook" + (interactive) + (let ((old-ring (and (assq 'input-ring (buffer-local-variables)) + (boundp 'input-ring) + input-ring)) + (old-ptyp comint-ptyp)) ; preserve across local var kill. gross. + (kill-all-local-variables) + (setq major-mode 'comint-mode) + (setq mode-name "Comint") + (setq mode-line-process '(": %s")) + (use-local-map comint-mode-map) + (make-local-variable 'comint-last-input-end) + (setq comint-last-input-end (make-marker)) + (make-local-variable 'comint-last-input-match) + (setq comint-last-input-match "") + (make-local-variable 'comint-prompt-regexp) ; Don't set; default + (make-local-variable 'input-ring-size) ; ...to global val. + (make-local-variable 'input-ring) + (make-local-variable 'input-ring-index) + (setq input-ring-index 0) + (make-local-variable 'comint-get-old-input) + (make-local-variable 'comint-input-sentinel) + (make-local-variable 'comint-input-filter) + (make-local-variable 'comint-input-sender) + (make-local-variable 'comint-eol-on-send) + (make-local-variable 'comint-ptyp) + (setq comint-ptyp old-ptyp) + (run-hooks 'comint-mode-hook) + ;Do this after the hook so the user can mung INPUT-RING-SIZE w/his hook. + ;The test is so we don't lose history if we run comint-mode twice in + ;a buffer. + (setq input-ring (if (ring-p old-ring) old-ring + (make-ring input-ring-size))))) + +;;; The old-ptyp stuff above is because we have to preserve the value of +;;; comint-ptyp across calls to comint-mode, in spite of the +;;; kill-all-local-variables that it does. Blech. Hopefully, this will all +;;; go away when a later release fixes the signalling bug. + +(if comint-mode-map + nil + (setq comint-mode-map (make-sparse-keymap)) + (define-key comint-mode-map "\ep" 'comint-previous-input) + (define-key comint-mode-map "\en" 'comint-next-input) + (define-key comint-mode-map "\es" 'comint-previous-similar-input) + (define-key comint-mode-map "\C-m" 'comint-send-input) + (define-key comint-mode-map "\C-d" 'comint-delchar-or-maybe-eof) + (define-key comint-mode-map "\C-a" 'comint-bol) + (define-key comint-mode-map "\C-c\C-u" 'comint-kill-input) + (define-key comint-mode-map "\C-c\C-w" 'backward-kill-word) + (define-key comint-mode-map "\C-c\C-c" 'comint-interrupt-subjob) + (define-key comint-mode-map "\C-c\C-z" 'comint-stop-subjob) + (define-key comint-mode-map "\C-c\C-\\" 'comint-quit-subjob) + (define-key comint-mode-map "\C-c\C-o" 'comint-kill-output) + (define-key comint-mode-map "\C-cr" 'comint-previous-input-matching) + (define-key comint-mode-map "\C-c\C-r" 'comint-show-output) + ;;; Here's the prompt-search stuff I installed for RMS to try... + (define-key comint-mode-map "\eP" 'comint-msearch-input) + (define-key comint-mode-map "\eN" 'comint-psearch-input) + (define-key comint-mode-map "\C-cR" 'comint-msearch-input-matching)) + + +;;; This function is used to make a full copy of the comint mode map, +;;; so that client modes won't interfere with each other. This function +;;; isn't necessary in emacs 18.5x, but we keep it around for 18.4x versions. +(defun full-copy-sparse-keymap (km) + "Recursively copy the sparse keymap KM" + (cond ((consp km) + (cons (full-copy-sparse-keymap (car km)) + (full-copy-sparse-keymap (cdr km)))) + (t km))) + +(defun comint-check-proc (buffer-name) + "True if there is a process associated w/buffer BUFFER-NAME, and +it is alive (status RUN or STOP)." + (let ((proc (get-buffer-process buffer-name))) + (and proc (memq (process-status proc) '(run stop))))) + +;;; Note that this guy, unlike shell.el's make-shell, barfs if you pass it () +;;; for the second argument (program). +(defun make-comint (name program &optional startfile &rest switches) + (let* ((buffer (get-buffer-create (concat "*" name "*"))) + (proc (get-buffer-process buffer))) + ;; If no process, or nuked process, crank up a new one and put buffer in + ;; comint mode. Otherwise, leave buffer and existing process alone. + (cond ((or (not proc) (not (memq (process-status proc) '(run stop)))) + (save-excursion + (set-buffer buffer) + (comint-mode)) ; Install local vars, mode, keymap, ... + (comint-exec buffer name program startfile switches))) + buffer)) + +(defvar comint-ptyp t + "True if communications via pty; false if by pipe. Buffer local. +This is to work around a bug in emacs process signalling.") + +(defun comint-exec (buffer name command startfile switches) + "Fires up a process in buffer for comint modes. +Blasts any old process running in the buffer. Doesn't set the buffer mode. +You can use this to cheaply run a series of processes in the same comint +buffer." + (save-excursion + (set-buffer buffer) + (let ((proc (get-buffer-process buffer))) ; Blast any old process. + (if proc (delete-process proc))) + ;; Crank up a new process + (let ((proc (comint-exec-1 name buffer command switches))) + (make-local-variable 'comint-ptyp) + (setq comint-ptyp process-connection-type) ; T if pty, NIL if pipe. + ;; Jump to the end, and set the process mark. + (goto-char (point-max)) + (set-marker (process-mark proc) (point))) + ;; Feed it the startfile. + (cond (startfile + ;;This is guaranteed to wait long enough + ;;but has bad results if the comint does not prompt at all + ;; (while (= size (buffer-size)) + ;; (sleep-for 1)) + ;;I hope 1 second is enough! + (sleep-for 1) + (goto-char (point-max)) + (insert-file-contents startfile) + (setq startfile (buffer-substring (point) (point-max))) + (delete-region (point) (point-max)) + (comint-send-string proc startfile))) + buffer)) + +;;; This auxiliary function cranks up the process for comint-exec in +;;; the appropriate environment. It is twice as long as it should be +;;; because emacs has two distinct mechanisms for manipulating the +;;; process environment, selected at compile time with the +;;; MAINTAIN-ENVIRONMENT #define. In one case, process-environment +;;; is bound; in the other it isn't. + +(defun comint-exec-1 (name buffer command switches) + (if (boundp 'process-environment) ; Not a completely reliable test. + (let ((process-environment + (comint-update-env process-environment + (list (format "TERMCAP=emacs:co#%d:tc=unknown" + (screen-width)) + "TERM=emacs" + "EMACS=t")))) + (apply 'start-process name buffer command switches)) + + (let ((tcapv (getenv "TERMCAP")) + (termv (getenv "TERM")) + (emv (getenv "EMACS"))) + (unwind-protect + (progn (setenv "TERMCAP" (format "emacs:co#%d:tc=unknown" + (screen-width))) + (setenv "TERM" "emacs") + (setenv "EMACS" "t") + (apply 'start-process name buffer command switches)) + (setenv "TERMCAP" tcapv) + (setenv "TERM" termv) + (setenv "EMACS" emv))))) + + + +;; This is just (append new old-env) that compresses out shadowed entries. +;; It's also pretty ugly, mostly due to elisp's horrible iteration structures. +(defun comint-update-env (old-env new) + (let ((ans (reverse new)) + (vars (mapcar (function (lambda (vv) + (and (string-match "^[^=]*=" vv) + (substring vv 0 (match-end 0))))) + new))) + (while old-env + (let* ((vv (car old-env)) ; vv is var=value + (var (and (string-match "^[^=]*=" vv) + (substring vv 0 (match-end 0))))) + (setq old-env (cdr old-env)) + (cond ((not (and var (comint-mem var vars))) + (if var (setq var (cons var vars))) + (setq ans (cons vv ans)))))) + (nreverse ans))) + +;;; This should be in emacs, but it isn't. +(defun comint-mem (item list &optional elt=) + "Test to see if ITEM is equal to an item in LIST. +Option comparison function ELT= defaults to equal." + (let ((elt= (or elt= (function equal))) + (done nil)) + (while (and list (not done)) + (if (funcall elt= item (car list)) + (setq done list) + (setq list (cdr list)))) + done)) + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +;;; Ring Code +;;;============================================================================ +;;; This code defines a ring data structure. A ring is a +;;; (hd-index tl-index . vector) +;;; list. You can insert to, remove from, and rotate a ring. When the ring +;;; fills up, insertions cause the oldest elts to be quietly dropped. +;;; +;;; HEAD = index of the newest item on the ring. +;;; TAIL = index of the oldest item on the ring. +;;; +;;; These functions are used by the input history mechanism, but they can +;;; be used for other purposes as well. + +(defun ring-p (x) + "T if X is a ring; NIL otherwise." + (and (consp x) (integerp (car x)) + (consp (cdr x)) (integerp (car (cdr x))) + (vectorp (cdr (cdr x))))) + +(defun make-ring (size) + "Make a ring that can contain SIZE elts" + (cons 1 (cons 0 (make-vector (+ size 1) nil)))) + +(defun ring-plus1 (index veclen) + "INDEX+1, with wraparound" + (let ((new-index (+ index 1))) + (if (= new-index veclen) 0 new-index))) + +(defun ring-minus1 (index veclen) + "INDEX-1, with wraparound" + (- (if (= 0 index) veclen index) 1)) + +(defun ring-length (ring) + "Number of elts in the ring." + (let ((hd (car ring)) (tl (car (cdr ring))) (siz (length (cdr (cdr ring))))) + (let ((len (if (<= hd tl) (+ 1 (- tl hd)) (+ 1 tl (- siz hd))))) + (if (= len siz) 0 len)))) + +(defun ring-empty-p (ring) + (= 0 (ring-length ring))) + +(defun ring-insert (ring item) + "Insert a new item onto the ring. If the ring is full, dump the oldest +item to make room." + (let* ((vec (cdr (cdr ring))) (len (length vec)) + (new-hd (ring-minus1 (car ring) len))) + (setcar ring new-hd) + (aset vec new-hd item) + (if (ring-empty-p ring) ;overflow -- dump one off the tail. + (setcar (cdr ring) (ring-minus1 (car (cdr ring)) len))))) + +(defun ring-remove (ring) + "Remove the oldest item retained on the ring." + (if (ring-empty-p ring) (error "Ring empty") + (let ((tl (car (cdr ring))) (vec (cdr (cdr ring)))) + (set-car (cdr ring) (ring-minus1 tl (length vec))) + (aref vec tl)))) + +;;; This isn't actually used in this package. I just threw it in in case +;;; someone else wanted it. If you want rotating-ring behavior on your history +;;; retrieval (analagous to kill ring behavior), this function is what you +;;; need. I should write the yank-input and yank-pop-input-or-kill to go with +;;; this, and not bind it to a key by default, so it would be available to +;;; people who want to bind it to a key. But who would want it? Blech. +(defun ring-rotate (ring n) + (if (not (= n 0)) + (if (ring-empty-p ring) ;Is this the right error check? + (error "ring empty") + (let ((hd (car ring)) (tl (car (cdr ring))) (vec (cdr (cdr ring)))) + (let ((len (length vec))) + (while (> n 0) + (setq tl (ring-plus1 tl len)) + (aset ring tl (aref ring hd)) + (setq hd (ring-plus1 hd len)) + (setq n (- n 1))) + (while (< n 0) + (setq hd (ring-minus1 hd len)) + (aset vec hd (aref vec tl)) + (setq tl (ring-minus1 tl len)) + (setq n (- n 1)))) + (set-car ring hd) + (set-car (cdr ring) tl))))) + +(defun comint-mod (n m) + "Returns N mod M. M is positive. Answer is guaranteed to be non-negative, +and less than m." + (let ((n (% n m))) + (if (>= n 0) n + (+ n + (if (>= m 0) m (- m)))))) ; (abs m) + +(defun ring-ref (ring index) + (let ((numelts (ring-length ring))) + (if (= numelts 0) (error "indexed empty ring") + (let* ((hd (car ring)) (tl (car (cdr ring))) (vec (cdr (cdr ring))) + (index (comint-mod index numelts)) + (vec-index (comint-mod (+ index hd) + (length vec)))) + (aref vec vec-index))))) + + +;;; Input history retrieval commands +;;; M-p -- previous input M-n -- next input +;;; C-c r -- previous input matching +;;; =========================================================================== + +(defun comint-previous-input (arg) + "Cycle backwards through input history." + (interactive "*p") + (let ((len (ring-length input-ring))) + (cond ((<= len 0) + (message "Empty input ring") + (ding)) + ((not (comint-after-pmark-p)) + (message "Not after process mark") + (ding)) + (t + (cond ((eq last-command 'comint-previous-input) + (delete-region (mark) (point))) + ((eq last-command 'comint-previous-similar-input) + (delete-region + (process-mark (get-buffer-process (current-buffer))) + (point))) + (t + (setq input-ring-index + (if (> arg 0) -1 + (if (< arg 0) 1 0))) + (push-mark (point)))) + (setq input-ring-index (comint-mod (+ input-ring-index arg) len)) + (message "%d" (1+ input-ring-index)) + (insert (ring-ref input-ring input-ring-index)) + (setq this-command 'comint-previous-input))))) + +(defun comint-next-input (arg) + "Cycle forwards through input history." + (interactive "*p") + (comint-previous-input (- arg))) + +(defvar comint-last-input-match "" + "Last string searched for by comint input history search, for defaulting. +Buffer local variable.") + +(defun comint-previous-input-matching (str) + "Searches backwards through input history for substring match." + (interactive (let* ((last-command last-command) ; preserve around r-f-m + (s (read-from-minibuffer + (format "Command substring (default %s): " + comint-last-input-match)))) + (list (if (string= s "") comint-last-input-match s)))) +; (interactive "sCommand substring: ") + (setq comint-last-input-match str) ; update default + (if (not (eq last-command 'comint-previous-input)) + (setq input-ring-index -1)) + (let ((str (regexp-quote str)) + (len (ring-length input-ring)) + (n (+ input-ring-index 1))) + (while (and (< n len) (not (string-match str (ring-ref input-ring n)))) + (setq n (+ n 1))) + (cond ((< n len) + (comint-previous-input (- n input-ring-index))) + (t (if (eq last-command 'comint-previous-input) + (setq this-command 'comint-previous-input)) + (message "Not found.") + (ding))))) + + +;;; These next three commands are alternatives to the input history commands -- +;;; comint-next-input, comint-previous-input and +;;; comint-previous-input-matching. They search through the process buffer +;;; text looking for occurrences of the prompt. RMS likes them better; +;;; I don't. Bound to M-P, M-N, and C-c R (uppercase P, N, and R) for +;;; now. Try'em out. Go with what you like... + +;;; comint-msearch-input-matching prompts for a string, not a regexp. +;;; This could be considered to be the wrong thing. I decided to keep it +;;; simple, and not make the user worry about regexps. This, of course, +;;; limits functionality. + +(defun comint-psearch-input () + "Search forwards for next occurrence of prompt and skip to end of line. +\(prompt is anything matching regexp comint-prompt-regexp)" + (interactive) + (if (re-search-forward comint-prompt-regexp (point-max) t) + (end-of-line) + (error "No occurrence of prompt found"))) + +(defun comint-msearch-input () + "Search backwards for previous occurrence of prompt and skip to end of line. +Search starts from beginning of current line." + (interactive) + (let ((p (save-excursion + (beginning-of-line) + (cond ((re-search-backward comint-prompt-regexp (point-min) t) + (end-of-line) + (point)) + (t nil))))) + (if p (goto-char p) + (error "No occurrence of prompt found")))) + +(defun comint-msearch-input-matching (str) + "Search backwards for occurrence of prompt followed by STRING. +STRING is prompted for, and is NOT a regular expression." + (interactive (let ((s (read-from-minibuffer + (format "Command (default %s): " + comint-last-input-match)))) + (list (if (string= s "") comint-last-input-match s)))) +; (interactive "sCommand: ") + (setq comint-last-input-match str) ; update default + (let* ((r (concat comint-prompt-regexp (regexp-quote str))) + (p (save-excursion + (beginning-of-line) + (cond ((re-search-backward r (point-min) t) + (end-of-line) + (point)) + (t nil))))) + (if p (goto-char p) + (error "No match")))) + +;;; +;;; Similar input -- contributed by ccm and highly winning. +;;; +;;; Reenter input, removing back to the last insert point if it exists. +;;; +(defvar comint-last-similar-string "" + "The string last used in a similar string search.") +(defun comint-previous-similar-input (arg) + "Reenters the last input that matches the string typed so far. If repeated +successively older inputs are reentered. If arg is 1, it will go back +in the history, if -1 it will go forward." + (interactive "p") + (if (not (comint-after-pmark-p)) + (error "Not after process mark")) + (if (not (eq last-command 'comint-previous-similar-input)) + (setq input-ring-index -1 + comint-last-similar-string + (buffer-substring + (process-mark (get-buffer-process (current-buffer))) + (point)))) + (let* ((size (length comint-last-similar-string)) + (len (ring-length input-ring)) + (n (+ input-ring-index arg)) + entry) + (while (and (< n len) + (or (< (length (setq entry (ring-ref input-ring n))) size) + (not (equal comint-last-similar-string + (substring entry 0 size))))) + (setq n (+ n arg))) + (cond ((< n len) + (setq input-ring-index n) + (if (eq last-command 'comint-previous-similar-input) + (delete-region (mark) (point)) ; repeat + (push-mark (point))) ; 1st time + (insert (substring entry size))) + (t (message "Not found.") (ding) (sit-for 1))) + (message "%d" (1+ input-ring-index)))) + + + + + + + + + +(defun comint-send-input () + "Send input to process. After the process output mark, sends all text +from the process mark to point as input to the process. Before the +process output mark, calls value of variable comint-get-old-input to retrieve +old input, copies it to the end of the buffer, and sends it. A terminal +newline is also inserted into the buffer and sent to the process. In either +case, value of variable comint-input-sentinel is called on the input before +sending it. The input is entered into the input history ring, if value of +variable comint-input-filter returns non-nil when called on the input. + +If variable comint-eol-on-send is non-nil, then point is moved to the end of +line before sending the input. + +comint-get-old-input, comint-input-sentinel, and comint-input-filter are chosen +according to the command interpreter running in the buffer. E.g., +If the interpreter is the csh, + comint-get-old-input is the default: take the current line, discard any + initial string matching regexp comint-prompt-regexp. + comint-input-sentinel monitors input for \"cd\", \"pushd\", and \"popd\" + commands. When it sees one, it cd's the buffer. + comint-input-filter is the default: returns T if the input isn't all white + space. + +If the comint is Lucid Common Lisp, + comint-get-old-input snarfs the sexp ending at point. + comint-input-sentinel does nothing. + comint-input-filter returns NIL if the input matches input-filter-regexp, + which matches (1) all whitespace (2) :a, :c, etc. + +Similarly for Soar, Scheme, etc.." + (interactive) + ;; Note that the input string does not include its terminal newline. + (let ((proc (get-buffer-process (current-buffer)))) + (if (not proc) (error "Current buffer has no process") + (let* ((pmark (process-mark proc)) + (pmark-val (marker-position pmark)) + (input (if (>= (point) pmark-val) + (progn (if comint-eol-on-send (end-of-line)) + (buffer-substring pmark (point))) + (let ((copy (funcall comint-get-old-input))) + (goto-char pmark) + (insert copy) + copy)))) + (insert ?\n) + (if (funcall comint-input-filter input) (ring-insert input-ring input)) + (funcall comint-input-sentinel input) + (funcall comint-input-sender proc input) + (set-marker (process-mark proc) (point)) + (set-marker comint-last-input-end (point)))))) + +(defun comint-get-old-input-default () + "Default for comint-get-old-input: take the current line, and discard +any initial text matching comint-prompt-regexp." + (save-excursion + (beginning-of-line) + (comint-skip-prompt) + (let ((beg (point))) + (end-of-line) + (buffer-substring beg (point))))) + +(defun comint-skip-prompt () + "Skip past the text matching regexp comint-prompt-regexp. +If this takes us past the end of the current line, don't skip at all." + (let ((eol (save-excursion (end-of-line) (point)))) + (if (and (looking-at comint-prompt-regexp) + (<= (match-end 0) eol)) + (goto-char (match-end 0))))) + + +(defun comint-after-pmark-p () + "Is point after the process output marker?" + ;; Since output could come into the buffer after we looked at the point + ;; but before we looked at the process marker's value, we explicitly + ;; serialise. This is just because I don't know whether or not emacs + ;; services input during execution of lisp commands. + (let ((proc-pos (marker-position + (process-mark (get-buffer-process (current-buffer)))))) + (<= proc-pos (point)))) + +(defun comint-simple-send (proc string) + "Default function for sending to PROC input STRING. +This just sends STRING plus a newline. To override this, +set the hook COMINT-INPUT-SENDER." + (comint-send-string proc string) + (comint-send-string proc "\n")) + +(defun comint-bol (arg) + "Goes to the beginning of line, then skips past the prompt, if any. +If a prefix argument is given (\\[universal-argument]), then no prompt skip +-- go straight to column 0. + +The prompt skip is done by skipping text matching the regular expression +comint-prompt-regexp, a buffer local variable. + +If you don't like this command, reset c-a to beginning-of-line +in your hook, comint-mode-hook." + (interactive "P") + (beginning-of-line) + (if (null arg) (comint-skip-prompt))) + +;;; These two functions are for entering text you don't want echoed or +;;; saved -- typically passwords to ftp, telnet, or somesuch. +;;; Just enter m-x send-invisible and type in your line. + +(defun comint-read-noecho (prompt) + "Prompt the user with argument PROMPT. Read a single line of text +without echoing, and return it. Note that the keystrokes comprising +the text can still be recovered (temporarily) with \\[view-lossage]. This +may be a security bug for some applications." + (let ((echo-keystrokes 0) + (answ "") + tem) + (if (and (stringp prompt) (not (string= (message prompt) ""))) + (message prompt)) + (while (not(or (= (setq tem (read-char)) ?\^m) + (= tem ?\n))) + (setq answ (concat answ (char-to-string tem)))) + (message "") + answ)) + +(defun send-invisible (str) + "Read a string without echoing, and send it to the process running +in the current buffer. A new-line is additionally sent. String is not +saved on comint input history list. +Security bug: your string can still be temporarily recovered with +\\[view-lossage]." +; (interactive (list (comint-read-noecho "Enter non-echoed text"))) + (interactive "P") ; Defeat snooping via C-x esc + (let ((proc (get-buffer-process (current-buffer)))) + (if (not proc) (error "Current buffer has no process") + (comint-send-string proc + (if (stringp str) str + (comint-read-noecho "Enter non-echoed text"))) + (comint-send-string proc "\n")))) + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +;;; Low-level process communication + +(defvar comint-input-chunk-size 512 + "*Long inputs send to comint processes are broken up into chunks of this size. +If your process is choking on big inputs, try lowering the value.") + +(defun comint-send-string (proc str) + "Send PROCESS the contents of STRING as input. +This is equivalent to process-send-string, except that long input strings +are broken up into chunks of size comint-input-chunk-size. Processes +are given a chance to output between chunks. This can help prevent processes +from hanging when you send them long inputs on some OS's." + (let* ((len (length str)) + (i (min len comint-input-chunk-size))) + (process-send-string proc (substring str 0 i)) + (while (< i len) + (let ((next-i (+ i comint-input-chunk-size))) + (accept-process-output) + (process-send-string proc (substring str i (min len next-i))) + (setq i next-i))))) + +(defun comint-send-region (proc start end) + "Sends to PROC the region delimited by START and END. +This is a replacement for process-send-region that tries to keep +your process from hanging on long inputs. See comint-send-string." + (comint-send-string proc (buffer-substring start end))) + + + + + + + + + + + + + + + + + + +;;; Random input hackage + +(defun comint-kill-output () + "Kill all output from interpreter since last input." + (interactive) + (let ((pmark (process-mark (get-buffer-process (current-buffer))))) + (kill-region comint-last-input-end pmark) + (goto-char pmark) + (insert "*** output flushed ***\n") + (set-marker pmark (point)))) + +(defun comint-show-output () + "Display start of this batch of interpreter output at top of window. +Also put cursor there." + (interactive) + (goto-char comint-last-input-end) + (backward-char) + (beginning-of-line) + (set-window-start (selected-window) (point)) + (end-of-line)) + +(defun comint-interrupt-subjob () + "Interrupt the current subjob." + (interactive) + (interrupt-process nil comint-ptyp)) + +(defun comint-kill-subjob () + "Send kill signal to the current subjob." + (interactive) + (kill-process nil comint-ptyp)) + +(defun comint-quit-subjob () + "Send quit signal to the current subjob." + (interactive) + (quit-process nil comint-ptyp)) + +(defun comint-stop-subjob () + "Stop the current subjob. +WARNING: if there is no current subjob, you can end up suspending +the top-level process running in the buffer. If you accidentally do +this, use \\[comint-continue-subjob] to resume the process. (This +is not a problem with most shells, since they ignore this signal.)" + (interactive) + (stop-process nil comint-ptyp)) + +(defun comint-continue-subjob () + "Send CONT signal to process buffer's process group. +Useful if you accidentally suspend the top-level process." + (interactive) + (continue-process nil comint-ptyp)) + +(defun comint-kill-input () + "Kill all text from last stuff output by interpreter to point." + (interactive) + (let* ((pmark (process-mark (get-buffer-process (current-buffer)))) + (p-pos (marker-position pmark))) + (if (> (point) p-pos) + (kill-region pmark (point))))) + +(defun comint-delchar-or-maybe-eof (arg) + "Delete ARG characters forward, or send an EOF to process if at end of buffer." + (interactive "p") + (if (eobp) + (process-send-eof) + (delete-char arg))) + + + + + + + + + + + + + + + + + + + + + + + +;;; Support for source-file processing commands. +;;;============================================================================ +;;; Many command-interpreters (e.g., Lisp, Scheme, Soar) have +;;; commands that process files of source text (e.g. loading or compiling +;;; files). So the corresponding process-in-a-buffer modes have commands +;;; for doing this (e.g., lisp-load-file). The functions below are useful +;;; for defining these commands. +;;; +;;; Alas, these guys don't do exactly the right thing for Lisp, Scheme +;;; and Soar, in that they don't know anything about file extensions. +;;; So the compile/load interface gets the wrong default occasionally. +;;; The load-file/compile-file default mechanism could be smarter -- it +;;; doesn't know about the relationship between filename extensions and +;;; whether the file is source or executable. If you compile foo.lisp +;;; with compile-file, then the next load-file should use foo.bin for +;;; the default, not foo.lisp. This is tricky to do right, particularly +;;; because the extension for executable files varies so much (.o, .bin, +;;; .lbin, .mo, .vo, .ao, ...). + + +;;; COMINT-SOURCE-DEFAULT -- determines defaults for source-file processing +;;; commands. +;;; +;;; COMINT-CHECK-SOURCE -- if FNAME is in a modified buffer, asks you if you +;;; want to save the buffer before issuing any process requests to the command +;;; interpreter. +;;; +;;; COMINT-GET-SOURCE -- used by the source-file processing commands to prompt +;;; for the file to process. + +;;; (COMINT-SOURCE-DEFAULT previous-dir/file source-modes) +;;;============================================================================ +;;; This function computes the defaults for the load-file and compile-file +;;; commands for tea, soar, cmulisp, and cmuscheme modes. +;;; +;;; - PREVIOUS-DIR/FILE is a pair (directory . filename) from the last +;;; source-file processing command. NIL if there hasn't been one yet. +;;; - SOURCE-MODES is a list used to determine what buffers contain source +;;; files: if the major mode of the buffer is in SOURCE-MODES, it's source. +;;; Typically, (lisp-mode) or (scheme-mode). +;;; +;;; If the command is given while the cursor is inside a string, *and* +;;; the string is an existing filename, *and* the filename is not a directory, +;;; then the string is taken as default. This allows you to just position +;;; your cursor over a string that's a filename and have it taken as default. +;;; +;;; If the command is given in a file buffer whose major mode is in +;;; SOURCE-MODES, then the the filename is the default file, and the +;;; file's directory is the default directory. +;;; +;;; If the buffer isn't a source file buffer (e.g., it's the process buffer), +;;; then the default directory & file are what was used in the last source-file +;;; processing command (i.e., PREVIOUS-DIR/FILE). If this is the first time +;;; the command has been run (PREVIOUS-DIR/FILE is nil), the default directory +;;; is the cwd, with no default file. (\"no default file\" = nil) +;;; +;;; SOURCE-REGEXP is typically going to be something like (tea-mode) +;;; for T programs, (lisp-mode) for Lisp programs, (soar-mode lisp-mode) +;;; for Soar programs, etc. +;;; +;;; The function returns a pair: (default-directory . default-file). + +(defun comint-source-default (previous-dir/file source-modes) + (cond ((and buffer-file-name (memq major-mode source-modes)) + (cons (file-name-directory buffer-file-name) + (file-name-nondirectory buffer-file-name))) + (previous-dir/file) + (t + (cons default-directory nil)))) + + +;;; (COMINT-CHECK-SOURCE fname) +;;;============================================================================ +;;; Prior to loading or compiling (or otherwise processing) a file (in the CMU +;;; process-in-a-buffer modes), this function can be called on the filename. +;;; If the file is loaded into a buffer, and the buffer is modified, the user +;;; is queried to see if he wants to save the buffer before proceeding with +;;; the load or compile. + +(defun comint-check-source (fname) + (let ((buff (get-file-buffer fname))) + (if (and buff + (buffer-modified-p buff) + (y-or-n-p (format "Save buffer %s first? " + (buffer-name buff)))) + ;; save BUFF. + (let ((old-buffer (current-buffer))) + (set-buffer buff) + (save-buffer) + (set-buffer old-buffer))))) + + +;;; (COMINT-GET-SOURCE prompt prev-dir/file source-modes mustmatch-p) +;;;============================================================================ +;;; COMINT-GET-SOURCE is used to prompt for filenames in command-interpreter +;;; commands that process source files (like loading or compiling a file). +;;; It prompts for the filename, provides a default, if there is one, +;;; and returns the result filename. +;;; +;;; See COMINT-SOURCE-DEFAULT for more on determining defaults. +;;; +;;; PROMPT is the prompt string. PREV-DIR/FILE is the (directory . file) pair +;;; from the last source processing command. SOURCE-MODES is a list of major +;;; modes used to determine what file buffers contain source files. (These +;;; two arguments are used for determining defaults). If MUSTMATCH-P is true, +;;; then the filename reader will only accept a file that exists. +;;; +;;; A typical use: +;;; (interactive (comint-get-source "Compile file: " prev-lisp-dir/file +;;; '(lisp-mode) t)) + +;;; This is pretty stupid about strings. It decides we're in a string +;;; if there's a quote on both sides of point on the current line. +(defun comint-extract-string () + "Returns string around point that starts the current line or nil." + (save-excursion + (let* ((point (point)) + (bol (progn (beginning-of-line) (point))) + (eol (progn (end-of-line) (point))) + (start (progn (goto-char point) + (and (search-backward "\"" bol t) + (1+ (point))))) + (end (progn (goto-char point) + (and (search-forward "\"" eol t) + (1- (point)))))) + (and start end + (buffer-substring start end))))) + +(defun comint-get-source (prompt prev-dir/file source-modes mustmatch-p) + (let* ((def (comint-source-default prev-dir/file source-modes)) + (stringfile (comint-extract-string)) + (sfile-p (and stringfile + (file-exists-p stringfile) + (not (file-directory-p stringfile)))) + (defdir (if sfile-p (file-name-directory stringfile) + (car def))) + (deffile (if sfile-p (file-name-nondirectory stringfile) + (cdr def))) + (ans (read-file-name (if deffile (format "%s(default %s) " + prompt deffile) + prompt) + defdir + (concat defdir deffile) + mustmatch-p))) + (list (expand-file-name (substitute-in-file-name ans))))) + +;;; I am somewhat divided on this string-default feature. It seems +;;; to violate the principle-of-least-astonishment, in that it makes +;;; the default harder to predict, so you actually have to look and see +;;; what the default really is before choosing it. This can trip you up. +;;; On the other hand, it can be useful, I guess. I would appreciate feedback +;;; on this. +;;; -Olin + + + + + + + + + + + + + + + + + + + + + + + +;;; Simple process query facility. +;;; =========================================================================== +;;; This function is for commands that want to send a query to the process +;;; and show the response to the user. For example, a command to get the +;;; arglist for a Common Lisp function might send a "(arglist 'foo)" query +;;; to an inferior Common Lisp process. +;;; +;;; This simple facility just sends strings to the inferior process and pops +;;; up a window for the process buffer so you can see what the process +;;; responds with. We don't do anything fancy like try to intercept what the +;;; process responds with and put it in a pop-up window or on the message +;;; line. We just display the buffer. Low tech. Simple. Works good. + +;;; Send to the inferior process PROC the string STR. Pop-up but do not select +;;; a window for the inferior process so that its response can be seen. +(defun comint-proc-query (proc str) + (let* ((proc-buf (process-buffer proc)) + (proc-mark (process-mark proc))) + (display-buffer proc-buf) + (set-buffer proc-buf) ; but it's not the selected *window* + (let ((proc-win (get-buffer-window proc-buf)) + (proc-pt (marker-position proc-mark))) + (comint-send-string proc str) ; send the query + (accept-process-output proc) ; wait for some output + ;; Try to position the proc window so you can see the answer. + ;; This is bogus code. If you delete the (sit-for 0), it breaks. + ;; I don't know why. Wizards invited to improve it. + (if (not (pos-visible-in-window-p proc-pt proc-win)) + (let ((opoint (window-point proc-win))) + (set-window-point proc-win proc-mark) (sit-for 0) + (if (not (pos-visible-in-window-p opoint proc-win)) + (push-mark opoint) + (set-window-point proc-win opoint))))))) + + + + + + + + + + + +;;; Filename completion in a buffer +;;; =========================================================================== +;;; Useful completion functions, courtesy of the Ergo group. +;;; M-<Tab> will complete the filename at the cursor as much as possible +;;; M-? will display a list of completions in the help buffer. + +;;; Three commands: +;;; comint-dynamic-complete Complete filename at point. +;;; comint-dynamic-list-completions List completions in help buffer. +;;; comint-replace-by-expanded-filename Expand and complete filename at point; +;;; replace with expanded/completed name. + +;;; These are not installed in the comint-mode keymap. But they are +;;; available for people who want them. Shell-mode installs them: +;;; (define-key cmushell-mode-map "\M-\t" 'comint-dynamic-complete) +;;; (define-key cmushell-mode-map "\M-?" 'comint-dynamic-list-completions))) +;;; +;;; Commands like this are fine things to put in load hooks if you +;;; want them present in specific modes. Example: +;;; (setq cmushell-load-hook +;;; '((lambda () (define-key lisp-mode-map "\M-\t" +;;; 'comint-replace-by-expanded-filename)))) +;;; + + +(defun comint-match-partial-pathname () + "Returns the string of an existing filename or causes an error." + (if (save-excursion (backward-char 1) (looking-at "\\s ")) "" + (save-excursion + (re-search-backward "[^~/A-Za-z0-9---_.$#,]+") + (re-search-forward "[~/A-Za-z0-9---_.$#,]+") + (substitute-in-file-name + (buffer-substring (match-beginning 0) (match-end 0)))))) + + +(defun comint-replace-by-expanded-filename () +"Replace the filename at point with an expanded, canonicalised, and +completed replacement. +\"Expanded\" means environment variables (e.g., $HOME) and ~'s are +replaced with the corresponding directories. \"Canonicalised\" means .. +and \. are removed, and the filename is made absolute instead of relative. +See functions expand-file-name and substitute-in-file-name. See also +comint-dynamic-complete." + (interactive) + (let* ((pathname (comint-match-partial-pathname)) + (pathdir (file-name-directory pathname)) + (pathnondir (file-name-nondirectory pathname)) + (completion (file-name-completion pathnondir + (or pathdir default-directory)))) + (cond ((null completion) + (message "No completions of %s." pathname) + (ding)) + ((eql completion t) + (message "Unique completion.")) + (t ; this means a string was returned. + (delete-region (match-beginning 0) (match-end 0)) + (insert (expand-file-name (concat pathdir completion))))))) + + +(defun comint-dynamic-complete () + "Dynamically complete the filename at point. +This function is similar to comint-replace-by-expanded-filename, except +that it won't change parts of the filename already entered in the buffer; +it just adds completion characters to the end of the filename." + (interactive) + (let* ((pathname (comint-match-partial-pathname)) + (pathdir (file-name-directory pathname)) + (pathnondir (file-name-nondirectory pathname)) + (completion (file-name-completion pathnondir + (or pathdir default-directory)))) + (cond ((null completion) + (message "No completions of %s." pathname) + (ding)) + ((eql completion t) + (message "Unique completion.")) + (t ; this means a string was returned. + (goto-char (match-end 0)) + (insert (substring completion (length pathnondir))))))) + +(defun comint-dynamic-list-completions () + "List in help buffer all possible completions of the filename at point." + (interactive) + (let* ((pathname (comint-match-partial-pathname)) + (pathdir (file-name-directory pathname)) + (pathnondir (file-name-nondirectory pathname)) + (completions + (file-name-all-completions pathnondir + (or pathdir default-directory)))) + (cond ((null completions) + (message "No completions of %s." pathname) + (ding)) + (t + (let ((conf (current-window-configuration))) + (with-output-to-temp-buffer "*Help*" + (display-completion-list completions)) + (sit-for 0) + (message "Hit space to flush.") + (let ((ch (read-char))) + (if (= ch ?\ ) + (set-window-configuration conf) + (setq unread-command-char ch)))))))) + +; Ergo bindings +; (global-set-key "\M-\t" 'comint-replace-by-expanded-filename) +; (global-set-key "\M-?" 'comint-dynamic-list-completions) +; (define-key shell-mode-map "\M-\t" 'comint-dynamic-complete) + + + + + + + + + + + + + + + + + + + + + + + + + + +;;; Converting process modes to use comint mode +;;; =========================================================================== +;;; Several gnu packages (tex-mode, background, dbx, gdb, kermit, prolog, +;;; telnet are some) use the shell package as clients. Most of them would +;;; be better off using the comint package, but they predate it. +;;; +;;; Altering these packages to use comint mode should greatly +;;; improve their functionality, and is fairly easy. +;;; +;;; Renaming variables +;;; Most of the work is renaming variables and functions. These are the common +;;; ones: +;;; Local variables: +;;; last-input-end comint-last-input-end +;;; last-input-start <unnecessary> +;;; shell-prompt-pattern comint-prompt-regexp +;;; shell-set-directory-error-hook <no equivalent> +;;; Miscellaneous: +;;; shell-set-directory <unnecessary> +;;; shell-mode-map comint-mode-map +;;; Commands: +;;; shell-send-input comint-send-input +;;; shell-send-eof comint-delchar-or-maybe-eof +;;; kill-shell-input comint-kill-input +;;; interrupt-shell-subjob comint-interrupt-subjob +;;; stop-shell-subjob comint-stop-subjob +;;; quit-shell-subjob comint-quit-subjob +;;; kill-shell-subjob comint-kill-subjob +;;; kill-output-from-shell comint-kill-output +;;; show-output-from-shell comint-show-output +;;; copy-last-shell-input Use comint-previous-input/comint-next-input +;;; +;;; LAST-INPUT-START is no longer necessary because inputs are stored on the +;;; input history ring. SHELL-SET-DIRECTORY is gone, its functionality taken +;;; over by SHELL-DIRECTORY-TRACKER, the shell mode's comint-input-sentinel. +;;; Comint mode does not provide functionality equivalent to +;;; shell-set-directory-error-hook; it is gone. +;;; +;;; If you are implementing some process-in-a-buffer mode, called foo-mode, do +;;; *not* create the comint-mode local variables in your foo-mode function. +;;; This is not modular. Instead, call comint-mode, and let *it* create the +;;; necessary comint-specific local variables. Then create the +;;; foo-mode-specific local variables in foo-mode. Set the buffer's keymap to +;;; be foo-mode-map, and its mode to be foo-mode. Set the comint-mode hooks +;;; (comint-prompt-regexp, comint-input-filter, comint-input-sentinel, +;;; comint-get-old-input) that need to be different from the defaults. Call +;;; foo-mode-hook, and you're done. Don't run the comint-mode hook yourself; +;;; comint-mode will take care of it. The following example, from cmushell.el, +;;; is typical: +;;; +;;; (defun shell-mode () +;;; (interactive) +;;; (comint-mode) +;;; (setq comint-prompt-regexp shell-prompt-pattern) +;;; (setq major-mode 'shell-mode) +;;; (setq mode-name "Shell") +;;; (cond ((not shell-mode-map) +;;; (setq shell-mode-map (full-copy-sparse-keymap comint-mode-map)) +;;; (define-key shell-mode-map "\M-\t" 'comint-dynamic-complete) +;;; (define-key shell-mode-map "\M-?" +;;; 'comint-dynamic-list-completions))) +;;; (use-local-map shell-mode-map) +;;; (make-local-variable 'shell-directory-stack) +;;; (setq shell-directory-stack nil) +;;; (setq comint-input-sentinel 'shell-directory-tracker) +;;; (run-hooks 'shell-mode-hook)) +;;; +;;; +;;; Note that make-comint is different from make-shell in that it +;;; doesn't have a default program argument. If you give make-shell +;;; a program name of NIL, it cleverly chooses one of explicit-shell-name, +;;; $ESHELL, $SHELL, or /bin/sh. If you give make-comint a program argument +;;; of NIL, it barfs. Adjust your code accordingly... +;;; + + + + + + + + + + + + + + +;;; Do the user's customisation... + +(defvar comint-load-hook nil + "This hook is run when comint is loaded in. +This is a good place to put keybindings.") + +(run-hooks 'comint-load-hook) + +;;; Change log: +;;; 9/12/89 +;;; - Souped up the filename expansion procedures. +;;; Doc strings are much clearer and more detailed. +;;; Fixed a bug where doing a filename completion when the point +;;; was in the middle of the filename instead of at the end would lose. +;;; +;;; 2/17/90 +;;; - Souped up the command history stuff so that text inserted +;;; by comint-previous-input-matching is removed by following +;;; command history recalls. comint-next/previous-input-matching +;;; is now much more smoothly integrated w/the command history stuff. +;;; - Added comint-eol-on-send flag and comint-input-sender hook. +;;; Comint-input-sender based on code contributed by Jeff Peck +;;; (peck@sun.com). +;;; +;;; 3/13/90 ccm@cmu.cs.edu +;;; - Added comint-previous-similar-input for looking up similar inputs. +;;; - Added comint-send-and-get-output to allow snarfing input from +;;; buffer. +;;; - Added the ability to pick up a source file by positioning over +;;; a string in comint-get-source. +;;; - Added add-hook to make it a little easier for the user to use +;;; multiple hooks. +;;; +;;; 5/22/90 shivers +;;; - Moved Chris' multiplexed ipc stuff to comint-ipc.el. +;;; - Altered Chris' comint-get-source string feature. The string +;;; is only offered as a default if it names an existing file. +;;; - Changed comint-exec to directly crank up the process, instead +;;; of calling the env program. This made background.el happy. +;;; - Added new buffer-local var comint-ptyp. The problem is that +;;; the signalling functions don't work as advertised. If you are +;;; communicating via pipes, the CURRENT-GROUP arg is supposed to +;;; be ignored, but, unfortunately it seems to be the case that you +;;; must pass a NIL for this arg in the pipe case. COMINT-PTYP +;;; is a flag that tells whether the process is communicating +;;; via pipes or a pty. The comint signalling functions use it +;;; to determine the necessary CURRENT-GROUP arg value. The bug +;;; has been reported to the Gnu folks. +;;; - comint-dynamic-complete flushes the help window if you hit space +;;; after you execute it. +;;; - Added functions comint-send-string, comint-send-region and var +;;; comint-input-chunk-size. comint-send-string tries to prevent processes +;;; from hanging when you send them long strings by breaking them into +;;; chunks and allowing process output between chunks. I got the idea from +;;; Eero Simoncelli's Common Lisp package. Note that using +;;; comint-send-string means that the process buffer's contents can change +;;; during a call! If you depend on process output only happening between +;;; toplevel commands, this could be a problem. In such a case, use +;;; process-send-string instead. If this is a problem for people, I'd like +;;; to hear about it. +;;; - Added comint-proc-query as a simple mechanism for commands that +;;; want to query an inferior process and display its response. For a +;;; typical use, see lisp-show-arglist in cmulisp.el. +;;; - Added constant comint-version, which is now "2.01". +;;; +;;; 6/14/90 shivers +;;; - Had comint-update-env defined twice. Removed extra copy. Also +;;; renamed mem to be comint-mem, for modularity. The duplication +;;; was reported by Michael Meissner. +;;; 6/16/90 shivers +;;; - Emacs has two different mechanisms for maintaining the process +;;; environment, determined at compile time by the MAINTAIN-ENVIRONMENT +;;; #define. One uses the process-environment global variable, and +;;; one uses a getenv/setenv interface. comint-exec assumed the +;;; process-environment interface; it has been generalised (with +;;; comint-exec-1) to handle both cases. Pretty bogus. We could, +;;; of course, skip all this and just use the etc/env program to +;;; handle the environment tweaking, but that obscures process +;;; queries that other modules (like background.el) depend on. etc/env +;;; is also fairly bogus. This bug, and some of the fix code was +;;; reported by Dan Pierson. +;;; +;;; 9/5/90 shivers +;;; - Changed make-variable-buffer-local's to make-local-variable's. +;;; This leaves non-comint-mode buffers alone. Stephane Payrard +;;; reported the sloppy useage. +;;; - You can now go from comint-previous-similar-input to +;;; comint-previous-input with no problem. + + diff --git a/ghc/CONTRIB/haskell-modes/yale/original/haskell-menu.el b/ghc/CONTRIB/haskell-modes/yale/original/haskell-menu.el new file mode 100644 index 0000000000..9f851c683c --- /dev/null +++ b/ghc/CONTRIB/haskell-modes/yale/original/haskell-menu.el @@ -0,0 +1,43 @@ +;;; haskell-menu.el -- support for Haskell menubar functions +;;; +;;; author : Sandra Loosemore +;;; date : 15 Jun 1994 +;;; + + +;;; Add an entry to the main menu bar + +(defvar menu-bar-haskell-menu (make-sparse-keymap "Haskell")) +(define-key haskell-mode-map [menu-bar haskell] + (cons "Haskell" menu-bar-haskell-menu)) +(define-key inferior-haskell-mode-map [menu-bar haskell] + (cons "Haskell" menu-bar-haskell-menu)) +(define-key ht-mode-map [menu-bar haskell] + (cons "Haskell" menu-bar-haskell-menu)) + + +;;; Define the functions. They get listed on the menu in the reverse +;;; order that they're defined. + +(define-key menu-bar-haskell-menu [haskell-tutorial] + '("Tutorial" . haskell-tutorial)) +(define-key menu-bar-haskell-menu [haskell-optimizers] + '("Optimizers..." . haskell-optimizers)) +(define-key menu-bar-haskell-menu [haskell-printers] + '("Printers..." . haskell-printers)) +(define-key menu-bar-haskell-menu [haskell-get-pad] + '("Scratch Pad" . haskell-get-pad)) +(define-key menu-bar-haskell-menu [haskell-compile] + '("Compile File..." . haskell-compile)) +(define-key menu-bar-haskell-menu [haskell-run-file] + '("Run File..." . haskell-run-file)) +(define-key menu-bar-haskell-menu [haskell-load] + '("Load File..." . haskell-load)) +(define-key menu-bar-haskell-menu [haskell-report-type] + '("Type Check Expression..." . haskell-report-type)) +(define-key menu-bar-haskell-menu [haskell-run] + '("Run Dialogue..." . haskell-run)) +(define-key menu-bar-haskell-menu [haskell-eval] + '("Eval Expression..." . haskell-eval)) + +(provide 'haskell-menu) diff --git a/ghc/CONTRIB/haskell-modes/yale/original/haskell.el b/ghc/CONTRIB/haskell-modes/yale/original/haskell.el new file mode 100644 index 0000000000..9b4c95b3ca --- /dev/null +++ b/ghc/CONTRIB/haskell-modes/yale/original/haskell.el @@ -0,0 +1,1710 @@ +;;; ================================================================== +;;; File: haskell.el ;;; +;;; ;;; +;;; Author: A. Satish Pai ;;; +;;; Maria M. Gutierrez ;;; +;;; Dan Rabin (Jul-1991) ;;; +;;; ================================================================== + +;;; Description: Haskell mode for GNU Emacs. + +;;; Related files: comint.el + +;;; Contents: + +;;; Update Log + +;;; Known bugs / problems +;;; - the haskell editing mode (indentation, etc) is still missing. +;;; - the handling for errors from haskell needs to be rethought. +;;; - general cleanup of code. + + +;;; Errors generated + +;;; ================================================================== +;;; Haskell mode for editing files, and an Inferior Haskell mode to +;;; run a Haskell process. This file contains stuff snarfed and +;;; modified from tea.el, scheme.el, etc. This file may be freely +;;; modified; however, if you have any bug-corrections or useful +;;; improvements, I'd appreciate it if you sent me the mods so that +;;; I can merge them into the version I maintain. +;;; +;;; The inferior Haskell mode requires comint.el. +;;; +;;; You might want to add this to your .emacs to go automagically +;;; into Haskell mode while finding .hs files. +;;; +;;; (setq auto-mode-alist +;;; (cons '("\\.hs$" . haskell-mode) +;;; auto-mode-alist)_) +;;; +;;; To use this file, set up your .emacs to autoload this file for +;;; haskell-mode. For example: +;;; +;;; (autoload 'haskell-mode "$HASKELL/emacs-tools/haskell.elc" +;;; "Load Haskell mode" t) +;;; +;;; (autoload 'run-mode "$HASKELL/emacs-tools/haskell.elc" +;;; "Load Haskell mode" t) +;;; +;;; [Note: The path name given above is Yale specific!! Modify as +;;; required.] +;;; ================================================================ + +;;; Announce your existence to the world at large. + +(provide 'haskell) + + +;;; Load these other files. + +(require 'comint) ; Olin Shivers' comint mode is the substratum + + + + +;;; ================================================================ +;;; Declare a bunch of variables. +;;; ================================================================ + + +;;; User settable (via M-x set-variable and M-x edit-options) + +(defvar haskell-program-name (getenv "HASKELLPROG") + "*Program invoked by the haskell command.") + +(defvar haskell-auto-create-process t + "*If not nil, create a Haskell process automatically when required to evaluate or compile Haskell code.") + +(defvar haskell-auto-switch-input t + "*If not nil, jump to *haskell* buffer automatically on input request.") + +(defvar haskell-ask-before-saving t + "*If not nil, ask before saving random haskell-mode buffers.") + +(defvar haskell-initial-printers '("interactive") + "*Printers to set when starting a new Haskell process.") + + +;;; Pad/buffer Initialization variables + +(defvar *haskell-buffer* "*haskell*" + "Name of the haskell process buffer") + +(defvar haskell-main-pad "\*Main-pad\*" + "Scratch pad associated with module Main") + +(defvar haskell-main-module "Main") + + +(defvar *last-loaded* nil) +(defvar *last-module* haskell-main-module) +(defvar *last-pad* haskell-main-pad) + + +;;; These are used for haskell-tutorial mode. + +(defvar *ht-source-file* "$HASKELL/progs/tutorial/tutorial.lhs") +(defvar *ht-temp-buffer* nil) +(defvar *ht-file-buffer* "Haskell-Tutorial-Master") + + + +;;; ================================================================ +;;; Haskell editing mode stuff +;;; ================================================================ + +;;; Leave this place alone... +;;; The definitions below have been pared down to the bare +;;; minimum; they will be restored later. +;;; +;;; -Satish 2/5. + +;;; Keymap for Haskell mode +(defvar haskell-mode-map (make-sparse-keymap) + "Keymap used for haskell-mode") + +(defun haskell-establish-key-bindings (keymap) + (define-key keymap "\C-ce" 'haskell-eval) + (define-key keymap "\C-cr" 'haskell-run) + (define-key keymap "\C-ct" 'haskell-report-type) + (define-key keymap "\C-cm" 'haskell-run-main) + (define-key keymap "\C-c\C-r" 'haskell-run-file) + (define-key keymap "\C-cp" 'haskell-get-pad) + (define-key keymap "\C-c\C-o" 'haskell-optimizers) + (define-key keymap "\C-c\C-p" 'haskell-printers) + (define-key keymap "\C-cc" 'haskell-compile) + (define-key keymap "\C-cl" 'haskell-load) + (define-key keymap "\C-ch" 'haskell-switch) + (define-key keymap "\C-c\C-k" 'haskell-kill) + (define-key keymap "\C-c:" 'haskell-command) + (define-key keymap "\C-cq" 'haskell-exit) + (define-key keymap "\C-ci" 'haskell-interrupt) + (define-key keymap "\C-cu" 'haskell-edit-unit)) + + +(haskell-establish-key-bindings haskell-mode-map) + + +(defvar haskell-mode-syntax-table nil + "Syntax table used for haskell-mode") + +(if haskell-mode-syntax-table + nil + (setq haskell-mode-syntax-table (standard-syntax-table))) + +;;; Command for invoking the Haskell mode +(defun haskell-mode nil + "Major mode for editing Haskell code to run in Emacs +The following commands are available: +\\{haskell-mode-map} + +A Haskell process can be fired up with \"M-x haskell\". + +Customization: Entry to this mode runs the hooks that are the value of variable +haskell-mode-hook. + +Windows: + +There are 3 types of windows associated with Haskell mode. They are: + *haskell*: which is the process window. + Pad: which are buffers available for each module. It is here + where you want to test things before preserving them in a + file. Pads are always associated with a module. + When issuing a command: + The pad and its associated module are sent to the Haskell + process prior to the execution of the command. + .hs: These are the files where Haskell programs live. They + have .hs as extension. + When issuing a command: + The file is sent to the Haskell process prior to the + execution of the command. + +Commands: + +Each command behaves differently according to the type of the window in which +the cursor is positioned when the command is issued . + +haskell-eval: \\[haskell-eval] + Always promts user for a Haskell expression to be evaluated. If in a + .hs file buffer, then the cursor tells which module is the current + module and the pad for that module (if any) gets loaded as well. + +haskell-run: \\[haskell-run] + Always queries for a variable of type Dialogue to be evaluated. + +haskell-run-main: \\[haskell-run-main] + Run Dialogue named main in the current module. + +haskell-report-type: \\[haskell-report-type] + Like haskell-eval, but prints the type of the expression without + evaluating it. + +haskell-mode: \\[haskell-mode] + Puts the current buffer in haskell mode. + +haskell-compile: \\[haskell-compile] + Compiles file in current buffer. + +haskell-load: \\[haskell-load] + Loads file in current buffer. + +haskell-run-file: \\[haskell-run-file] + Runs file in the current buffer. + +haskell-pad: \\[haskell-pad] + Creates a scratch pad for the current module. + +haskell-optimizers: \\[haskell-optimizers] + Shows the list of available optimizers. Commands for turning them on/off. + +haskell-printers: \\[haskell-printers] + Shows the list of available printers. Commands for turning them on/off. + +haskell-command: \\[haskell-command] + Prompts for a command to be sent to the command interface. You don't + need to put the : before the command. + +haskell-quit: \\[haskell-quit] + Terminates the haskell process. + +haskell-switch: \\[haskell-switch] + Switches to the inferior Haskell buffer (*haskell*) and positions the + cursor at the end of the buffer. + +haskell-kill: \\[haskell-kill] + Kill the current contents of the *haskell* buffer. + +haskell-interrupt: \\[haskell-interrupt] + Interrupts haskell process and resets it. + +haskell-edit-unit: \\[haskell-edit-unit] + Edit the .hu file for the unit containing this file. +" + (interactive) + (kill-all-local-variables) + (use-local-map haskell-mode-map) + (setq major-mode 'haskell-mode) + (setq mode-name "Haskell") + (make-local-variable 'indent-line-function) + (setq indent-line-function 'indent-relative-maybe) + ;(setq local-abbrev-table haskell-mode-abbrev-table) + (set-syntax-table haskell-mode-syntax-table) + ;(setq tab-stop-list haskell-tab-stop-list) ;; save old list?? + (run-hooks 'haskell-mode-hook)) + + + +;;;================================================================ +;;; Inferior Haskell stuff +;;;================================================================ + + +(defvar inferior-haskell-mode-map (full-copy-sparse-keymap comint-mode-map)) + +(haskell-establish-key-bindings inferior-haskell-mode-map) +(define-key inferior-haskell-mode-map "\C-m" 'haskell-send-input) + +(defvar haskell-source-modes '(haskell-mode) + "*Used to determine if a buffer contains Haskell source code. +If it's loaded into a buffer that is in one of these major modes, +it's considered a Haskell source file.") + +(defvar haskell-prompt-pattern "^[A-Z]\\([A-Z]\\|[a-z]\\|[0-9]\\)*>\\s-*" + "Regular expression capturing the Haskell system prompt.") + +(defvar haskell-prompt-ring () + "Keeps track of input to haskell process from the minibuffer") + +(defun inferior-haskell-mode-variables () + nil) + + +;;; INFERIOR-HASKELL-MODE (adapted from comint.el) + +(defun inferior-haskell-mode () + "Major mode for interacting with an inferior Haskell process. + +The following commands are available: +\\{inferior-haskell-mode-map} + +A Haskell process can be fired up with \"M-x haskell\". + +Customization: Entry to this mode runs the hooks on comint-mode-hook and +inferior-haskell-mode-hook (in that order). + +You can send text to the inferior Haskell process from other buffers containing +Haskell source. + + +Windows: + +There are 3 types of windows in the inferior-haskell-mode. They are: + *haskell*: which is the process window. + Pad: which are buffers available for each module. It is here + where you want to test things before preserving them in a + file. Pads are always associated with a module. + When issuing a command: + The pad and its associated module are sent to the Haskell + process prior to the execution of the command. + .hs: These are the files where Haskell programs live. They + have .hs as extension. + When issuing a command: + The file is sent to the Haskell process prior to the + execution of the command. + +Commands: + +Each command behaves differently according to the type of the window in which +the cursor is positioned when the command is issued. + +haskell-eval: \\[haskell-eval] + Always promts user for a Haskell expression to be evaluated. If in a + .hs file, then the cursor tells which module is the current module and + the pad for that module (if any) gets loaded as well. + +haskell-run: \\[haskell-run] + Always queries for a variable of type Dialogue to be evaluated. + +haskell-run-main: \\[haskell-run-main] + Run Dialogue named main. + +haskell-report-type: \\[haskell-report-type] + Like haskell-eval, but prints the type of the expression without + evaluating it. + +haskell-mode: \\[haskell-mode] + Puts the current buffer in haskell mode. + +haskell-compile: \\[haskell-compile] + Compiles file in current buffer. + +haskell-load: \\[haskell-load] + Loads file in current buffer. + +haskell-run-file: \\[haskell-run-file] + Runs file in the current buffer. + +haskell-pad: \\[haskell-pad] + Creates a scratch pad for the current module. + +haskell-optimizers: \\[haskell-optimizers] + Shows the list of available optimizers. Commands for turning them on/off. + +haskell-printers: \\[haskell-printers] + Shows the list of available printers. Commands for turning them on/off. + +haskell-command: \\[haskell-command] + Prompts for a command to be sent to the command interface. You don't + need to put the : before the command. + +haskell-quit: \\[haskell-quit] + Terminates the haskell process. + +haskell-switch: \\[haskell-switch] + Switches to the inferior Haskell buffer (*haskell*) and positions the + cursor at the end of the buffer. + +haskell-kill: \\[haskell-kill] + Kill the current contents of the *haskell* buffer. + +haskell-interrupt: \\[haskell-interrupt] + Interrupts haskell process and resets it. + +haskell-edit-unit: \\[haskell-edit-unit] + Edit the .hu file for the unit containing this file. + +The usual comint functions are also available. In particular, the +following are all available: + +comint-bol: Beginning of line, but skip prompt. Bound to C-a by default. +comint-delchar-or-maybe-eof: Delete char, unless at end of buffer, in + which case send EOF to process. Bound to C-d by default. + +Note however, that the default keymap bindings provided shadow some of +the default comint mode bindings, so that you may want to bind them +to your choice of keys. + +Comint mode's dynamic completion of filenames in the buffer is available. +(Q.v. comint-dynamic-complete, comint-dynamic-list-completions.) + +If you accidentally suspend your process, use \\[comint-continue-subjob] +to continue it." + + (interactive) + (comint-mode) + (setq comint-prompt-regexp haskell-prompt-pattern) + ;; Customise in inferior-haskell-mode-hook + (inferior-haskell-mode-variables) + (setq major-mode 'inferior-haskell-mode) + (setq mode-name "Inferior Haskell") + (setq mode-line-process '(": %s : busy")) + (use-local-map inferior-haskell-mode-map) + (setq comint-input-filter 'haskell-input-filter) + (setq comint-input-sentinel 'ignore) + (setq comint-get-old-input 'haskell-get-old-input) + (run-hooks 'inferior-haskell-mode-hook) + ;Do this after the hook so the user can mung INPUT-RING-SIZE w/his hook. + ;The test is so we don't lose history if we run comint-mode twice in + ;a buffer. + (setq haskell-prompt-ring (make-ring input-ring-size))) + + +(defun haskell-input-filter (str) + "Don't save whitespace." + (not (string-match "\\s *" str))) + + + +;;; ================================================================== +;;; Random utilities +;;; ================================================================== + + +;;; This keeps track of the status of the haskell process. +;;; Values are: +;;; busy -- The process is busy. +;;; ready -- The process is ready for a command. +;;; input -- The process is waiting for input. +;;; debug -- The process is in the debugger. + +(defvar *haskell-status* 'busy + "Status of the haskell process") + +(defun set-haskell-status (value) + (setq *haskell-status* value) + (haskell-update-mode-line)) + +(defun get-haskell-status () + *haskell-status*) + +(defun haskell-update-mode-line () + (save-excursion + (set-buffer *haskell-buffer*) + (cond ((eq *haskell-status* 'ready) + (setq mode-line-process '(": %s: ready"))) + ((eq *haskell-status* 'input) + (setq mode-line-process '(": %s: input"))) + ((eq *haskell-status* 'busy) + (setq mode-line-process '(": %s: busy"))) + ((eq *haskell-status* 'debug) + (setq mode-line-process '(": %s: debug"))) + (t + (haskell-mode-error "Confused about status of haskell process!"))) + ;; Yes, this is the officially sanctioned technique for forcing + ;; a redisplay of the mode line. + (set-buffer-modified-p (buffer-modified-p)))) + + +(defun haskell-send-to-process (string) + (process-send-string "haskell" string) + (process-send-string "haskell" "\n")) + + + +;;; ================================================================== +;;; Handle input in haskell process buffer; history commands. +;;; ================================================================== + +(defun haskell-get-old-input () + "Get old input text from Haskell process buffer." + (save-excursion + (if (re-search-forward haskell-prompt-pattern (point-max) 'move) + (goto-char (match-beginning 0))) + (cond ((re-search-backward haskell-prompt-pattern (point-min) t) + (comint-skip-prompt) + (let ((temp (point))) + (end-of-line) + (buffer-substring temp (point))))))) + + +(defun haskell-send-input () + "Send input to Haskell while in the process buffer" + (interactive) + (if (eq (get-haskell-status) 'debug) + (comint-send-input) + (haskell-send-input-aux))) + +(defun haskell-send-input-aux () + ;; Note that the input string does not include its terminal newline. + (let ((proc (get-buffer-process (current-buffer)))) + (if (not proc) + (haskell-mode-error "Current buffer has no process!") + (let* ((pmark (process-mark proc)) + (pmark-val (marker-position pmark)) + (input (if (>= (point) pmark-val) + (buffer-substring pmark (point)) + (let ((copy (funcall comint-get-old-input))) + (goto-char pmark) + (insert copy) + copy)))) + (insert ?\n) + (if (funcall comint-input-filter input) + (ring-insert input-ring input)) + (funcall comint-input-sentinel input) + (set-marker (process-mark proc) (point)) + (set-marker comint-last-input-end (point)) + (haskell-send-to-process input))))) + + + +;;; ================================================================== +;;; Minibuffer input stuff +;;; ================================================================== + +;;; Haskell input history retrieval commands (taken from comint.el) +;;; M-p -- previous input M-n -- next input + +(defvar haskell-minibuffer-local-map nil + "Local map for minibuffer when in Haskell") + +(if haskell-minibuffer-local-map + nil + (progn + (setq haskell-minibuffer-local-map + (full-copy-sparse-keymap minibuffer-local-map)) + ;; Haskell commands + (define-key haskell-minibuffer-local-map "\ep" 'haskell-previous-input) + (define-key haskell-minibuffer-local-map "\en" 'haskell-next-input) + )) + +(defun haskell-previous-input (arg) + "Cycle backwards through input history." + (interactive "*p") + (let ((len (ring-length haskell-prompt-ring))) + (cond ((<= len 0) + (message "Empty input ring.") + (ding)) + (t + (cond ((eq last-command 'haskell-previous-input) + (delete-region (mark) (point)) + (set-mark (point))) + (t + (setq input-ring-index + (if (> arg 0) -1 + (if (< arg 0) 1 0))) + (push-mark (point)))) + (setq input-ring-index (comint-mod (+ input-ring-index arg) len)) + (insert (ring-ref haskell-prompt-ring input-ring-index)) + (setq this-command 'haskell-previous-input)) + ))) + +(defun haskell-next-input (arg) + "Cycle forwards through input history." + (interactive "*p") + (haskell-previous-input (- arg))) + +(defvar haskell-last-input-match "" + "Last string searched for by Haskell input history search, for defaulting. +Buffer local variable.") + +(defun haskell-previous-input-matching (str) + "Searches backwards through input history for substring match" + (interactive (let ((s (read-from-minibuffer + (format "Command substring (default %s): " + haskell-last-input-match)))) + (list (if (string= s "") haskell-last-input-match s)))) + (setq haskell-last-input-match str) ; update default + (let ((str (regexp-quote str)) + (len (ring-length haskell-prompt-ring)) + (n 0)) + (while (and (<= n len) + (not (string-match str (ring-ref haskell-prompt-ring n)))) + (setq n (+ n 1))) + (cond ((<= n len) (haskell-previous-input (+ n 1))) + (t (haskell-mode-error "Not found."))))) + + +;;; Actually read an expression from the minibuffer using the new keymap. + +(defun haskell-get-expression (prompt) + (let ((exp (read-from-minibuffer prompt nil haskell-minibuffer-local-map))) + (ring-insert haskell-prompt-ring exp) + exp)) + + + +;;; ================================================================== +;;; Handle output from Haskell process +;;; ================================================================== + +;;; The haskell process produces output with embedded control codes. +;;; These control codes are used to keep track of what kind of input +;;; the haskell process is expecting. Ordinary output is just displayed. +;;; +;;; This is kind of complicated because control sequences can be broken +;;; across multiple batches of text received from the haskell process. +;;; If the string ends in the middle of a control sequence, save it up +;;; for the next call. + +(defvar *haskell-saved-output* nil) + +;;; On the Next, there is some kind of race condition that causes stuff +;;; sent to the Haskell subprocess before it has really started to be lost. +;;; The point of this variable is to force the Emacs side to wait until +;;; Haskell has started and printed out its banner before sending it +;;; anything. See start-haskell below. + +(defvar *haskell-process-alive* nil) + +(defun haskell-output-filter (process str) + "Filter for output from Yale Haskell command interface" + ;; *** debug + ;;(let ((buffer (get-buffer-create "haskell-output"))) + ;; (save-excursion + ;; (set-buffer buffer) + ;; (insert str))) + (setq *haskell-process-alive* t) + (let ((next 0) + (start 0) + (data (match-data))) + (unwind-protect + (progn + ;; If there was saved output from last time, glue it in front of the + ;; newly received input. + (if *haskell-saved-output* + (progn + (setq str (concat *haskell-saved-output* str)) + (setq *haskell-saved-output* nil))) + ;; Loop, looking for complete command sequences. + ;; Set next to point to the first one. + ;; start points to first character to be processed. + (while (setq next + (string-match *haskell-message-match-regexp* + str start)) + ;; Display any intervening ordinary text. + (if (not (eq next start)) + (haskell-display-output (substring str start next))) + ;; Now dispatch on the particular command sequence found. + ;; Handler functions are called with the string and start index + ;; as arguments, and should return the index of the "next" + ;; character. + (let ((end (match-end 0))) + (haskell-handle-message str next) + (setq start end))) + ;; Look to see whether the string ends with an incomplete + ;; command sequence. + ;; If so, save the tail of the string for next time. + (if (and (setq next + (string-match *haskell-message-prefix-regexp* str start)) + (eq (match-end 0) (length str))) + (setq *haskell-saved-output* (substring str next)) + (setq next (length str))) + ;; Display any leftover ordinary text. + (if (not (eq next start)) + (haskell-display-output (substring str start next)))) + (store-match-data data)))) + +(defvar *haskell-message-match-regexp* + "EMACS:.*\n") + +(defvar *haskell-message-prefix-regexp* + "E\\(M\\(A\\(C\\(S\\(:.*\\)?\\)?\\)?\\)?\\)?") + +(defvar *haskell-message-dispatch* + '(("EMACS:debug\n" . haskell-got-debug) + ("EMACS:busy\n" . haskell-got-busy) + ("EMACS:input\n" . haskell-got-input) + ("EMACS:ready\n" . haskell-got-ready) + ("EMACS:printers .*\n" . haskell-got-printers) + ("EMACS:optimizers .*\n" . haskell-got-optimizers) + ("EMACS:message .*\n" . haskell-got-message) + ("EMACS:error\n" . haskell-got-error) + )) + +(defun haskell-handle-message (str idx) + (let ((list *haskell-message-dispatch*) + (fn nil)) + (while (and list (null fn)) + (if (eq (string-match (car (car list)) str idx) idx) + (setq fn (cdr (car list))) + (setq list (cdr list)))) + (if (null fn) + (haskell-mode-error "Garbled message from Haskell!") + (let ((end (match-end 0))) + (funcall fn str idx end) + end)))) + + +(defun haskell-message-data (string start end) + (let ((real-start (+ (string-match " " string start) 1)) + (real-end (- end 1))) + (substring string real-start real-end))) + +(defun haskell-got-debug (string start end) + (beep) + (message "In the debugger!") + (set-haskell-status 'debug)) + +(defun haskell-got-busy (string start end) + (set-haskell-status 'busy)) + +(defun haskell-got-input (string start end) + (if haskell-auto-switch-input + (progn + (haskell-switch) + (beep))) + (set-haskell-status 'input) + (message "Waiting for input...")) + +(defun haskell-got-ready (string start end) + (set-haskell-status 'ready)) + +(defun haskell-got-printers (string start end) + (haskell-printers-update (haskell-message-data string start end))) + +(defun haskell-got-optimizers (string start end) + (haskell-optimizers-update (haskell-message-data string start end))) + +(defun haskell-got-message (string start end) + (message "%s" (haskell-message-data string start end))) + +(defun haskell-got-error (string start end) + (beep) + (message "Haskell error.")) + + +;;; Displays output at end of given buffer. +;;; This function only ensures that the output is visible, without +;;; selecting the buffer in which it is displayed. +;;; Note that just using display-buffer instead of all this rigamarole +;;; won't work; you need to temporarily select the window containing +;;; the *haskell-buffer*, or else the display won't be scrolled to show +;;; the new output. +;;; *** This should really position the window in the buffer so that +;;; *** the point is on the last line of the window. + +(defun haskell-display-output (str) + (let ((window (selected-window))) + (unwind-protect + (progn + (pop-to-buffer *haskell-buffer*) + (haskell-display-output-aux str)) + (select-window window)))) + +(defun haskell-display-output-aux (str) + (haskell-move-marker) + (insert str) + (haskell-move-marker)) + + + +;;; ================================================================== +;;; Interactive commands +;;; ================================================================== + + +;;; HASKELL +;;; ------- +;;; +;;; This is the function that fires up the inferior haskell process. + +(defun haskell () + "Run an inferior Haskell process with input and output via buffer *haskell*. +Takes the program name from the variable haskell-program-name. +Runs the hooks from inferior-haskell-mode-hook +(after the comint-mode-hook is run). +\(Type \\[describe-mode] in the process buffer for a list of commands.)" + (interactive) + (if (not (haskell-process-exists-p)) + (start-haskell))) + +(defun start-haskell () + (message "Starting haskell subprocess...") + ;; Kill old haskell process. Normally this routine is only called + ;; after checking haskell-process-exists-p, but things can get + ;; screwed up if you rename the *haskell* buffer while leaving the + ;; old process running. This forces it to get rid of the old process + ;; and start a new one. + (if (get-process "haskell") + (delete-process "haskell")) + (let ((haskell-buffer + (apply 'make-comint + "haskell" + (or haskell-program-name + (haskell-mode-error "Haskell-program-name undefined!")) + nil + nil))) + (save-excursion + (set-buffer haskell-buffer) + (inferior-haskell-mode)) + (haskell-session-init) + ;; Wait for process to get started before sending it anything + ;; to avoid race condition on NeXT. + (setq *haskell-process-alive* nil) + (while (not *haskell-process-alive*) + (sleep-for 1)) + (haskell-send-to-process ":(use-emacs-interface)") + (haskell-printers-set haskell-initial-printers nil) + (display-buffer haskell-buffer)) + (message "Starting haskell subprocess... Done.")) + + +(defun haskell-process-exists-p () + (let ((haskell-buffer (get-buffer *haskell-buffer*))) + (and haskell-buffer (comint-check-proc haskell-buffer)))) + + + +;;; Initialize things on the emacs side, and tell haskell that it's +;;; talking to emacs. + +(defun haskell-session-init () + (set-haskell-status 'busy) + (setq *last-loaded* nil) + (setq *last-module* haskell-main-module) + (setq *last-pad* haskell-main-pad) + (setq *haskell-saved-output* nil) + (haskell-create-main-pad) + (set-process-filter (get-process "haskell") 'haskell-output-filter) + ) + + +(defun haskell-create-main-pad () + (let ((buffer (get-buffer-create haskell-main-pad))) + (save-excursion + (set-buffer buffer) + (haskell-mode)) + (haskell-record-pad-mapping + haskell-main-pad haskell-main-module nil) + buffer)) + + +;;; Called from evaluation and compilation commands to start up a Haskell +;;; process if none is already in progress. + +(defun haskell-maybe-create-process () + (cond ((haskell-process-exists-p) + t) + (haskell-auto-create-process + (start-haskell)) + (t + (haskell-mode-error "No Haskell process!")))) + + + +;;; HASKELL-GET-PAD +;;; ------------------------------------------------------------------ + +;;; This always puts the pad buffer in the "other" window. +;;; Having it wipe out the .hs file window is clearly the wrong +;;; behavior. + +(defun haskell-get-pad () + "Creates a new scratch pad for the current module. +Signals an error if the current buffer is not a .hs file." + (interactive) + (let ((fname (buffer-file-name))) + (if fname + (do-get-pad fname (current-buffer)) + (haskell-mode-error "Not in a .hs buffer!")))) + + +(defun do-get-pad (fname buff) + (let* ((mname (or (haskell-get-modname buff) + (read-no-blanks-input "Scratch pad for module? " nil))) + (pname (haskell-lookup-pad mname fname)) + (pbuff nil)) + ;; Generate the base name of the pad buffer, then create the + ;; buffer. The actual name of the pad buffer may be something + ;; else because of name collisions. + (if (not pname) + (progn + (setq pname (format "*%s-pad*" mname)) + (setq pbuff (generate-new-buffer pname)) + (setq pname (buffer-name pbuff)) + (haskell-record-pad-mapping pname mname fname) + ) + (setq pbuff (get-buffer pname))) + ;; Make sure the pad buffer is in haskell mode. + (pop-to-buffer pbuff) + (haskell-mode))) + + + +;;; HASKELL-SWITCH +;;; ------------------------------------------------------------------ + +(defun haskell-switch () + "Switches to \*haskell\* buffer." + (interactive) + (haskell-maybe-create-process) + (pop-to-buffer *haskell-buffer*) + (push-mark) + (goto-char (point-max))) + + + +;;; HASKELL-KILL +;;; ------------------------------------------------------------------ + +(defun haskell-kill () + "Kill contents of *haskell* buffer. \\[haskell-kill]" + (interactive) + (save-excursion + (set-buffer *haskell-buffer*) + (beginning-of-buffer) + (let ((mark (point))) + (end-of-buffer) + (kill-region mark (point))))) + + + +;;; HASKELL-COMMAND +;;; ------------------------------------------------------------------ + +(defun haskell-command (str) + "Format STRING as a haskell command and send it to haskell process. \\[haskell-command]" + (interactive "sHaskell command: ") + (haskell-send-to-process (format ":%s" str))) + + +;;; HASKELL-EVAL and HASKELL-RUN +;;; ------------------------------------------------------------------ + +(defun haskell-eval () + "Evaluate expression in current module. \\[haskell-eval]" + (interactive) + (haskell-maybe-create-process) + (haskell-eval-aux (haskell-get-expression "Haskell expression: ") + "emacs-eval")) + +(defun haskell-run () + "Run Haskell Dialogue in current module" + (interactive) + (haskell-maybe-create-process) + (haskell-eval-aux (haskell-get-expression "Haskell dialogue: ") + "emacs-run")) + +(defun haskell-run-main () + "Run Dialogue named main in current module" + (interactive) + (haskell-maybe-create-process) + (haskell-eval-aux "main" "emacs-run")) + +(defun haskell-report-type () + "Print the type of the expression." + (interactive) + (haskell-maybe-create-process) + (haskell-eval-aux (haskell-get-expression "Haskell expression: ") + "emacs-report-type")) + +(defun haskell-eval-aux (exp fn) + (cond ((equal *haskell-buffer* (buffer-name)) + ;; In the *haskell* buffer. + (let* ((pname *last-pad*) + (mname *last-module*) + (fname *last-loaded*)) + (haskell-eval-aux-aux exp pname mname fname fn))) + ((buffer-file-name) + ;; In a .hs file. + (let* ((fname (buffer-file-name)) + (mname (haskell-get-modname (current-buffer))) + (pname (haskell-lookup-pad mname fname))) + (haskell-eval-aux-aux exp pname mname fname fn))) + (t + ;; In a pad. + (let* ((pname (buffer-name (current-buffer))) + (mname (haskell-get-module-from-pad pname)) + (fname (haskell-get-file-from-pad pname))) + (haskell-eval-aux-aux exp pname mname fname fn))) + )) + +(defun haskell-eval-aux-aux (exp pname mname fname fn) + (haskell-save-modified-source-files fname) + (haskell-send-to-process (format ":(%s" fn)) + (haskell-send-to-process + (prin1-to-string exp)) + (haskell-send-to-process + (prin1-to-string (or pname fname "interactive"))) + (haskell-send-to-process + (prin1-to-string + (if (and pname (get-buffer pname)) + (save-excursion + (set-buffer pname) + (buffer-string)) + ""))) + (haskell-send-to-process + (format "'|%s|" mname)) + (haskell-send-to-process + (if fname + (prin1-to-string (haskell-maybe-get-unit-file-name fname)) + "'#f")) + (haskell-send-to-process ")") + (setq *last-pad* pname) + (setq *last-module* mname) + (setq *last-loaded* fname)) + + + +;;; HASKELL-RUN-FILE, HASKELL-LOAD, HASKELL-COMPILE +;;; ------------------------------------------------------------------ + +(defun haskell-run-file () + "Runs Dialogue named main in current file." + (interactive) + (haskell-maybe-create-process) + (let ((fname (haskell-get-file-to-operate-on))) + (haskell-save-modified-source-files fname) + (haskell-send-to-process ":(emacs-run-file") + (haskell-send-to-process (prin1-to-string fname)) + (haskell-send-to-process ")"))) + +(defun haskell-load () + "Load current file." + (interactive) + (haskell-maybe-create-process) + (let ((fname (haskell-get-file-to-operate-on))) + (haskell-save-modified-source-files fname) + (haskell-send-to-process ":(emacs-load-file") + (haskell-send-to-process (prin1-to-string fname)) + (haskell-send-to-process ")"))) + +(defun haskell-compile () + "Compile current file." + (interactive) + (haskell-maybe-create-process) + (let ((fname (haskell-get-file-to-operate-on))) + (haskell-save-modified-source-files fname) + (haskell-send-to-process ":(emacs-compile-file") + (haskell-send-to-process (prin1-to-string fname)) + (haskell-send-to-process ")"))) + + +(defun haskell-get-file-to-operate-on () + (cond ((equal *haskell-buffer* (buffer-name)) + ;; When called from the haskell process buffer, prompt for a file. + (call-interactively 'haskell-get-file/prompt)) + ((buffer-file-name) + ;; When called from a .hs file buffer, use the unit file + ;; associated with it, if there is one. + (haskell-maybe-get-unit-file-name (buffer-file-name))) + (t + ;; When called from a pad, use the file that the module the + ;; pad belongs to lives in. + (haskell-maybe-get-unit-file-name + (haskell-get-file-from-pad (buffer-name (current-buffer))))))) + +(defun haskell-get-file/prompt (filename) + (interactive "fHaskell file: ") + (haskell-run-file-aux filename)) + + + +;;; HASKELL-EXIT +;;; ------------------------------------------------------------------ + +(defun haskell-exit () + "Quit the haskell process." + (interactive) + (cond ((not (haskell-process-exists-p)) + (message "No process currently running.")) + ((y-or-n-p "Do you really want to quit Haskell? ") + (haskell-send-to-process ":quit") + ;; If we were running the tutorial, mark the temp buffer as unmodified + ;; so we don't get asked about saving it later. + (if (and *ht-temp-buffer* + (get-buffer *ht-temp-buffer*)) + (save-excursion + (set-buffer *ht-temp-buffer*) + (set-buffer-modified-p nil))) + ;; Try to remove the haskell output buffer from the screen. + (bury-buffer *haskell-buffer*) + (replace-buffer-in-windows *haskell-buffer*)) + (t + nil))) + + +;;; HASKELL-INTERRUPT +;;; ------------------------------------------------------------------ + +(defun haskell-interrupt () + "Interrupt the haskell process." + (interactive) + (if (haskell-process-exists-p) + (haskell-send-to-process "\C-c"))) + + + +;;; HASKELL-EDIT-UNIT +;;; ------------------------------------------------------------------ + +(defun haskell-edit-unit () + "Edit the .hu file." + (interactive) + (let ((fname (buffer-file-name))) + (if fname + (let ((find-file-not-found-hooks (list 'haskell-new-unit)) + (file-not-found nil) + (units-fname (haskell-get-unit-file-name fname))) + (find-file-other-window units-fname) + ;; If creating a new file, initialize it to contain the name + ;; of the haskell source file. + (if file-not-found + (save-excursion + (insert + (if (string= (file-name-directory fname) + (file-name-directory units-fname)) + (file-name-nondirectory fname) + fname) + "\n")))) + (haskell-mode-error "Not in a .hs buffer!")))) + +(defun haskell-new-unit () + (setq file-not-found t)) + + +;;; Look for a comment like "-- unit:" at top of file. +;;; If not found, assume unit file has same name as the buffer but +;;; a .hu extension. + +(defun haskell-get-unit-file-name (fname) + (or (haskell-get-unit-file-name-from-file fname) + (concat (haskell-strip-file-extension fname) ".hu"))) + +(defun haskell-maybe-get-unit-file-name (fname) + (or (haskell-get-unit-file-name-from-file fname) + (haskell-strip-file-extension fname))) + +(defun haskell-get-unit-file-name-from-file (fname) + (let ((buffer (get-file-buffer fname))) + (if buffer + (save-excursion + (beginning-of-buffer) + (if (re-search-forward "-- unit:[ \t]*" (point-max) t) + (let ((beg (match-end 0))) + (end-of-line) + (buffer-substring beg (point))) + nil)) + nil))) + + + + +;;; ================================================================== +;;; Support for printers/optimizers menus +;;; ================================================================== + +;;; This code was adapted from the standard buff-menu.el code. + +(defvar haskell-menu-mode-map nil "") + +(if (not haskell-menu-mode-map) + (progn + (setq haskell-menu-mode-map (make-keymap)) + (suppress-keymap haskell-menu-mode-map t) + (define-key haskell-menu-mode-map "m" 'hm-mark) + (define-key haskell-menu-mode-map "u" 'hm-unmark) + (define-key haskell-menu-mode-map "x" 'hm-exit) + (define-key haskell-menu-mode-map "q" 'hm-exit) + (define-key haskell-menu-mode-map " " 'next-line) + (define-key haskell-menu-mode-map "\177" 'hm-backup-unmark) + (define-key haskell-menu-mode-map "?" 'describe-mode))) + +;; Printers Menu mode is suitable only for specially formatted data. + +(put 'haskell-menu-mode 'mode-class 'special) + +(defun haskell-menu-mode () + "Major mode for editing Haskell flags. +Each line describes a flag. +Letters do not insert themselves; instead, they are commands. +m -- mark flag (turn it on) +u -- unmark flag (turn it off) +x -- exit; tell the Haskell process to update the flags, then leave menu. +q -- exit; same as x. +Precisely,\\{haskell-menu-mode-map}" + (kill-all-local-variables) + (use-local-map haskell-menu-mode-map) + (setq truncate-lines t) + (setq buffer-read-only t) + (setq major-mode 'haskell-menu-mode) + (setq mode-name "Haskell Flags Menu") + ;; These are all initialized elsewhere + (make-local-variable 'hm-current-flags) + (make-local-variable 'hm-request-fn) + (make-local-variable 'hm-update-fn) + (run-hooks 'haskell-menu-mode-hook)) + + +(defun haskell-menu (help-file buffer request-fn update-fn) + (haskell-maybe-create-process) + (if (get-buffer buffer) + (progn + (pop-to-buffer buffer) + (goto-char (point-min))) + (progn + (pop-to-buffer buffer) + (insert-file-contents help-file) + (haskell-menu-mode) + (setq hm-request-fn request-fn) + (setq hm-update-fn update-fn) + )) + (hm-mark-current) + (message "m = mark; u = unmark; x = execute; q = quit; ? = more help.")) + + + +;;; A line that starts with *hm-marked* is a menu item turned on. +;;; A line that starts with *hm-unmarked* is turned off. +;;; A line that starts with anything else is just random text and is +;;; ignored by commands that deal with menu items. + +(defvar *hm-marked* " on") +(defvar *hm-unmarked* " ") +(defvar *hm-marked-regexp* " on \\w") +(defvar *hm-unmarked-regexp* " \\w") + +(defun hm-mark () + "Mark flag to be turned on." + (interactive) + (beginning-of-line) + (cond ((looking-at *hm-marked-regexp*) + (forward-line 1)) + ((looking-at *hm-unmarked-regexp*) + (let ((buffer-read-only nil)) + (delete-char (length *hm-unmarked*)) + (insert *hm-marked*) + (forward-line 1))) + (t + (forward-line 1)))) + +(defun hm-unmark () + "Unmark flag." + (interactive) + (beginning-of-line) + (cond ((looking-at *hm-unmarked-regexp*) + (forward-line 1)) + ((looking-at *hm-marked-regexp*) + (let ((buffer-read-only nil)) + (delete-char (length *hm-marked*)) + (insert *hm-unmarked*) + (forward-line 1))) + (t + (forward-line 1)))) + +(defun hm-backup-unmark () + "Move up and unmark." + (interactive) + (forward-line -1) + (hm-unmark) + (forward-line -1)) + + +;;; Actually make the changes. + +(defun hm-exit () + "Update flags, then leave menu." + (interactive) + (hm-execute) + (hm-quit)) + +(defun hm-execute () + "Tell haskell process to tweak flags." + (interactive) + (save-excursion + (goto-char (point-min)) + (let ((flags-on nil) + (flags-off nil)) + (while (not (eq (point) (point-max))) + (cond ((looking-at *hm-unmarked-regexp*) + (setq flags-off (cons (hm-flag) flags-off))) + ((looking-at *hm-marked-regexp*) + (setq flags-on (cons (hm-flag) flags-on))) + (t + nil)) + (forward-line 1)) + (funcall hm-update-fn flags-on flags-off)))) + + +(defun hm-quit () + (interactive) + "Make the menu go away." + (bury-buffer (current-buffer)) + (replace-buffer-in-windows (current-buffer))) + +(defun hm-flag () + (save-excursion + (beginning-of-line) + (forward-char 6) + (let ((beg (point))) + ;; End of flag name marked by tab or two spaces. + (re-search-forward "\t\\| ") + (buffer-substring beg (match-beginning 0))))) + + +;;; Update the menu to mark only those items currently turned on. + +(defun hm-mark-current () + (funcall hm-request-fn) + (save-excursion + (goto-char (point-min)) + (while (not (eq (point) (point-max))) + (cond ((and (looking-at *hm-unmarked-regexp*) + (hm-item-currently-on-p (hm-flag))) + (hm-mark)) + ((and (looking-at *hm-marked-regexp*) + (not (hm-item-currently-on-p (hm-flag)))) + (hm-unmark)) + (t + (forward-line 1)))))) + + +;;; See if a menu item is turned on. + +(defun hm-item-currently-on-p (item) + (member-string= item hm-current-flags)) + +(defun member-string= (item list) + (cond ((null list) + nil) + ((string= item (car list)) + list) + (t + (member-string= item (cdr list))))) + + + +;;; Make the menu for printers. + +(defvar *haskell-printers-help* + (concat (getenv "HASKELL") "/emacs-tools/printer-help.txt") + "Help file for printers.") + +(defvar *haskell-printers-buffer* "*Haskell printers*") + +(defun haskell-printers () + "Set printers interactively." + (interactive) + (haskell-menu + *haskell-printers-help* + *haskell-printers-buffer* + 'haskell-printers-inquire + 'haskell-printers-set)) + +(defun haskell-printers-inquire () + (setq hm-current-flags t) + (haskell-send-to-process ":(emacs-send-printers)") + (while (eq hm-current-flags t) + (sleep-for 1))) + +(defun haskell-printers-update (data) + (setq hm-current-flags (read data))) + +(defun haskell-printers-set (flags-on flags-off) + (haskell-send-to-process ":(emacs-set-printers '") + (haskell-send-to-process (prin1-to-string flags-on)) + (haskell-send-to-process ")")) + + +;;; Equivalent stuff for the optimizers menu + +(defvar *haskell-optimizers-help* + (concat (getenv "HASKELL") "/emacs-tools/optimizer-help.txt") + "Help file for optimizers.") + +(defvar *haskell-optimizers-buffer* "*Haskell optimizers*") + +(defun haskell-optimizers () + "Set optimizers interactively." + (interactive) + (haskell-menu + *haskell-optimizers-help* + *haskell-optimizers-buffer* + 'haskell-optimizers-inquire + 'haskell-optimizers-set)) + +(defun haskell-optimizers-inquire () + (setq hm-current-flags t) + (haskell-send-to-process ":(emacs-send-optimizers)") + (while (eq hm-current-flags t) + (sleep-for 1))) + +(defun haskell-optimizers-update (data) + (setq hm-current-flags (read data))) + +(defun haskell-optimizers-set (flags-on flags-off) + (haskell-send-to-process ":(emacs-set-optimizers '") + (haskell-send-to-process (prin1-to-string flags-on)) + (haskell-send-to-process ")")) + + + +;;; ================================================================== +;;; Random utilities +;;; ================================================================== + + +;;; Keep track of the association between pads, modules, and files. +;;; The global variable is a list of (pad-buffer-name module-name file-name) +;;; lists. + +(defvar *haskell-pad-mappings* () + "Associates pads with their corresponding module and file.") + +(defun haskell-record-pad-mapping (pname mname fname) + (setq *haskell-pad-mappings* + (cons (list pname mname fname) *haskell-pad-mappings*))) + +(defun haskell-get-module-from-pad (pname) + (car (cdr (assoc pname *haskell-pad-mappings*)))) + +(defun haskell-get-file-from-pad (pname) + (car (cdr (cdr (assoc pname *haskell-pad-mappings*))))) + +(defun haskell-lookup-pad (mname fname) + (let ((pname (haskell-lookup-pad-aux mname fname *haskell-pad-mappings*))) + (if (and pname (get-buffer pname)) + pname + nil))) + +(defun haskell-lookup-pad-aux (mname fname list) + (cond ((null list) + nil) + ((and (equal mname (car (cdr (car list)))) + (equal fname (car (cdr (cdr (car list)))))) + (car (car list))) + (t + (haskell-lookup-pad-aux mname fname (cdr list))))) + + + +;;; Save any modified .hs and .hu files. +;;; Yes, the two set-buffer calls really seem to be necessary. It seems +;;; that y-or-n-p makes emacs forget we had temporarily selected some +;;; other buffer, and if you just do save-buffer directly it will end +;;; up trying to save the current buffer instead. The built-in +;;; save-some-buffers function has this problem.... + +(defun haskell-save-modified-source-files (filename) + (let ((buffers (buffer-list)) + (found-any nil)) + (while buffers + (let ((buffer (car buffers))) + (if (and (buffer-modified-p buffer) + (save-excursion + (set-buffer buffer) + (and buffer-file-name + (haskell-source-file-p buffer-file-name) + (setq found-any t) + (or (null haskell-ask-before-saving) + (and filename (string= buffer-file-name filename)) + (y-or-n-p + (format "Save file %s? " buffer-file-name)))))) + (save-excursion + (set-buffer buffer) + (save-buffer)))) + (setq buffers (cdr buffers))) + (if found-any + (message "") + (message "(No files need saving)")))) + +(defun haskell-source-file-p (filename) + (or (string-match "\\.hs$" filename) + (string-match "\\.lhs$" filename) + (string-match "\\.hi$" filename) + (string-match "\\.hu$" filename))) + + + +;;; Buffer utilities + +(defun haskell-move-marker () + "Moves the marker and point to the end of buffer" + (set-marker comint-last-input-end (point-max)) + (set-marker (process-mark (get-process "haskell")) (point-max)) + (goto-char (point-max))) + + + +;;; Extract the name of the module the point is in, from the given buffer. + +(defvar *haskell-re-module-hs* "^module\\s *") +(defvar *haskell-re-module-lhs* "^>\\s *module\\s *") +(defvar *haskell-re-modname* "[A-Z]\\([a-z]\\|[A-Z]\\|[0-9]\\|'\\|_\\)*") + +(defun haskell-get-modname (buff) + "Get module name in BUFFER that point is in." + (save-excursion + (set-buffer buff) + (let ((regexp (if (haskell-lhs-filename-p (buffer-file-name)) + *haskell-re-module-lhs* + *haskell-re-module-hs*))) + (if (or (looking-at regexp) + (re-search-backward regexp (point-min) t) + (re-search-forward regexp (point-max) t)) + (progn + (goto-char (match-end 0)) + (if (looking-at *haskell-re-modname*) + (buffer-substring (match-beginning 0) (match-end 0)) + (haskell-mode-error "Module name not found!!"))) + "Main")))) + + +;;; Strip file extensions. +;;; Only strip off extensions we know about; e.g. +;;; "foo.hs" -> "foo" but "foo.bar" -> "foo.bar". + +(defvar *haskell-filename-regexp* "\\(.*\\)\\.\\(hs\\|lhs\\)$") + +(defun haskell-strip-file-extension (filename) + "Strip off the extension from a filename." + (if (string-match *haskell-filename-regexp* filename) + (substring filename (match-beginning 1) (match-end 1)) + filename)) + + +;;; Is this a .lhs filename? + +(defun haskell-lhs-filename-p (filename) + (string-match ".*\\.lhs$" filename)) + + +;;; Haskell mode error + +(defun haskell-mode-error (msg) + "Show MSG in message line as an error from the haskell mode." + (error (concat "Haskell mode: " msg))) + + + +;;; ================================================================== +;;; User customization +;;; ================================================================== + +(defvar haskell-load-hook nil + "This hook is run when haskell is loaded in. +This is a good place to put key bindings." + ) + +(run-hooks 'haskell-load-hook) + + + + +;;;====================================================================== +;;; Tutorial mode setup +;;;====================================================================== + +;;; Set up additional key bindings for tutorial mode. + +(defvar ht-mode-map (make-sparse-keymap)) + +(haskell-establish-key-bindings ht-mode-map) +(define-key ht-mode-map "\C-c\C-f" 'ht-next-page) +(define-key ht-mode-map "\C-c\C-b" 'ht-prev-page) +(define-key ht-mode-map "\C-c\C-l" 'ht-restore-page) +(define-key ht-mode-map "\C-c?" 'describe-mode) + +(defun haskell-tutorial-mode () + "Major mode for running the Haskell tutorial. +You can use these commands: +\\{ht-mode-map}" + (interactive) + (kill-all-local-variables) + (use-local-map ht-mode-map) + (setq major-mode 'haskell-tutorial-mode) + (setq mode-name "Haskell Tutorial") + (set-syntax-table haskell-mode-syntax-table) + (run-hooks 'haskell-mode-hook)) + + +(defun haskell-tutorial () + "Run the haskell tutorial." + (interactive) + (ht-load-tutorial) + (ht-make-buffer) + (ht-display-page) + (haskell-maybe-create-process) + (haskell-send-to-process ":(emacs-set-printers '(interactive))") + ) + + +;;; Load the tutorial file into a read-only buffer. Do not display this +;;; buffer. + +(defun ht-load-tutorial () + (let ((buffer (get-buffer *ht-file-buffer*))) + (if buffer + (save-excursion + (set-buffer buffer) + (beginning-of-buffer)) + (save-excursion + (set-buffer (setq buffer (get-buffer-create *ht-file-buffer*))) + (let ((fname (substitute-in-file-name *ht-source-file*))) + (if (file-readable-p fname) + (ht-load-tutorial-aux fname) + (call-interactively 'ht-load-tutorial-aux))))))) + +(defun ht-load-tutorial-aux (filename) + (interactive "fTutorial file: ") + (insert-file filename) + (set-buffer-modified-p nil) + (setq buffer-read-only t) + (beginning-of-buffer)) + + +;;; Create a buffer to use for messing about with each page of the tutorial. +;;; Put the buffer into haskell-tutorial-mode. + +(defun ht-make-buffer () + (find-file (concat "/tmp/" (make-temp-name "ht") ".lhs")) + (setq *ht-temp-buffer* (buffer-name)) + (haskell-tutorial-mode)) + + +;;; Commands for loading text into the tutorial pad buffer + +(defun ht-next-page () + "Go to the next tutorial page." + (interactive) + (if (ht-goto-next-page) + (ht-display-page) + (beep))) + +(defun ht-goto-next-page () + (let ((buff (current-buffer))) + (unwind-protect + (progn + (set-buffer *ht-file-buffer*) + (search-forward "\C-l" nil t)) + (set-buffer buff)))) + +(defun ht-prev-page () + "Go to the previous tutorial page." + (interactive) + (if (ht-goto-prev-page) + (ht-display-page) + (beep))) + +(defun ht-goto-prev-page () + (let ((buff (current-buffer))) + (unwind-protect + (progn + (set-buffer *ht-file-buffer*) + (search-backward "\C-l" nil t)) + (set-buffer buff)))) + +(defun ht-goto-page (arg) + "Go to the tutorial page specified as the argument." + (interactive "sGo to page: ") + (if (ht-searchfor-page (format "Page: %s " arg)) + (ht-display-page) + (beep))) + +(defun ht-goto-section (arg) + "Go to the tutorial section specified as the argument." + (interactive "sGo to section: ") + (if (ht-searchfor-page (format "Section: %s " arg)) + (ht-display-page) + (beep))) + +(defun ht-searchfor-page (search-string) + (let ((buff (current-buffer))) + (unwind-protect + (progn + (set-buffer *ht-file-buffer*) + (let ((point (point))) + (beginning-of-buffer) + (if (search-forward search-string nil t) + t + (progn + (goto-char point) + nil)))) + (set-buffer buff)))) + +(defun ht-restore-page () + (interactive) + (let ((old-point (point))) + (ht-display-page) + (goto-char old-point))) + +(defun ht-display-page () + (set-buffer *ht-file-buffer*) + (let* ((beg (progn + (if (search-backward "\C-l" nil t) + (forward-line 1) + (beginning-of-buffer)) + (point))) + (end (progn + (if (search-forward "\C-l" nil t) + (beginning-of-line) + (end-of-buffer)) + (point))) + (text (buffer-substring beg end))) + (set-buffer *ht-temp-buffer*) + (erase-buffer) + (insert text) + (beginning-of-buffer))) + + + +;;;====================================================================== +;;; Menu bar stuff +;;;====================================================================== + +;;; This only works in Emacs version 19, so it's in a separate file for now. + +(if (featurep 'menu-bar) + (load-library "haskell-menu")) diff --git a/ghc/CONTRIB/haskell-modes/yale/original/optimizer-help.txt b/ghc/CONTRIB/haskell-modes/yale/original/optimizer-help.txt new file mode 100644 index 0000000000..c18ac5db61 --- /dev/null +++ b/ghc/CONTRIB/haskell-modes/yale/original/optimizer-help.txt @@ -0,0 +1,6 @@ +Optimizer switches + inline Aggressively inline functions + constant Hoist constant expressions to top-level + foldr Perform foldr/build deforestation + lisp Tell the Lisp compiler to work hard to produce best code + delays Try to make delays out-of-line for more compact code diff --git a/ghc/CONTRIB/haskell-modes/yale/original/printer-help.txt b/ghc/CONTRIB/haskell-modes/yale/original/printer-help.txt new file mode 100644 index 0000000000..f8a620056e --- /dev/null +++ b/ghc/CONTRIB/haskell-modes/yale/original/printer-help.txt @@ -0,0 +1,26 @@ +General messages + compiling Printed when the compilation system starts a compilation + loading Printed when a previously compiled unit is loaded + reading Prints the name of the file being parsed + pad Enables printing within scratch pads + interactive Print verbose messages in command loop + prompt Print prompt in command loop +Timings + time Prints the time that it takes to execute a computation + phase-time Prints the time of each phase of compilation +Compiler passes + parse Prints the program recreated from ast + import Lists all symbols imported and exported for each module + scope Print the program after scoping and precedence parsing + depend Prints entire program in nested let's + type Prints signatures during inference + cfn Prints entire program after context free normalization + depend2 Like depend + flic Prints entire program as flic code + optimize Prints entire program as optimized flic code + optimize-extra Prints extra verbose information during optimization + strictness Print strictness of all functions and variables + codegen Prints generated Lisp code + codegen-flic Prints generated Lisp code and associated flic code + dumper Prints the code in the interface + dump-stat Prints statistics for the interface file |