diff options
| author | Yale AI Dept <ai@nebula.cs.yale.edu> | 1993-07-14 13:08:00 -0500 |
|---|---|---|
| committer | Duncan McGreggor <duncan.mcgreggor@rackspace.com> | 1993-07-14 13:08:00 -0500 |
| commit | 4e987026148fe65c323afbc93cd560c07bf06b3f (patch) | |
| tree | 26ae54177389edcbe453d25a00c38c2774e8b7d4 /emacs-tools | |
Import to github.
Diffstat (limited to 'emacs-tools')
| -rw-r--r-- | emacs-tools/README | 5 | ||||
| -rw-r--r-- | emacs-tools/comint.el | 1524 | ||||
| -rw-r--r-- | emacs-tools/comint.elc | bin | 0 -> 24467 bytes | |||
| -rw-r--r-- | emacs-tools/haskell.el | 2198 | ||||
| -rw-r--r-- | emacs-tools/haskell.elc | 788 | ||||
| -rw-r--r-- | emacs-tools/optimizer-help.txt | 5 | ||||
| -rw-r--r-- | emacs-tools/printer-help.txt | 24 |
7 files changed, 4544 insertions, 0 deletions
diff --git a/emacs-tools/README b/emacs-tools/README new file mode 100644 index 0000000..bb22105 --- /dev/null +++ b/emacs-tools/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/emacs-tools/comint.el b/emacs-tools/comint.el new file mode 100644 index 0000000..e690005 --- /dev/null +++ b/emacs-tools/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/emacs-tools/comint.elc b/emacs-tools/comint.elc Binary files differnew file mode 100644 index 0000000..0b9bf63 --- /dev/null +++ b/emacs-tools/comint.elc diff --git a/emacs-tools/haskell.el b/emacs-tools/haskell.el new file mode 100644 index 0000000..4130aea --- /dev/null +++ b/emacs-tools/haskell.el @@ -0,0 +1,2198 @@ +;;; ================================================================== +;;; 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-buffer* "*haskell*" + "*Name of the haskell process buffer") + +(defvar *haskell-show-error* 1 + "*If not nil move to the buffer where the error was found") + + +(defvar haskell-auto-create-process t + "*If not nil, create a Haskell process automatically when required to evaluate or compile Haskell code") + +(defvar *haskell-debug-in-lisp* nil + "*If not nil, enter Lisp debugger on error; otherwise, automagically return +to Haskell top-level.") + + +;;; Command interface related variables + +(defvar *emacs* nil + "When not nil means haskell is in emacs mode") + + +;;; Pad/buffer Initialization variables + +(defvar haskell-main-pad "\*Main-pad\*" + "Scratch pad associated with module Main") + +(defvar haskell-main-file "Main") + +(defvar haskell-main-module "Main") + + +(defvar *last-loaded* haskell-main-file + "Last file loaded with a :load command - Defaults to Main") + +(defvar *last-loaded-modtime* nil + "Modification time of last file loaded, used to determine whether it +needs to be reloaded.") + +(defvar *last-module* haskell-main-module + "Last module set with a :module command - Defaults to Main") + +(defvar *last-pad* haskell-main-pad + "Last pad saved with a :save command - Defaults to Main") + + +;;; These are used for haskell-tutorial mode. + +(defvar *ht-source-file* "$HASKELL/progs/tutorial/tutorial.hs") +(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 nil + "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-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:" 'haskell-command) + (define-key keymap "\C-cq" 'haskell-exit) + (define-key keymap "\C-ci" 'haskell-interrupt) + (define-key keymap "\C-cu" 'haskell-edit-unit) + (define-key keymap "\C-cd" 'haskell-please-recover) + (define-key keymap "\C-c(" 'haskell-ensure-lisp-mode) + (define-key keymap "\C-c)" 'haskell-resume-command-loop)) + + +(if haskell-mode-map + nil + (progn + (setq haskell-mode-map (make-sparse-keymap)) + ;; Compiler commands + (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. + +haskell-run-file: \\[haskell-run-file] + Runs a file. Ideally the file has a set of variable of type Dialogue + that get evaluated. + +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-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. + +switch-to-haskell: \\[switch-to-haskell] + Switchs to the inferior Haskell buffer (*haskell*) and positions the + cursor at the end of the 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 nil) + +(if inferior-haskell-mode-map + nil + (setq inferior-haskell-mode-map + (full-copy-sparse-keymap comint-mode-map)) + ;;; Haskell commands + (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-prev-l/c-dir/file nil + "Caches the (directory . file) pair used in the last invocation of +haskell-run-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") + +(defvar tea-prompt-pattern "^>+\\s-*" + "Regular expression capturing the T system prompt.") + +(defvar haskell-version "Yale University Haskell Version 0.8, 1991" + "Current Haskell system version") + +(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-run-file: \\[haskell-run-file] + Runs a file. Ideally the file has a set of variable of type Dialogue + that get evaluated. + +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-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. + +switch-to-haskell: \\[switch-to-haskell] + Switchs to the inferior Haskell buffer (*haskell*) and positions the + cursor at the end of the 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))) + + +;;; Install the process communication commands in the +;;; inferior-haskell-mode keymap. + +(defvar inferior-haskell-mode-hook 'haskell-fresh-start + "*Hook for customizing inferior-Haskell mode") + +(defun haskell-input-filter (str) + "Don't save whitespace." + (not (string-match "\\s *" str))) + + + +;;; ================================================================== +;;; Handle output from Haskell process +;;; ================================================================== + + +;;; 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. +;;; dead -- The process is dead (exited or not started yet). + + +(defvar *haskell-status* 'dead + "Status of the haskell process") + +(defun set-haskell-status (value) + (setq *haskell-status* value) + (update-mode-line)) + +(defun get-haskell-status () + *haskell-status*) + +(defun 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* 'dead) + (setq mode-line-process '(": %s: dead"))) + (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)))) + + +;;; Filter +;;; 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) + +(defun process-haskell-output (process str) + "Filter for output from Yale Haskell command interface" + (let ((idx 0) + (lastidx 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 idx to point to the first one. + ;; lastidx points to next character to be processed. + (while (setq idx (ci-response-start str lastidx)) + ;; Display any intervening ordinary text. + (if (not (eq idx lastidx)) + (haskell-display-output (substring str lastidx idx))) + ;; 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 -- usually (match-end 0). + (setq lastidx (funcall (ci-response-handler str idx) str idx))) + ;; Look to see whether the string ends with an incomplete + ;; command sequence. + ;; If so, save the tail of the string for next time. + (if (setq idx (ci-prefix-start str lastidx)) + (setq *haskell-saved-output* (substring str idx)) + (setq idx (length str))) + ;; Display any leftover ordinary text. + (if (not (eq idx lastidx)) + (haskell-display-output (substring str lastidx idx)))) + (store-match-data data)))) + + + +;;; Here is code for matching command sequences from haskell. + +;;; The first entry of each item is the full regexp; the second is a prefix +;;; regexp; the third is a handler function to call. + +(defvar *ci-responses* + '(("\C-Ar" "\C-A" haskell-got-ready) + ("\C-Ai" "\C-A" haskell-got-input-request) + ("\C-Ae" "\C-A" haskell-got-error) + ("\C-Ap.*\n" "\C-A\\(p.*\\)?" haskell-got-printers) + ("\C-Ao.*\n" "\C-A\\(o.*\\)?" haskell-got-optimizers) + ("\C-As.*\n" "\C-A\\(s.*\\)?" haskell-got-message) + ;; This is the error string for T +; ("^\\*\\* Error" +; "^\\*\\(\\*\\( \\(E\\(r\\(r\\(or?\\)?\\)?\\)?\\)?\\)?\\)?" +; haskell-got-lisp-error) + ;; This is the prompt for Lucid's break loop + ("\n-> " "\n\\(-\\(> ?\\)?\\)?" haskell-got-lisp-error) + ;; This is the prompt for CMU CL's break loop + ("0\\] " "0\\(\\] ?\\)?" haskell-got-lisp-error) + ;; This is the prompt for AKCL's break loop + ("USER>>" "U\\(S\\(E\\(R\\(>>?\\)?\\)?\\)?\\)?" haskell-got-lisp-error) + ;; This is the prompt for Allegro CL + ("USER(.*):" "U\\(S\\(E\\(R\\((.*)?\\)?\\)?\\)?\\)?" haskell-got-lisp-error) + ;; This is the prompt for Harlequin Lispworks + ("USER .* : .* >" "U\\(S\\(E\\(R\\( .*\\( \\(:\\( .*\\( >?\\)?\\)?\\)?\\)?\\)?\\)?\\)?\\)?" haskell-got-lisp-error) + )) + +(defun command-match-regexp (x) (car x)) +(defun command-prefix-regexp (x) (car (cdr x))) +(defun command-handler (x) (car (cdr (cdr x)))) + +(defun glue-together (extractor) + (let ((result (concat "\\(" (funcall extractor (car *ci-responses*)) "\\)")) + (stuff (cdr *ci-responses*))) + (while stuff + (setq result + (concat result "\\|\\(" (funcall extractor (car stuff)) "\\)")) + (setq stuff (cdr stuff))) + result)) + +(defvar *ci-response-regexp* (glue-together 'command-match-regexp)) + +(defvar *ci-prefix-regexp* + (concat "\\(" (glue-together 'command-prefix-regexp) "\\)\\'")) + +(defun ci-response-start (str idx) + (string-match *ci-response-regexp* str idx)) + +(defun ci-prefix-start (str idx) + (string-match *ci-prefix-regexp* str idx)) + +(defun ci-response-handler (str idx) + (let ((list *ci-responses*) + (result nil)) + (while (and list (null result)) + (if (eq (string-match (command-match-regexp (car list)) str idx) idx) + (setq result (command-handler (car list))) + (setq list (cdr list)))) + (if (null result) + (haskell-mode-error "Failed to find command handler!!!")) + result)) + + +;;; Here are the low-level handler functions. Basically, these +;;; guys just parse the input for the command sequence and then call some +;;; other function to do the real work. + +(defun haskell-got-ready (str idx) + (let ((result (match-end 0))) + (haskell-reset) + result)) + +(defun haskell-got-input-request (str idx) + (let ((result (match-end 0))) + (get-user-input) + result)) + +(defun haskell-got-error (str idx) + (let ((result (match-end 0))) + (haskell-error-handler) + result)) + +(defun haskell-got-printers (str idx) + (let ((result (match-end 0))) + (update-printers-list (substring str (+ idx 2) (- result 1))) + result)) + +(defun haskell-got-optimizers (str idx) + (let ((result (match-end 0))) + (update-optimizers-list (substring str (+ idx 2) (- result 1))) + result)) + +(defun haskell-got-message (str idx) + (let ((result (match-end 0))) + (message (substring str (+ idx 2) (- result 1))) + result)) + +(defun haskell-got-lisp-error (str idx) + (haskell-handle-lisp-error idx str) + (length str)) + + +;;; Something really bad happened and we got a Lisp error. +;;; Either let the user mess around in the Lisp debugger, or else +;;; just get out of it and go back into the Haskell command loop. + +(defun haskell-handle-lisp-error (location str) + (haskell-display-output (substring str location)) + (if *emacs* + ;; Don't ding if we were already in the break loop when the + ;; error happened. + (progn + (ding) + (if *haskell-debug-in-lisp* + (haskell-talk-to-lisp) + (haskell-flush-commands-and-reset))))) + +(defun loaded-tutorial-p () + (and *ht-temp-buffer* + (get-buffer *ht-temp-buffer*) + (equal *last-loaded* (buffer-file-name (get-buffer *ht-temp-buffer*))))) + +(defun haskell-flush-commands-and-reset () + (haskell-flush-command-queue) + (save-excursion + (switch-to-buffer *haskell-buffer*) + (haskell-ensure-lisp-mode) + (haskell-resume-command-loop))) + +(defun haskell-talk-to-lisp () + (pop-to-buffer *haskell-buffer*) + (goto-char (point-max)) + (haskell-ensure-lisp-mode)) + + +(defun haskell-resume-command-loop () + "Resumes Haskell command processing after debugging in Lisp. \\[haskell-resume-command-loop]" + (interactive) + (if (not *emacs*) + (progn + (process-send-string "haskell" "(mumble-user::restart-haskell)\n") + (haskell-ensure-emacs-mode)))) + + + +;;; 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) + (if (eq (get-haskell-status) 'dead) + (save-excursion + (set-buffer *haskell-buffer*) + (haskell-display-output-aux 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)) + + + +;;; The haskell process says it's expecting the user to type in some input. +;;; Switch to the *haskell-buffer* so the user can type things. +;;; Once we have received an input message, stay in input mode until +;;; we get a ready message back from haskell. This permits multiple +;;; data messages to be sent to haskell from a single input request. +;;; +;;; This user interface isn't really ideal. You can be typing +;;; away in some other buffer and all of a sudden have Haskell decide +;;; it wants some input, and bingo! You're switched into the Haskell +;;; buffer behind your back. There's also the problem that you're +;;; left in the Haskell buffer afterwards, instead of getting swapped +;;; back into the buffer that was current when the input request was +;;; received. +;;; Not sure how to fix this -- seems like a totally synchronous interface +;;; would be worse.... + +(defun get-user-input () + (message "Haskell is waiting for input...") + (pop-to-buffer *haskell-buffer*) + (goto-char (point-max)) + (set-haskell-status 'input) + (haskell-pop-data-queue)) + + +;;; The haskell process says it encountered an error. +;;; Remember to flush the command queue before continuing. + +(defun haskell-error-handler () + (ding) + (haskell-flush-command-queue) + ;; *** See comments below for why this is disabled. +; (if *haskell-show-error* +; (haskell-show-error)) + (set-haskell-status 'ready) + (haskell-end-interaction nil)) + + +;;; Pop up a buffer containing the file with the error, and put the +;;; point on the line where the error was reported. +;;; *** This code does the wrong thing in some situations. For example, +;;; *** if you type in garbage to C-c e, it thinks that it should +;;; *** show you the last pad sent to the haskell process, which is +;;; *** clearly bogus. +;;; *** I also think it would be better interaction style to have to +;;; *** request to be shown the error explicitly, instead of unexpectedly +;;; *** being thrown into some other buffer. + +;;; Error handling Variables + +(defvar *yh-error-def* "Error occured in definition of\\s *") +(defvar *yh-error-line* "at line\\s *") +(defvar *yh-error-file* "of file\\s *") +(defvar *haskell-line* "\\([0-9]\\)*") + +(defun haskell-show-error () + "Point out error to user if possible" + (set-buffer *haskell-buffer*) + (save-excursion + (let ((function-name nil) + (line-number nil) + (filename nil)) + (if (and (setq function-name (get-function-name)) + (setq line-number (get-line-number)) + (setq filename (get-filename))) + (point-error-to-user function-name line-number filename))))) + +(defvar *haskell-function-name* + "\\([a-z]\\|[A-Z]\\|[0-9]\\|'\\|_\\|\-\\)*") + +(defun get-function-name () + (if (and (re-search-backward *yh-error-def* (point-min) t) + (re-search-forward *yh-error-def* (point-max) t)) + (let ((beg (point))) + (if (re-search-forward *haskell-function-name* (point-max) t) + (buffer-substring beg (point)) + nil)) + nil)) + +(defun get-line-number () + (if (re-search-forward *yh-error-line* (point-max) t) + (let ((beg (point))) + (if (re-search-forward *haskell-line* (point-max) t) + (string-to-int (buffer-substring beg (point))) + nil)) + nil)) + + +(defun get-filename () + (if (re-search-forward *yh-error-file* (point-max) t) + (let ((beg (point))) + (if (re-search-forward "\\($\\| \\|\t\\)" (point-max) t) + (buffer-substring beg (point)) + nil)) + nil)) + +(defun point-error-to-user (function-name line-number filename) + (if (equal filename "Interactive") + (pop-to-buffer *last-pad*) + (let ((fname (strip-fext filename))) + (if (get-buffer fname) + (pop-to-buffer fname) + (find-file-other-window filename)))) + (goto-line line-number)) + + +;;; The haskell process says it is ready to execute another command. +;;; Tell the user the last command has finished and execute the next +;;; command from the queue, if there is one. + +(defun haskell-reset () + (set-haskell-status 'ready) + (haskell-pop-command-queue)) + + + + +;;; ================================================================== +;;; Command queue utilities +;;; ================================================================== + +;;; Here's the stuff for managing the command queue. +;;; There are three kinds of things that show up in the queue: +;;; * Strings to be sent as commands to the haskell process. These +;;; are queued with haskell-send-command. +;;; * Other stuff to be sent to the haskell process (e.g., text to +;;; be read as dialogue input). These are queued with +;;; haskell-send-data. +;;; * Messages indicating start of an interaction sequence. These +;;; are just shown to the user. These are added to the queue with +;;; haskell-begin-interaction. +;;; * Messages indicating end of an interaction sequence. These are +;;; queued with haskell-end-interaction. +;;; +;;; Representationally, the queue is just a list of conses. The car of each +;;; entry is a symbol that identifies the kind of queue entry, and the cdr +;;; is associated data. Only the functions in this section need to know +;;; about the internal format of the queue. + + +(defvar *command-interface-queue* nil + "Contains the commands to be sent to the Haskell command interface") + + +;;; Here's a helper function. + +(defun haskell-queue-or-execute (fn request data) + (cond (*command-interface-queue* + (setq *command-interface-queue* + (nconc *command-interface-queue* (list (cons request data))))) + ((eq (get-haskell-status) 'ready) + (funcall fn data)) + (t + (setq *command-interface-queue* (list (cons request data)))))) + + +;;; Queue a command. + +(defun haskell-send-command (str) + "Queues STRING for transmission to haskell process." + (haskell-queue-or-execute 'haskell-send-command-aux 'command str)) + +(defun haskell-send-command-aux (str) + (process-send-string "haskell" str) + (process-send-string "haskell" "\n") + (if (not (eq (get-haskell-status) 'input)) + (set-haskell-status 'busy))) + + +;;; Queue a begin-interaction message. + +(defvar *begin-interaction-delimiter* nil ;; "-------------\n" + "*Delimiter showing an interaction has begun") + +(defun haskell-begin-interaction (msg) + (haskell-queue-or-execute 'haskell-begin-interaction-aux 'begin msg)) + +(defun haskell-begin-interaction-aux (msg) + (if *begin-interaction-delimiter* + (haskell-display-output *begin-interaction-delimiter*)) + (if msg + (haskell-display-output (concat "\n" msg "\n")))) + + +;;; Queue an end-interaction message. + +(defvar *end-interaction-delimiter* nil ;; "\n--- ready ---\n\n" + "*Delimiter showing an interaction has ended") + +(defun haskell-end-interaction (msg) + (haskell-queue-or-execute 'haskell-end-interaction-aux 'end msg)) + +(defun haskell-end-interaction-aux (msg) + (if *end-interaction-delimiter* + (haskell-display-output *end-interaction-delimiter*)) + (if msg + (message "%s" msg))) + + +;;; Queue data. This is treated a little differently because we want +;;; text typed in as input to the program to be sent down the pipe to +;;; the process before processing end-interaction messages and additional +;;; commands in the queue. + +(defun haskell-send-data (str) + (cond ((assoc 'data *command-interface-queue*) + (setq *command-interface-queue* + (merge-data-into-queue + (list (cons 'data str)) + *command-interface-queue* + *command-interface-queue* + nil))) + ((or (eq (get-haskell-status) 'ready) (eq (get-haskell-status) 'input)) + (haskell-send-command-aux str)) + (t + (setq *command-interface-queue* (list (cons 'data str)))))) + +(defun merge-data-into-queue (new head tail lasttail) + (cond ((null tail) + (rplacd lasttail new) + head) + ((eq (car (car tail)) 'data) + (merge-data-into-queue new head (cdr tail) tail)) + (lasttail + (rplacd lasttail new) + (rplacd new tail) + head) + (t + (rplacd new tail) + new))) + + +;;; This function is called when the haskell process reports that it +;;; has finished processing a command. It sends the next queued +;;; command (if there is one) down the pipe. + +(defun haskell-pop-command-queue () + (if *command-interface-queue* + (let ((entry (car *command-interface-queue*))) + (setq *command-interface-queue* (cdr *command-interface-queue*)) + (cond ((eq (car entry) 'command) + (haskell-send-command-aux (cdr entry))) + ((eq (car entry) 'begin) + (haskell-begin-interaction-aux (cdr entry)) + (haskell-pop-command-queue)) + ((eq (car entry) 'end) + (haskell-end-interaction-aux (cdr entry)) + (haskell-pop-command-queue)) + ((eq (car entry) 'data) + (haskell-send-command-aux (cdr entry))) + (t + (haskell-mode-error "Invalid command in queue!!!")) + )))) + + +;;; This function is called when the haskell process reports that it +;;; wants to read some input. If there's queued data, send it; but +;;; don't do commands or messages on the queue. +;;; Remember, we can send multiple pieces of input data for one input +;;; request from haskell. + +(defun haskell-pop-data-queue () + (if *command-interface-queue* + (let ((entry (car *command-interface-queue*))) + (if (eq (car entry) 'data) + (progn + (setq *command-interface-queue* (cdr *command-interface-queue*)) + (haskell-send-command-aux (cdr entry)) + (haskell-pop-data-queue)))))) + + +;;; This is called when there is an error. + +(defun haskell-flush-command-queue () + (setq *command-interface-queue* nil)) + + + +;;; ================================================================== +;;; Interactive commands +;;; ================================================================== + + +;;; HASKELL and RUN HASKELL +;;; ------------------------------------------------------------------ + +;;; These are the two functions that start a Haskell process. +;;; Rewritten to avoid doing anything if a Haskell process +;;; already exists. 1991-Sep-09 Dan Rabin. + +;;; *** Dan says: +;;; *** If the *haskell* buffer still exists, and the process has status +;;; *** `dead', the usual evaluation commands don't create a new one, so no +;;; *** evaluation happens. + + +(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) + (let ((haskell-buffer (get-buffer *haskell-buffer*))) + (if (not (and haskell-buffer (comint-check-proc haskell-buffer))) + (progn + (setq haskell-buffer + (apply 'make-comint + "haskell" + haskell-program-name + nil + nil)) + (save-excursion + (set-buffer haskell-buffer) + (inferior-haskell-mode)) + (display-buffer haskell-buffer))))) + + +;;; Fresh start + +(defun haskell-fresh-start () + (set-haskell-status 'busy) + (setq *command-interface-queue* nil) + (setq *last-loaded* haskell-main-file) + (setq *last-pad* haskell-main-pad) + (setq *emacs* nil) + (setq *haskell-saved-output* nil) + (haskell-ensure-emacs-mode)) + + +;;; Called from evaluation and compilation commands to start up a Haskell +;;; process if none is already in progress. + +(defun haskell-maybe-create-process () + (if haskell-auto-create-process + (haskell))) + + +;;; This is called from HASKELL-FRESH-START to ensure that +;;; there is a pad when starting up a Haskell interaction. + +(defun haskell-ensure-emacs-mode () + (create-main-pad) + (setq *emacs* t) + (ci-emacs)) + + +;;; This is called when a Lisp error has been detected. + +(defun haskell-ensure-lisp-mode () + "Switch to talking to Lisp. \\[haskell-ensure-lisp-mode]" + (interactive) + (setq *emacs* nil)) + + +;;; 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 (get-modname buff) + (read-no-blanks-input "Scratch pad for module? " nil))) + (pname (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 (or (not pname) (not (setq pbuff (get-buffer pname)))) + (progn + (setq pname (get-padname mname)) + (setq pbuff (generate-new-buffer pname)) + (setq pname (buffer-name pbuff)) + (record-pad-mapping pname mname fname) + )) + ;; 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) + (switch-to-haskell t)) + + +(defun switch-to-haskell (eob-p) + "Really switch to the \*haskell\* buffer. +With argument, positions cursor at end of buffer." + (interactive "P") + (pop-to-buffer *haskell-buffer*) + (cond (eob-p + (push-mark) + (goto-char (point-max))))) + + +;;; HASKELL-COMMAND +;;; ------------------------------------------------------------------ + +(defun haskell-command (str) + "Format STRING as a haskell command and send it to haskell process. \\[haskell-command]" + (interactive "sHaskell command: ") + (if (eq ?Q (capitalize (aref str 0))) + (ci-quit) + (progn + (haskell-begin-interaction + (concat "Executing command: :" str)) + (haskell-send-command (concat ":" str)) + (haskell-end-interaction + (concat "Executing command: :" str " ...done."))))) + + +;;; HASKELL-EVAL and HASKELL-RUN +;;; ------------------------------------------------------------------ + +(defun haskell-eval () + "Evaluate expression in current module. \\[haskell-eval]" + (interactive) + (haskell-maybe-create-process) + (haskell-eval-aux (get-haskell-expression "Haskell expression: ") + nil + "Evaluating")) + +(defun haskell-run () + "Run Haskell Dialogue in current module" + (interactive) + (haskell-maybe-create-process) + (haskell-eval-aux (get-haskell-expression "Haskell dialogue: ") + t + "Running")) + +(defun haskell-run-main () + "Run Dialogue named main in current module" + (interactive) + (haskell-maybe-create-process) + (haskell-eval-aux "main" t "Running")) + +(defun haskell-eval-aux (exp dialogue-p what) + (cond ((equal *haskell-buffer* (buffer-name)) + (let* ((pname *last-pad*) + (mname *last-module*) + (fname *last-loaded*) + (msg (format "%s: %s" what exp))) + (haskell-eval-aux-aux exp pname mname fname msg dialogue-p))) + ((equal *ht-temp-buffer* (buffer-name)) + (let* ((fname (buffer-file-name)) + (mname (get-modname (current-buffer))) + (pname (lookup-pad mname fname)) + (msg (format "%s (in tutorial): %s" what exp))) + (haskell-eval-aux-aux exp pname mname fname msg dialogue-p))) + ((buffer-file-name) + (let* ((fname (buffer-file-name)) + (mname (get-modname (current-buffer))) + (pname (lookup-pad mname fname)) + (msg (format "%s (in file %s): %s" + what (file-name-nondirectory fname) exp))) + (haskell-eval-aux-aux exp pname mname fname msg dialogue-p))) + (t + (let* ((pname (buffer-name (current-buffer))) + (mname (get-module-from-pad pname)) + (fname (get-file-from-pad pname)) + (msg (format "%s (in pad %s): %s" what pname exp))) + (haskell-eval-aux-aux exp pname mname fname msg dialogue-p))) + )) + +(defun haskell-eval-aux-aux (exp pname mname fname msg dialogue-p) + (haskell-begin-interaction msg) + (ci-kill) + (haskell-load-file-if-modified fname) + (ci-module mname) + (if pname (haskell-save-pad-if-modified pname)) + (if dialogue-p + (ci-send-name exp) + (ci-print-exp exp)) + (ci-eval) + (haskell-end-interaction (concat msg " ...done."))) + + +;;; Save pad only if modified. Keep track of *last-pad* sent to process. + +(defun haskell-save-pad-if-modified (pad) + (save-excursion + (set-buffer pad) + (if (or (equal pad haskell-main-pad) (buffer-modified-p)) + (progn + (setq *last-pad* pad) + (ci-clear) + (ci-set-file pad) + (ci-send-buffer pad) +; (set-buffer-modified-p t) ;***??? + (ci-save))))) + + + +;;; HASKELL-RUN-FILE +;;; ------------------------------------------------------------------ + +(defun haskell-run-file () + "Run all Dialogues in current file" + (interactive) + (haskell-maybe-create-process) + (cond ((equal *haskell-buffer* (buffer-name)) + ;; When called from the haskell process buffer, prompt for + ;; a file to run. + (call-interactively 'haskell-run-file/process)) + ((buffer-file-name) + ;; When called from a .hs file buffer, run that file. + (haskell-run-file-aux (buffer-file-name))) + (t + ;; When called from a pad, run the file that the module the + ;; pad belongs to lives in. + (haskell-run-file-aux + (get-file-from-pad (buffer-name (current-buffer))))) + )) + +(defun haskell-run-file/process (filename) + (interactive (comint-get-source "Haskell file to run: " + haskell-prev-l/c-dir/file + haskell-source-modes t)) + (comint-check-source filename) + (setq haskell-prev-l/c-dir/file + (cons (file-name-directory filename) + (file-name-nondirectory filename))) + (haskell-run-file-aux filename)) + +(defun haskell-run-file-aux (fname) + (let ((msg (concat "Running file: " fname))) + (haskell-begin-interaction msg) + (ci-kill) + (save-modified-source-files buffer-file-name) + (ci-run (strip-fext fname)) + (haskell-end-interaction (concat msg " ...done.")))) + + +;;; HASKELL-LOAD +;;; ------------------------------------------------------------------ + +(defun haskell-load () + "Load current file" + (interactive) + (haskell-maybe-create-process) + (let* ((fname (buffer-file-name)) + (msg (concat "Loading file: " fname))) + (cond (fname + (haskell-begin-interaction msg) + (haskell-load-file-if-modified fname) + (haskell-end-interaction (concat msg " ...done."))) + (t + (haskell-mode-error "Must be in a file to load"))))) + + +;;; Load file only if modified or not *last-loaded*. +;;; For now, this just loads the file unconditionally. + +(defun haskell-load-file-if-modified (filename) + (save-modified-source-files buffer-file-name) + (cond ((string= filename haskell-main-file) + (setq *last-loaded* haskell-main-file) + (ci-load-main)) + (t + (setq *last-loaded* filename) + (ci-load (strip-fext filename))))) + + +;;; ***This isn't used any more. +;(defun file-modification-time (file) +; "Get modification time for FILE from filesystem information." +; (car (cdr (car (nthcdr 5 (file-attributes file)))))) + + +;;; HASKELL-COMPILE +;;; ------------------------------------------------------------------ + +(defun haskell-compile () + "Compile current file" + (interactive) + (haskell-maybe-create-process) + (let ((fname (buffer-file-name))) + (cond (fname + (haskell-begin-interaction (concat "Compiling: " fname)) + (haskell-compile-file-if-modified fname) + (haskell-end-interaction + (concat "Compiling: " fname " ...done."))) + (t + (haskell-mode-error "Must be in a file to compile"))))) + +(defun haskell-compile-file-if-modified (fname) + ;; *** For now it unconditionally compiles the file. + (save-modified-source-files buffer-file-name) + (ci-compile (strip-fext fname))) + + +;;; HASKELL-EXIT +;;; ------------------------------------------------------------------ + +(defun haskell-exit () + "Quit the haskell process" + (interactive) + (ci-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*)) + + +;;; HASKELL-INTERRUPT +;;; ------------------------------------------------------------------ + +(defun haskell-interrupt () + "Interrupt the haskell process" + (interactive) + ;; Do not queue the interrupt character; send it immediately. + (haskell-send-command-aux "\C-c") ; interrupt Haskell + (haskell-end-interaction "done.") ; send a reset to Lisp + ) + + +;;; 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))) + (find-file-other-window units-fname) + (if file-not-found + ;; *** this is broken. + (units-add-source-file + (if (string= (file-name-directory fname) + (file-name-directory units-fname)) + (file-name-nondirectory fname) + fname)))) + (haskell-mode-error "Not in a .hs buffer")))) + +(defun haskell-new-unit () + (setq file-not-found t)) + +(defun units-add-source-file (file) + (save-excursion + (insert (strip-fext file) "\n"))) + + +;;; 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 () + (let ((name nil)) + (save-excursion + (beginning-of-buffer) + (if (re-search-forward "-- unit:[ \t]*" (point-max) t) + (let ((beg (match-end 0))) + (end-of-line) + (setq name (buffer-substring beg (point)))) + (setq name (concat (strip-fext (buffer-file-name)) ".hu")))) + name)) + + +;;; HASKELL-PLEASE-RECOVER +;;; ------------------------------------------------------------------ + +(defun haskell-please-recover () + (interactive) + (haskell-flush-commands-and-reset) + (haskell-end-interaction "done.")) + + + +;;; ================================================================== +;;; 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" 'haskell-menu-mark) + (define-key haskell-menu-mode-map "u" 'haskell-menu-unmark) + (define-key haskell-menu-mode-map "x" 'haskell-menu-exit) + (define-key haskell-menu-mode-map "q" 'haskell-menu-exit) + (define-key haskell-menu-mode-map " " 'next-line) + (define-key haskell-menu-mode-map "\177" 'haskell-menu-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 'haskell-menu-current-flags) + (make-local-variable 'haskell-menu-request-fn) + (make-local-variable 'haskell-menu-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 haskell-menu-request-fn request-fn) + (setq haskell-menu-update-fn update-fn) + )) + (haskell-menu-mark-current) + (message "m = mark; u = unmark; x = execute; q = quit; ? = more help.")) + + + +;;; A line that starts with *haskell-menu-marked* is a menu item turned on. +;;; A line that starts with *haskell-menu-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 *haskell-menu-marked* " on") +(defvar *haskell-menu-unmarked* " ") +(defvar *haskell-menu-marked-regexp* " on \\w") +(defvar *haskell-menu-unmarked-regexp* " \\w") + +(defun haskell-menu-mark () + "Mark flag to be turned on." + (interactive) + (beginning-of-line) + (cond ((looking-at *haskell-menu-marked-regexp*) + (forward-line 1)) + ((looking-at *haskell-menu-unmarked-regexp*) + (let ((buffer-read-only nil)) + (delete-char (length *haskell-menu-unmarked*)) + (insert *haskell-menu-marked*) + (forward-line 1))) + (t + (forward-line 1)))) + +(defun haskell-menu-unmark () + "Unmark flag." + (interactive) + (beginning-of-line) + (cond ((looking-at *haskell-menu-unmarked-regexp*) + (forward-line 1)) + ((looking-at *haskell-menu-marked-regexp*) + (let ((buffer-read-only nil)) + (delete-char (length *haskell-menu-marked*)) + (insert *haskell-menu-unmarked*) + (forward-line 1))) + (t + (forward-line 1)))) + +(defun haskell-menu-backup-unmark () + "Move up and unmark." + (interactive) + (forward-line -1) + (haskell-menu-unmark) + (forward-line -1)) + + +;;; Actually make the changes. + +(defun haskell-menu-exit () + "Update flags, then leave menu." + (interactive) + (haskell-menu-execute) + (haskell-menu-quit)) + +(defun haskell-menu-execute () + "Tell haskell process to tweak flags." + (interactive) + (start-setting-flags) + (save-excursion + (goto-char (point-min)) + (while (not (eq (point) (point-max))) + (cond ((looking-at *haskell-menu-unmarked-regexp*) + (funcall haskell-menu-update-fn (haskell-menu-flag) nil)) + ((looking-at *haskell-menu-marked-regexp*) + (funcall haskell-menu-update-fn (haskell-menu-flag) t)) + (t + nil)) + (forward-line 1))) + (finish-setting-flags)) + +(defun haskell-menu-quit () + (interactive) + "Make the menu go away." + (bury-buffer (current-buffer)) + (replace-buffer-in-windows (current-buffer))) + + +(defun haskell-menu-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))))) + + +(defun start-setting-flags () + nil) + +(defun finish-setting-flags () + (haskell-end-interaction "Setting flags....done.")) + + +;;; Update the menu to mark only those items currently turned on. + +(defun haskell-menu-mark-current () + (funcall haskell-menu-request-fn) + (save-excursion + (goto-char (point-min)) + (while (not (eq (point) (point-max))) + (cond ((and (looking-at *haskell-menu-unmarked-regexp*) + (menu-item-currently-on-p (haskell-menu-flag))) + (haskell-menu-mark)) + ((and (looking-at *haskell-menu-marked-regexp*) + (not (menu-item-currently-on-p (haskell-menu-flag)))) + (haskell-menu-unmark)) + (t + (forward-line 1)))))) + + +;;; See if a menu item is turned on. + +(defun menu-item-currently-on-p (item) + (member-string= item haskell-menu-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* + 'get-current-printers + 'set-current-printers)) + +(defun get-current-printers () + (setq haskell-menu-current-flags t) + (haskell-send-command ":p?") + (while (eq haskell-menu-current-flags t) + (sleep-for 1))) + +(defun update-printers-list (data) + (setq haskell-menu-current-flags (read data))) + +(defun set-current-printers (flag on) + (let ((was-on (menu-item-currently-on-p flag))) + (cond ((and on (not was-on)) + (haskell-send-command (format ":p+ %s" flag))) + ((and (not on) was-on) + (haskell-send-command (format ":p- %s" flag))) + (t + nil)))) + + +;;; 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* + 'get-current-optimizers + 'set-current-optimizers)) + +(defun get-current-optimizers () + (setq haskell-menu-current-flags t) + (haskell-send-command ":o?") + (while (eq haskell-menu-current-flags t) + (sleep-for 1))) + +(defun update-optimizers-list (data) + (setq haskell-menu-current-flags (read data))) + +(defun set-current-optimizers (flag on) + (let ((was-on (menu-item-currently-on-p flag))) + (cond ((and on (not was-on)) + (haskell-send-command (format ":o+ %s" flag))) + ((and (not on) was-on) + (haskell-send-command (format ":o- %s" flag))) + (t + nil)))) + + + + +;;; ================================================================== +;;; 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 *pad-mappings* () + "Associates pads with their corresponding module and file.") + +(defun record-pad-mapping (pname mname fname) + (setq *pad-mappings* + (cons (list pname mname fname) *pad-mappings*))) + +(defun get-module-from-pad (pname) + (car (cdr (assoc pname *pad-mappings*)))) + +(defun get-file-from-pad (pname) + (car (cdr (cdr (assoc pname *pad-mappings*))))) + +(defun lookup-pad (mname fname) + (lookup-pad-aux mname fname *pad-mappings*)) + +(defun 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 + (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.... + +(defvar *ask-before-saving* t) + +(defun 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 + (source-file-p buffer-file-name) + (setq found-any t) + (or (null *ask-before-saving*) + (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 source-file-p (filename) + (or (string-match "\\.hs$" filename) + (string-match "\\.lhs$" filename) + (string-match "\\.hu$" filename) + (string-match "\\.shu$" filename) + (string-match "\\.hsp$" filename) + (string-match "\\.prim$" 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))) + + +;;; Pad utils + +(defun create-main-pad () + (let ((buffer (get-buffer-create haskell-main-pad))) + (save-excursion + (set-buffer buffer) + (haskell-mode)) + (record-pad-mapping haskell-main-pad haskell-main-module haskell-main-file) + buffer)) + + +;;; Extract the name of the module the point is in, from the given buffer. + +(defvar *re-module* "^module\\s *\\|^>\\s *module\\s *") +(defvar *re-modname* "[A-Z]\\([a-z]\\|[A-Z]\\|[0-9]\\|'\\|_\\)*") + +(defun get-modname (buff) + "Get module name in BUFFER that point is in." + (save-excursion + (set-buffer buff) + (if (or (looking-at *re-module*) + (re-search-backward *re-module* (point-min) t) + (re-search-forward *re-module* (point-max) t)) + (progn + (goto-char (match-end 0)) + (if (looking-at *re-modname*) + (buffer-substring (match-beginning 0) (match-end 0)) + (haskell-mode-error "Module name not found!!"))) + "Main"))) + + +;;; Build the base name for a pad buffer. + +(defun get-padname (m) + "Build padname from module name" + (concat "*" m "-pad*")) + + +;;; 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 strip-fext (filename) + "Strip off the extension from a filename." + (if (string-match *haskell-filename-regexp* filename) + (substring filename (match-beginning 1) (match-end 1)) + 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))) + + + + +;;; ================================================================== +;;; Command generators +;;; ================================================================== + +;;; Generate Haskell command interface commands. These are very simple +;;; routines building the string commands to be sent to the haskell +;;; process. + +(defun ci-send-buffer (buff) + "Send BUFFER to haskell process." + (let ((str (buffer-string))) + (if (not (string-match "\\`\\s *\\'" str)) ; ignore if all whitespace + (save-excursion + (set-buffer buff) + (haskell-send-command str))))) + +(defun ci-kill () + (haskell-send-command ":kill")) + +(defun ci-clear () + (haskell-send-command ":clear")) + +(defun ci-set-file (file-name) + (haskell-send-command (concat ":file " file-name))) + +(defun ci-module (modname) + (setq *last-module* modname) + (haskell-send-command (concat ":module " modname))) + + +;;; Keeps track of the last file loaded. +;;; Change to do a :compile (temporary until new csys) +;;; 2-Aug-91 Dan Rabin. + +(defun ci-load (filename) + (haskell-send-command (concat ":load " filename))) + +(defun ci-load-main () + (haskell-send-command ":Main")) + +(defun ci-save () + (haskell-send-command ":save")) + +(defun ci-compile (filename) + (haskell-send-command (concat ":compile " filename))) + +(defun ci-run (filename) + (haskell-send-command (concat ":run " filename))) + +(defun ci-print-exp (exp) + (ci-set-file "interactive-expression-buffer") + (haskell-send-command (concat "= " exp))) + +(defun ci-send-name (name) + (let ((temp (make-temp-name "etemp"))) + (ci-set-file "interactive-expression-buffer") + (haskell-send-command (concat temp " = " name)))) + +(defun ci-eval () + (haskell-send-command ":eval")) + +(defun ci-quit () + (cond ((not (get-buffer-process *haskell-buffer*)) + (message "No process currently running.")) + ((y-or-n-p "Do you really want to quit Haskell? ") + (process-send-string "haskell" ":quit\n") + (set-haskell-status 'dead)) + (t + nil))) + + +;;; When setting emacs mode (on/off) +;;; (a) Set process-filter +;;; (b) Send :Emacs command to Haskell process + +(defun ci-emacs () + (haskell-reset) + (set-process-filter (get-process "haskell") 'process-haskell-output) + (haskell-send-command ":Emacs on")) + + + + + + +;;; ================================================================== +;;; 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))))))) + + +;;; Modified for Haskell (taken from comint-send-input) + +(defun haskell-send-input () + "Send input to Haskell while in the process buffer" + (interactive) + (if *emacs* + (haskell-send-input-aux) + (comint-send-input))) + +(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-data 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)) + (t (ding))))) + +(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 get-haskell-expression (prompt) + (let ((exp (read-from-minibuffer prompt nil haskell-minibuffer-local-map))) + (ring-insert haskell-prompt-ring exp) + exp)) + + + + +;;; ================================================================== +;;; 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 nil) + +(if ht-mode-map + nil + (progn + (setq 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)) + + +;;; 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") ".hs")) + (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))) diff --git a/emacs-tools/haskell.elc b/emacs-tools/haskell.elc new file mode 100644 index 0000000..165e126 --- /dev/null +++ b/emacs-tools/haskell.elc @@ -0,0 +1,788 @@ + +(provide (quote haskell)) + +(require (quote comint)) + +(defvar haskell-program-name (getenv "HASKELLPROG") "\ +*Program invoked by the haskell command") + +(defvar *haskell-buffer* "*haskell*" "\ +*Name of the haskell process buffer") + +(defvar *haskell-show-error* 1 "\ +*If not nil move to the buffer where the error was found") + +(defvar haskell-auto-create-process t "\ +*If not nil, create a Haskell process automatically when required to evaluate or compile Haskell code") + +(defvar *haskell-debug-in-lisp* nil "\ +*If not nil, enter Lisp debugger on error; otherwise, automagically return +to Haskell top-level.") + +(defvar *emacs* nil "\ +When not nil means haskell is in emacs mode") + +(defvar haskell-main-pad "*Main-pad*" "\ +Scratch pad associated with module Main") + +(defvar haskell-main-file "Main") + +(defvar haskell-main-module "Main") + +(defvar *last-loaded* haskell-main-file "\ +Last file loaded with a :load command - Defaults to Main") + +(defvar *last-loaded-modtime* nil "\ +Modification time of last file loaded, used to determine whether it +needs to be reloaded.") + +(defvar *last-module* haskell-main-module "\ +Last module set with a :module command - Defaults to Main") + +(defvar *last-pad* haskell-main-pad "\ +Last pad saved with a :save command - Defaults to Main") + +(defvar *ht-source-file* "$HASKELL/progs/tutorial/tutorial.hs") + +(defvar *ht-temp-buffer* nil) + +(defvar *ht-file-buffer* "Haskell-Tutorial-Master") + +(defvar haskell-mode-map nil "\ +Keymap used for haskell-mode") + +(defun haskell-establish-key-bindings (keymap) (byte-code "ÁÂÃ#ˆÁÄÅ#ˆÁÆÇ#ˆÁÈÉ#ˆÁÊË#ˆÁÌÍ#ˆÁÎÏ#ˆÁÐÑ#ˆÁÒÓ#ˆÁÔÕ#ˆÁÖ×#ˆÁØÙ#ˆÁÚÛ#ˆÁÜÝ#ˆÁÞß#ˆÁàá#ˆÁâã#‡" [keymap define-key "e" haskell-eval "r" haskell-run "m" haskell-run-main "" haskell-run-file "p" haskell-get-pad "" haskell-optimizers "" haskell-printers "c" haskell-compile "l" haskell-load "h" haskell-switch ":" haskell-command "q" haskell-exit "i" haskell-interrupt "u" haskell-edit-unit "d" haskell-please-recover "(" haskell-ensure-lisp-mode ")" haskell-resume-command-loop] 20)) + +(if haskell-mode-map nil (progn (setq haskell-mode-map (make-sparse-keymap)) (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))) + +(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. + +haskell-run-file: \\[haskell-run-file] + Runs a file. Ideally the file has a set of variable of type Dialogue + that get evaluated. + +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-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. + +switch-to-haskell: \\[switch-to-haskell] + Switchs to the inferior Haskell buffer (*haskell*) and positions the + cursor at the end of the 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) (byte-code "ÅˆÆ ˆÇ!ˆÈ‰ˆÉ‰ˆÊÃ!ˆË‰ˆÌ !ˆÍÎ!‡" [haskell-mode-map major-mode mode-name indent-line-function haskell-mode-syntax-table nil kill-all-local-variables use-local-map haskell-mode "Haskell" make-local-variable indent-relative-maybe set-syntax-table run-hooks haskell-mode-hook] 6)) + +(defvar inferior-haskell-mode-map nil) + +(if inferior-haskell-mode-map nil (setq 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 "
" (quote haskell-send-input))) + +(defvar haskell-source-modes (quote (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-prev-l/c-dir/file nil "\ +Caches the (directory . file) pair used in the last invocation of +haskell-run-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 nil "\ +Keeps track of input to haskell process from the minibuffer") + +(defvar tea-prompt-pattern "^>+\\s-*" "\ +Regular expression capturing the T system prompt.") + +(defvar haskell-version "Yale University Haskell Version 0.8, 1991" "\ +Current Haskell system version") + +(defun inferior-haskell-mode-variables nil (byte-code "À‡" [nil] 1)) + +(defun inferior-haskell-mode nil "\ +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-run-file: \\[haskell-run-file] + Runs a file. Ideally the file has a set of variable of type Dialogue + that get evaluated. + +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-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. + +switch-to-haskell: \\[switch-to-haskell] + Switchs to the inferior Haskell buffer (*haskell*) and positions the + cursor at the end of the 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) (byte-code "ËˆÌ ˆ ‰ˆÍ ˆÎ‰ˆÏ‰ˆÐ‰ˆÑ
!ˆÒ‰ˆÓ‰ˆÔ‰ˆÕÖ!ˆ× +!‰ ‡" [comint-prompt-regexp haskell-prompt-pattern major-mode mode-name mode-line-process inferior-haskell-mode-map comint-input-filter comint-input-sentinel comint-get-old-input haskell-prompt-ring input-ring-size nil comint-mode inferior-haskell-mode-variables inferior-haskell-mode "Inferior Haskell" (": %s : busy") use-local-map haskell-input-filter ignore haskell-get-old-input run-hooks inferior-haskell-mode-hook make-ring] 7)) + +(defvar inferior-haskell-mode-hook (quote haskell-fresh-start) "\ +*Hook for customizing inferior-Haskell mode") + +(defun haskell-input-filter (str) "\ +Don't save whitespace." (byte-code "ÁÂ\"?‡" [str string-match "\\s *"] 3)) + +(defvar *haskell-status* (quote dead) "\ +Status of the haskell process") + +(defun set-haskell-status (value) (byte-code " ‰ˆÂ ‡" [*haskell-status* value update-mode-line] 2)) + +(defun get-haskell-status nil (byte-code "‡" [*haskell-status*] 1)) + +(defun update-mode-line nil (byte-code "Šqˆ Ä=ƒ + +(defvar *haskell-saved-output* nil) + +(defun process-haskell-output (process str) "\ +Filter for output from Yale Haskell command interface" (byte-code "ÆÆÇ ÈŽ … + +(defvar *ci-responses* (quote (("r" "" haskell-got-ready) ("i" "" haskell-got-input-request) ("e" "" haskell-got-error) ("p.* +" "\\(p.*\\)?" haskell-got-printers) ("o.* +" "\\(o.*\\)?" haskell-got-optimizers) ("s.* +" "\\(s.*\\)?" haskell-got-message) (" +-> " " +\\(-\\(> ?\\)?\\)?" haskell-got-lisp-error) ("0\\] " "0\\(\\] ?\\)?" haskell-got-lisp-error) ("USER>>" "U\\(S\\(E\\(R\\(>>?\\)?\\)?\\)?\\)?" haskell-got-lisp-error) ("USER(.*):" "U\\(S\\(E\\(R\\((.*)?\\)?\\)?\\)?\\)?" haskell-got-lisp-error) ("USER .* : .* >" "U\\(S\\(E\\(R\\( .*\\( \\(:\\( .*\\( >?\\)?\\)?\\)?\\)?\\)?\\)?\\)?\\)?" haskell-got-lisp-error)))) + +(defun command-match-regexp (x) (byte-code "@‡" [x] 1)) + +(defun command-prefix-regexp (x) (byte-code "A@‡" [x] 1)) + +(defun command-handler (x) (byte-code "AA@‡" [x] 1)) + +(defun glue-together (extractor) (byte-code "ÄÅ +@\"ÆQ +A …$ + +(defvar *ci-response-regexp* (glue-together (quote command-match-regexp))) + +(defvar *ci-prefix-regexp* (concat "\\(" (glue-together (quote command-prefix-regexp)) "\\)\\'")) + +(defun ci-response-start (str idx) (byte-code "à +#‡" [*ci-response-regexp* str idx string-match] 4)) + +(defun ci-prefix-start (str idx) (byte-code "à +#‡" [*ci-prefix-regexp* str idx string-match] 4)) + +(defun ci-response-handler (str idx) (byte-code " Ã… + +?…+ +?…4 +*‡" [list *ci-responses* result nil str idx string-match command-match-regexp command-handler haskell-mode-error "Failed to find command handler!!!"] 6)) + +(defun haskell-got-ready (str idx) (byte-code "ÁÂ!à ˆ)‡" [result match-end 0 haskell-reset] 3)) + +(defun haskell-got-input-request (str idx) (byte-code "ÁÂ!à ˆ)‡" [result match-end 0 get-user-input] 3)) + +(defun haskell-got-error (str idx) (byte-code "ÁÂ!à ˆ)‡" [result match-end 0 haskell-error-handler] 3)) + +(defun haskell-got-printers (str idx) (byte-code "ÃÄ!Å +Æ\\ÇZO!ˆ)‡" [result str idx match-end 0 update-printers-list 2 1] 6)) + +(defun haskell-got-optimizers (str idx) (byte-code "ÃÄ!Å +Æ\\ÇZO!ˆ)‡" [result str idx match-end 0 update-optimizers-list 2 1] 6)) + +(defun haskell-got-message (str idx) (byte-code "ÃÄ!Å +Æ\\ÇZO!ˆ)‡" [result str idx match-end 0 message 2 1] 6)) + +(defun haskell-got-lisp-error (str idx) (byte-code " \"ˆ G‡" [idx str haskell-handle-lisp-error] 3)) + +(defun haskell-handle-lisp-error (location str) (byte-code "Ä ÅO!ˆ +… + +(defun loaded-tutorial-p nil (byte-code "… + +(defun haskell-flush-commands-and-reset nil (byte-code "Á ˆŠÂ!ˆÃ ˆÄ )‡" [*haskell-buffer* haskell-flush-command-queue switch-to-buffer haskell-ensure-lisp-mode haskell-resume-command-loop] 5)) + +(defun haskell-talk-to-lisp nil (byte-code "Á!ˆdbˆÂ ‡" [*haskell-buffer* pop-to-buffer haskell-ensure-lisp-mode] 3)) + +(defun haskell-resume-command-loop nil "\ +Resumes Haskell command processing after debugging in Lisp. \\[haskell-resume-command-loop]" (interactive) (byte-code "Áˆ?… +" haskell-ensure-emacs-mode] 3)) + +(defun haskell-display-output (str) (byte-code "à Ä=ƒ + +(defun haskell-display-output-aux (str) (byte-code "Á ˆcˆÁ ‡" [str haskell-move-marker] 3)) + +(defun get-user-input nil (byte-code "ÁÂ!ˆÃ!ˆdbˆÄÅ!ˆÆ ‡" [*haskell-buffer* message "Haskell is waiting for input..." pop-to-buffer set-haskell-status input haskell-pop-data-queue] 5)) + +(defun haskell-error-handler nil (byte-code "Á ˆÂ ˆÃÄ!ˆÅÀ!‡" [nil ding haskell-flush-command-queue set-haskell-status ready haskell-end-interaction] 5)) + +(defvar *yh-error-def* "Error occured in definition of\\s *") + +(defvar *yh-error-line* "at line\\s *") + +(defvar *yh-error-file* "of file\\s *") + +(defvar *haskell-line* "\\([0-9]\\)*") + +(defun haskell-show-error nil "\ +Point out error to user if possible" (byte-code "qˆŠÂ Š‰… + +(defvar *haskell-function-name* "\\([a-z]\\|[A-Z]\\|[0-9]\\|'\\|_\\|-\\)*") + +(defun get-function-name nil (byte-code "ÅeÁ#…
+`\"‚\" + +(defun get-line-number nil (byte-code "ÅdÁ#ƒ +`\"!‚ + +(defun get-filename nil (byte-code "ÄdÁ#ƒ +`\"‚ + +(defun point-error-to-user (function-name line-number filename) (byte-code "ÄÅ\"ƒ
+!ƒ +!‚ + +(defun haskell-reset nil (byte-code "ÀÁ!ˆÂ ‡" [set-haskell-status ready haskell-pop-command-queue] 3)) + +(defvar *command-interface-queue* nil "\ +Contains the commands to be sent to the Haskell command interface") + +(defun haskell-queue-or-execute (fn request data) (byte-code "ƒ +BC\"‰‚$ +\"‚$ +BC‰‡" [*command-interface-queue* request data fn t nconc get-haskell-status ready funcall] 5)) + +(defun haskell-send-command (str) "\ +Queues STRING for transmission to haskell process." (byte-code "ÁÂÃ#‡" [str haskell-queue-or-execute haskell-send-command-aux command] 4)) + +(defun haskell-send-command-aux (str) (byte-code "ÁÂ\"ˆÁÂÃ\"ˆÄ Å=?… +" get-haskell-status input set-haskell-status busy] 5)) + +(defvar *begin-interaction-delimiter* nil "\ +*Delimiter showing an interaction has begun") + +(defun haskell-begin-interaction (msg) (byte-code "ÁÂÃ#‡" [msg haskell-queue-or-execute haskell-begin-interaction-aux begin] 4)) + +(defun haskell-begin-interaction-aux (msg) (byte-code "… +"] 5)) + +(defvar *end-interaction-delimiter* nil "\ +*Delimiter showing an interaction has ended") + +(defun haskell-end-interaction (msg) (byte-code "ÁÂÃ#‡" [msg haskell-queue-or-execute haskell-end-interaction-aux end] 4)) + +(defun haskell-end-interaction-aux (msg) (byte-code "… + +(defun haskell-send-data (str) (byte-code "ÄÅ\"ƒ + +(defun merge-data-into-queue (new head tail lasttail) (byte-code "?ƒ +\"ˆ ‚8 + A$‚8 +\"ˆÅ +\"ˆ ‚8 +\"ˆ +‡" [tail lasttail new head t rplacd data merge-data-into-queue] 7)) + +(defun haskell-pop-command-queue nil (byte-code "…N + +(defun haskell-pop-data-queue nil (byte-code "… + +(defun haskell-flush-command-queue nil (byte-code "Á‰‡" [*command-interface-queue* nil] 2)) + +(defun haskell nil "\ +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) (byte-code "ÃˆÄ !…
+ÃÃ%‰ˆŠqˆÉ )ˆÊ!)‡" [haskell-buffer *haskell-buffer* haskell-program-name nil get-buffer comint-check-proc apply make-comint "haskell" inferior-haskell-mode display-buffer] 8)) + +(defun haskell-fresh-start nil (byte-code "ÈÉ!ˆÁ‰ˆ ‰ˆ
‰ˆÁ‰ˆÁ‰ˆÊ ‡" [*command-interface-queue* nil *last-loaded* haskell-main-file *last-pad* haskell-main-pad *emacs* *haskell-saved-output* set-haskell-status busy haskell-ensure-emacs-mode] 3)) + +(defun haskell-maybe-create-process nil (byte-code "… + +(defun haskell-ensure-emacs-mode nil (byte-code " ˆÁ‰ˆÃ ‡" [*emacs* t create-main-pad ci-emacs] 3)) + +(defun haskell-ensure-lisp-mode nil "\ +Switch to talking to Lisp. \\[haskell-ensure-lisp-mode]" (interactive) (byte-code "ÁˆÁ‰‡" [*emacs* nil] 2)) + +(defun haskell-get-pad nil "\ +Creates a new scratch pad for the current module. +Signals an error if the current buffer is not a .hs file." (interactive) (byte-code "ÁˆÂ ƒ + +(defun do-get-pad (fname buff) (byte-code "Æ !† + + +(defun haskell-switch nil "\ +Switches to *haskell* buffer" (interactive) (byte-code "ÁˆÂ ˆÃÀ!‡" [t nil haskell-maybe-create-process switch-to-haskell] 3)) + +(defun switch-to-haskell (eob-p) "\ +Really switch to the *haskell* buffer. +With argument, positions cursor at end of buffer." (interactive "P") (byte-code "ˆÃ!ˆ … + +(defun haskell-command (str) "\ +Format STRING as a haskell command and send it to haskell process. \\[haskell-command]" (interactive "sHaskell command: ") (byte-code "ÁˆÂÃÄH!=ƒ + +(defun haskell-eval nil "\ +Evaluate expression in current module. \\[haskell-eval]" (interactive) (byte-code "ÀˆÁ ˆÂÃÄ!ÀÅ#‡" [nil haskell-maybe-create-process haskell-eval-aux get-haskell-expression "Haskell expression: " "Evaluating"] 6)) + +(defun haskell-run nil "\ +Run Haskell Dialogue in current module" (interactive) (byte-code "ÁˆÂ ˆÃÄÅ!ÀÆ#‡" [t nil haskell-maybe-create-process haskell-eval-aux get-haskell-expression "Haskell dialogue: " "Running"] 6)) + +(defun haskell-run-main nil "\ +Run Dialogue named main in current module" (interactive) (byte-code "ÁˆÂ ˆÃÄÀÅ#‡" [t nil haskell-maybe-create-process haskell-eval-aux "main" "Running"] 5)) + +(defun haskell-eval-aux (exp dialogue-p what) (byte-code "ÍÎ \"ƒ( + ÏÐ # Ñ
+&,‚¦ +&,‚¦ +&,‚¦ +&,‡" [*haskell-buffer* pname *last-pad* mname *last-module* fname *last-loaded* msg what exp dialogue-p *ht-temp-buffer* t equal buffer-name format "%s: %s" haskell-eval-aux-aux buffer-file-name get-modname lookup-pad "%s (in tutorial): %s" "%s (in file %s): %s" file-name-nondirectory get-module-from-pad get-file-from-pad "%s (in pad %s): %s"] 29)) + +(defun haskell-eval-aux-aux (exp pname mname fname msg dialogue-p) (byte-code "Æ!ˆÇ ˆÈ !ˆÉ +!ˆ … + +(defun haskell-save-pad-if-modified (pad) (byte-code "ŠqˆÃ \"†
+ +(defun haskell-run-file nil "\ +Run all Dialogues in current file" (interactive) (byte-code "ˆà ˆÄÅ \"ƒ + +(defun haskell-run-file/process (filename) (interactive (byte-code "ÃÄ Â$‡" [haskell-prev-l/c-dir/file haskell-source-modes t comint-get-source "Haskell file to run: "] 5)) (byte-code "ĈŠ!ˆÆ !Ç !B‰ˆÈ !‡" [haskell-prev-l/c-dir/file haskell-source-modes t filename nil comint-check-source file-name-directory file-name-nondirectory haskell-run-file-aux] 5)) + +(defun haskell-run-file-aux (fname) (byte-code "à PÄ!ˆÅ ˆÆ +!ˆÇÈ !!ˆÉÊP!)‡" [msg fname buffer-file-name "Running file: " haskell-begin-interaction ci-kill save-modified-source-files ci-run strip-fext haskell-end-interaction " ...done."] 8)) + +(defun haskell-load nil "\ +Load current file" (interactive) (byte-code "ÃˆÄ ˆÅ ÆPƒ + +(defun haskell-load-file-if-modified (filename) (byte-code "Å!ˆÆ +\"ƒ +‰ˆÇ ‚ + +(defun haskell-compile nil "\ +Compile current file" (interactive) (byte-code "ˆà ˆÄ ƒ + +(defun haskell-compile-file-if-modified (fname) (byte-code "Â!ˆÃÄ !!‡" [buffer-file-name fname save-modified-source-files ci-compile strip-fext] 4)) + +(defun haskell-exit nil "\ +Quit the haskell process" (interactive) (byte-code "ÁˆÃ ˆ… +!ˆÇ +!‡" [*ht-temp-buffer* nil *haskell-buffer* ci-quit get-buffer set-buffer-modified-p bury-buffer replace-buffer-in-windows] 6)) + +(defun haskell-interrupt nil "\ +Interrupt the haskell process" (interactive) (byte-code "ÀˆÁÂ!ˆÃÄ!‡" [nil haskell-send-command-aux "" haskell-end-interaction "done."] 3)) + +(defun haskell-edit-unit nil "\ +Edit the .hu file." (interactive) (byte-code "ÈŠƒ1 +…- + +(defun haskell-new-unit nil (byte-code "Á‰‡" [file-not-found t] 2)) + +(defun units-add-source-file (file) (byte-code "ŠÁÂ!Ã\")‡" [file insert strip-fext " +"] 4)) + +(defun haskell-get-unit-file nil (byte-code "ÁŠÄ ˆÅÆdÂ#ƒ + +(defun haskell-please-recover nil (interactive) (byte-code "ÀˆÁ ˆÂÃ!‡" [nil haskell-flush-commands-and-reset haskell-end-interaction "done."] 3)) + +(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" (quote haskell-menu-mark)) (define-key haskell-menu-mode-map "u" (quote haskell-menu-unmark)) (define-key haskell-menu-mode-map "x" (quote haskell-menu-exit)) (define-key haskell-menu-mode-map "q" (quote haskell-menu-exit)) (define-key haskell-menu-mode-map " " (quote next-line)) (define-key haskell-menu-mode-map "" (quote haskell-menu-backup-unmark)) (define-key haskell-menu-mode-map "?" (quote describe-mode)))) + +(put (quote haskell-menu-mode) (quote mode-class) (quote special)) + +(defun haskell-menu-mode nil "\ +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}" (byte-code "Æ ˆÇ!ˆÂ‰ˆÂ‰ˆÈ‰ˆÉ‰ˆÊË!ˆÊÌ!ˆÊÍ!ˆÎÏ!‡" [haskell-menu-mode-map truncate-lines t buffer-read-only major-mode mode-name kill-all-local-variables use-local-map haskell-menu-mode "Haskell Flags Menu" make-local-variable haskell-menu-current-flags haskell-menu-request-fn haskell-menu-update-fn run-hooks haskell-menu-mode-hook] 7)) + +(defun haskell-menu (help-file buffer request-fn update-fn) (byte-code "Æ ˆÇ!ƒ + +(defvar *haskell-menu-marked* " on") + +(defvar *haskell-menu-unmarked* " ") + +(defvar *haskell-menu-marked-regexp* " on \\w") + +(defvar *haskell-menu-unmarked-regexp* " \\w") + +(defun haskell-menu-mark nil "\ +Mark flag to be turned on." (interactive) (byte-code "ÃˆÇ ˆÈ!ƒ + +(defun haskell-menu-unmark nil "\ +Unmark flag." (interactive) (byte-code "ÃˆÇ ˆÈ!ƒ + +(defun haskell-menu-backup-unmark nil "\ +Move up and unmark." (interactive) (byte-code "ÀˆÁÂ!ˆÃ ˆÁÂ!‡" [nil forward-line -1 haskell-menu-unmark] 4)) + +(defun haskell-menu-exit nil "\ +Update flags, then leave menu." (interactive) (byte-code "ÀˆÁ ˆÂ ‡" [nil haskell-menu-execute haskell-menu-quit] 3)) + +(defun haskell-menu-execute nil "\ +Tell haskell process to tweak flags." (interactive) (byte-code "ˆŠˆŠebˆ`d=?…7 + +(defun haskell-menu-quit nil (interactive) (byte-code "ÀˆÁˆÂp!ˆÃp!‡" [nil "Make the menu go away." bury-buffer replace-buffer-in-windows] 3)) + +(defun haskell-menu-flag nil (byte-code "ŠÁ ˆÂÃ!ˆ`ÄÅ!ˆÆÇÈ!\"))‡" [beg beginning-of-line forward-char 6 re-search-forward " \\| " buffer-substring match-beginning 0] 7)) + +(defun start-setting-flags nil (byte-code "À‡" [nil] 1)) + +(defun finish-setting-flags nil (byte-code "ÀÁ!‡" [haskell-end-interaction "Setting flags....done."] 2)) + +(defun haskell-menu-mark-current nil (byte-code "Ä!ˆŠebˆ`d=?…; +!…, + +(defun menu-item-currently-on-p (item) (byte-code " \"‡" [item haskell-menu-current-flags member-string=] 3)) + +(defun member-string= (item list) (byte-code "?ƒ +@\"ƒ +A\"‡" [list nil item t string= member-string=] 4)) + +(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 nil "\ +Set printers interactively." (interactive) (byte-code "ˆà ÄÅ$‡" [*haskell-printers-help* *haskell-printers-buffer* nil haskell-menu get-current-printers set-current-printers] 5)) + +(defun get-current-printers nil (byte-code "Á‰ˆÂÃ!ˆÁ=… + +(defun update-printers-list (data) (byte-code " !‰‡" [haskell-menu-current-flags data read] 3)) + +(defun set-current-printers (flag on) (byte-code "Å ! +… + +?… + +(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 nil "\ +Set optimizers interactively." (interactive) (byte-code "ˆà ÄÅ$‡" [*haskell-optimizers-help* *haskell-optimizers-buffer* nil haskell-menu get-current-optimizers set-current-optimizers] 5)) + +(defun get-current-optimizers nil (byte-code "Á‰ˆÂÃ!ˆÁ=… + +(defun update-optimizers-list (data) (byte-code " !‰‡" [haskell-menu-current-flags data read] 3)) + +(defun set-current-optimizers (flag on) (byte-code "Å ! +… + +?… + +(defvar *pad-mappings* nil "\ +Associates pads with their corresponding module and file.") + +(defun record-pad-mapping (pname mname fname) (byte-code " + EB‰‡" [*pad-mappings* pname mname fname] 3)) + +(defun get-module-from-pad (pname) (byte-code " \"A@‡" [pname *pad-mappings* assoc] 3)) + +(defun get-file-from-pad (pname) (byte-code " \"AA@‡" [pname *pad-mappings* assoc] 3)) + +(defun lookup-pad (mname fname) (byte-code "à +#‡" [mname fname *pad-mappings* lookup-pad-aux] 4)) + +(defun lookup-pad-aux (mname fname list) (byte-code "?ƒ +@A@\"… + A#‡" [list nil mname fname t equal lookup-pad-aux] 6)) + +(defvar *ask-before-saving* t) + +(defun save-modified-source-files (filename) (byte-code "È Â…O + +(defun source-file-p (filename) (byte-code "ÁÂ\"†' + +(defun haskell-move-marker nil "\ +Moves the marker and point to the end of buffer" (byte-code "Ád\"ˆÁÂÃÄ!!d\"ˆdb‡" [comint-last-input-end set-marker process-mark get-process "haskell"] 6)) + +(defun create-main-pad nil (byte-code "Ä !ŠqˆÅ )ˆÆ + #ˆ)‡" [buffer haskell-main-pad haskell-main-module haskell-main-file get-buffer-create haskell-mode record-pad-mapping] 6)) + +(defvar *re-module* "^module\\s *\\|^>\\s *module\\s *") + +(defvar *re-modname* "[A-Z]\\([a-z]\\|[A-Z]\\|[0-9]\\|'\\|_\\)*") + +(defun get-modname (buff) "\ +Get module name in BUFFER that point is in." (byte-code "ŠqˆÄ !† + +(defun get-padname (m) "\ +Build padname from module name" (byte-code "ÁÂQ‡" [m "*" "-pad*"] 3)) + +(defvar *haskell-filename-regexp* "\\(.*\\)\\.\\(hs\\|lhs\\)$") + +(defun strip-fext (filename) "\ +Strip off the extension from a filename." (byte-code " \"ƒ + +(defun haskell-mode-error (msg) "\ +Show MSG in message line as an error from the haskell mode" (byte-code "ÁÂP!‡" [msg error "Haskell mode: "] 3)) + +(defun ci-send-buffer (buff) "\ +Send BUFFER to haskell process." (byte-code " ÃÄ\"?… + +(defun ci-kill nil (byte-code "ÀÁ!‡" [haskell-send-command ":kill"] 2)) + +(defun ci-clear nil (byte-code "ÀÁ!‡" [haskell-send-command ":clear"] 2)) + +(defun ci-set-file (file-name) (byte-code "ÁÂP!‡" [file-name haskell-send-command ":file "] 3)) + +(defun ci-module (modname) (byte-code " ‰ˆÂà P!‡" [*last-module* modname haskell-send-command ":module "] 3)) + +(defun ci-load (filename) (byte-code "ÁÂP!‡" [filename haskell-send-command ":load "] 3)) + +(defun ci-load-main nil (byte-code "ÀÁ!‡" [haskell-send-command ":Main"] 2)) + +(defun ci-save nil (byte-code "ÀÁ!‡" [haskell-send-command ":save"] 2)) + +(defun ci-compile (filename) (byte-code "ÁÂP!‡" [filename haskell-send-command ":compile "] 3)) + +(defun ci-run (filename) (byte-code "ÁÂP!‡" [filename haskell-send-command ":run "] 3)) + +(defun ci-print-exp (exp) (byte-code "ÁÂ!ˆÃÄP!‡" [exp ci-set-file "interactive-expression-buffer" haskell-send-command "= "] 4)) + +(defun ci-send-name (name) (byte-code "ÂÃ!ÄÅ!ˆÆÇ Q!)‡" [temp name make-temp-name "etemp" ci-set-file "interactive-expression-buffer" haskell-send-command " = "] 6)) + +(defun ci-eval nil (byte-code "ÀÁ!‡" [haskell-send-command ":eval"] 2)) + +(defun ci-quit nil (byte-code "Ã!?ƒ
+" set-haskell-status dead] 6)) + +(defun ci-emacs nil (byte-code "À ˆÁÂÃ!Ä\"ˆÅÆ!‡" [haskell-reset set-process-filter get-process "haskell" process-haskell-output haskell-send-command ":Emacs on"] 5)) + +(defun haskell-get-old-input nil "\ +Get old input text from Haskell process buffer." (byte-code "ŠÃdÄ#…
+`\"))‡" [haskell-prompt-pattern t temp re-search-forward move match-beginning 0 re-search-backward comint-skip-prompt end-of-line buffer-substring] 8)) + +(defun haskell-send-input nil "\ +Send input to Haskell while in the process buffer" (interactive) (byte-code "Áˆƒ + +(defun haskell-send-input-aux nil (byte-code "Êp!?ƒ +Yƒ$ + +(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)) (define-key haskell-minibuffer-local-map "p" (quote haskell-previous-input)) (define-key haskell-minibuffer-local-map "n" (quote haskell-next-input)))) + +(defun haskell-previous-input (arg) "\ +Cycle backwards through input history." (interactive "*p") (byte-code "ÇˆÈ !ÉXƒ + +(defun haskell-next-input (arg) "\ +Cycle forwards through input history." (interactive "*p") (byte-code "ÁˆÂ[!‡" [arg nil haskell-previous-input] 2)) + +(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 (byte-code "ÂÃÄ \"!ÅÆ\"ƒ +‰ˆÈ +!É !Ê
X… +Ì
\"\"?…* + +(defun get-haskell-expression (prompt) (byte-code "Å Â #Æ \"ˆ)‡" [exp prompt nil haskell-minibuffer-local-map haskell-prompt-ring read-from-minibuffer ring-insert] 4)) + +(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 (quote haskell-load-hook)) + +(defvar ht-mode-map nil) + +(if ht-mode-map nil (progn (setq ht-mode-map (make-sparse-keymap)) (haskell-establish-key-bindings ht-mode-map) (define-key ht-mode-map "" (quote ht-next-page)) (define-key ht-mode-map "" (quote ht-prev-page)) (define-key ht-mode-map " " (quote ht-restore-page)) (define-key ht-mode-map "?" (quote describe-mode)))) + +(defun haskell-tutorial-mode nil "\ +Major mode for running the Haskell tutorial. +You can use these commands: +\\{ht-mode-map}" (interactive) (byte-code "ĈŠˆÆ!ˆÇ‰ˆÈ‰ˆÉ !ˆÊË!‡" [ht-mode-map major-mode mode-name haskell-mode-syntax-table nil kill-all-local-variables use-local-map haskell-tutorial-mode "Haskell Tutorial" set-syntax-table run-hooks haskell-mode-hook] 5)) + +(defun haskell-tutorial nil "\ +Run the haskell tutorial." (interactive) (byte-code "ÀˆÁ ˆÂ ˆÃ ‡" [nil ht-load-tutorial ht-make-buffer ht-display-page] 4)) + +(defun ht-load-tutorial nil (byte-code "Ä !ƒ +!ƒ* +!‚- + +(defun ht-load-tutorial-aux (filename) (interactive "fTutorial file: ") (byte-code "ÁˆÄ!ˆÅÁ!ˆÃ‰ˆÆ ‡" [filename nil buffer-read-only t insert-file set-buffer-modified-p beginning-of-buffer] 4)) + +(defun ht-make-buffer nil (byte-code "ÁÂÃÄ!ÅQ!ˆÆ ‰ˆÇ ‡" [*ht-temp-buffer* find-file "/tmp/" make-temp-name "ht" ".hs" buffer-name haskell-tutorial-mode] 5)) + +(defun ht-next-page nil "\ +Go to the next tutorial page." (interactive) (byte-code "ÀˆÁ ƒ + +(defun ht-goto-next-page nil (byte-code "pÄŽ qˆÅÆÂÃ#))‡" [buff *ht-file-buffer* nil t ((byte-code "q‡" [buff] 1)) search-forward " "] 4)) + +(defun ht-prev-page nil "\ +Go to the previous tutorial page." (interactive) (byte-code "ÀˆÁ ƒ + +(defun ht-goto-prev-page nil (byte-code "pÄŽ qˆÅÆÂÃ#))‡" [buff *ht-file-buffer* nil t ((byte-code "q‡" [buff] 1)) search-backward " "] 4)) + +(defun ht-goto-page (arg) "\ +Go to the tutorial page specified as the argument." (interactive "sGo to page: ") (byte-code "ÁˆÂÃÄ\"!ƒ + +(defun ht-goto-section (arg) "\ +Go to the tutorial section specified as the argument." (interactive "sGo to section: ") (byte-code "ÁˆÂÃÄ\"!ƒ + +(defun ht-searchfor-page (search-string) (byte-code "pÆŽ qˆ`Ç ˆÈ ÄÅ#ƒ +bˆÄ)))‡" [buff *ht-file-buffer* point search-string nil t ((byte-code "q‡" [buff] 1)) beginning-of-buffer search-forward] 5)) + +(defun ht-restore-page nil (interactive) (byte-code "Áˆ` ˆb)‡" [old-point nil ht-display-page] 2)) + +(defun ht-display-page nil (byte-code "qˆÇÈÂÃ#ƒ diff --git a/emacs-tools/optimizer-help.txt b/emacs-tools/optimizer-help.txt new file mode 100644 index 0000000..3ed2ae2 --- /dev/null +++ b/emacs-tools/optimizer-help.txt @@ -0,0 +1,5 @@ +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 diff --git a/emacs-tools/printer-help.txt b/emacs-tools/printer-help.txt new file mode 100644 index 0000000..a525ad1 --- /dev/null +++ b/emacs-tools/printer-help.txt @@ -0,0 +1,24 @@ +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 + extension Enables printing withinn extensions +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 |