From 280406ea013082414f6e41edace5ecdcd8e9da7a Mon Sep 17 00:00:00 2001 From: David Aspinall Date: Fri, 4 Sep 2009 08:30:17 +0000 Subject: Trimmed down comint --- lib/scomint.el | 352 +++++++++++++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 352 insertions(+) create mode 100644 lib/scomint.el (limited to 'lib/scomint.el') diff --git a/lib/scomint.el b/lib/scomint.el new file mode 100644 index 00000000..c6a6e758 --- /dev/null +++ b/lib/scomint.el @@ -0,0 +1,352 @@ +;;; scomint.el --- Simplified comint for less interactive shells +;; +;; Copyright (C) 2009 LFCS Edinburgh. +;; Author: David Aspinall +;; License: GPL (GNU GENERAL PUBLIC LICENSE) +;; +;; $Id$ + +;;; Commentary: +;; +;; This is a heavily simplified comint for Proof General. +;; Much of the code is taken from comint.el. +;; +;; The reason to provide this is to remove some of +;; the interactive features which are otherwise +;; hard to disentangle. +;; + +(defface scomint-highlight-input '((t (:weight bold))) + "Face to use to highlight user input." + :group 'scomint) + +(defface scomint-highlight-prompt + '((((min-colors 88) (background dark)) (:foreground "cyan1")) + (((background dark)) (:foreground "cyan")) + (t (:foreground "dark blue"))) + "Face to use to highlight prompts." + :group 'scomint) + +(defvar scomint-buffer-maximum-size 800000 + "The maximum size in characters for SComint buffers. +SComint buffers are truncated from the top to be no greater than this number, +if non-nil.") + + +(defvar scomint-last-input-start nil) +(defvar scomint-last-input-end nil) +(defvar scomint-last-output-start nil) + +(defvar scomint-exec-hook nil + "Hook run each time a process is exec'd by `scomint-exec'. +This is called after the process is cranked up. It is useful for things that +must be done each time a process is executed in a Comint mode buffer (e.g., +`(process-kill-without-query)').") + +(put 'scomint-mode 'mode-class 'special) + + +(define-derived-mode scomint-mode fundamental-mode "SComint" + "Major mode for interacting with a background 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. + +\\{comint-mode-map} + +Entry to this mode runs the hooks on `scomint-mode-hook'." + (setq mode-line-process '(":%s")) + (set (make-local-variable 'window-point-insertion-type) t) + (make-local-variable 'font-lock-defaults) + (setq font-lock-defaults '(nil t)) + (add-hook 'change-major-mode-hook 'font-lock-defontify nil t) + (set (make-local-variable 'next-line-add-newlines) nil)) + +(defun scomint-check-proc (buffer) + "Return non-nil if there is a living process associated w/buffer BUFFER. +Living means the status is `open', `run', or `stop'. +BUFFER can be either a buffer or the name of one." + (let ((proc (get-buffer-process buffer))) + (and proc (memq (process-status proc) '(open run stop))))) + +;;;###autoload +(defun scomint-make-in-buffer (name buffer program &optional startfile &rest switches) + "Make a Comint process NAME in BUFFER, running PROGRAM. +If BUFFER is nil, it defaults to NAME surrounded by `*'s. +PROGRAM should be either a string denoting an executable program to create +via `start-file-process', or a cons pair of the form (HOST . SERVICE) denoting +a TCP connection to be opened via `open-network-stream'. If there is already +a running process in that buffer, it is not restarted. Optional fourth arg +STARTFILE is the name of a file to send the contents of to the process. + +If PROGRAM is a string, any more args are arguments to PROGRAM." + (or (fboundp 'start-file-process) + (error "Multi-processing is not supported for this system")) + (setq buffer (get-buffer-create (or buffer (concat "*" name "*")))) + ;; If no process, or nuked process, crank up a new one and put buffer in + ;; comint mode. Otherwise, leave buffer and existing process alone. + (unless (scomint-check-proc buffer) + (with-current-buffer buffer + (unless (derived-mode-p 'scomint-mode) + (scomint-mode))) ; Install local vars, mode, keymap, ... + (scomint-exec buffer name program startfile switches)) + buffer) + +;;;###autoload +(defun scomint-make (name program &optional startfile &rest switches) + "Make a Comint process NAME in a buffer, running PROGRAM. +The name of the buffer is made by surrounding NAME with `*'s. +PROGRAM should be either a string denoting an executable program to create +via `start-file-process', or a cons pair of the form (HOST . SERVICE) denoting +a TCP connection to be opened via `open-network-stream'. If there is already +a running process in that buffer, it is not restarted. Optional third arg +STARTFILE is the name of a file to send the contents of the process to. + +If PROGRAM is a string, any more args are arguments to PROGRAM." + (apply #'scomint-make-in-buffer name nil program startfile switches)) + + +(defun scomint-exec (buffer name command startfile switches) + "Start up a process named NAME in buffer BUFFER for Comint modes. +Runs the given COMMAND with SWITCHES with output to STARTFILE. +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. The hook `scomint-exec-hook' is run after each exec." + (with-current-buffer buffer + (let ((proc (get-buffer-process buffer))) ; Blast any old process. + (if proc (delete-process proc))) + ;; Crank up a new process + (let ((proc + (if (consp command) + (open-network-stream name buffer (car command) (cdr command)) + (scomint-exec-1 name buffer command switches)))) + (set-process-filter proc 'scomint-output-filter) + ;; 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)) + (scomint-send-string proc startfile))) + (run-hooks 'scomint-exec-hook) + buffer))) + +;; This auxiliary function cranks up the process for comint-exec in +;; the appropriate environment. + +(defun scomint-exec-1 (name buffer command switches) + (let ((process-environment + (nconc + ;; If using termcap, we specify `emacs' as the terminal type + ;; because that lets us specify a width. + ;; If using terminfo, we specify `dumb' because that is + ;; a defined terminal type. `emacs' is not a defined terminal type + ;; and there is no way for us to define it here. + ;; Some programs that use terminfo get very confused + ;; if TERM is not a valid terminal type. + ;; ;; There is similar code in compile.el. + (if (and (boundp 'system-uses-terminfo) system-uses-terminfo) + (list "TERM=dumb" "TERMCAP=" + (format "COLUMNS=%d" (window-width))) + (list "TERM=emacs" + (format "TERMCAP=emacs:co#%d:tc=unknown:" (window-width)))) + (unless (getenv "EMACS") + (list "EMACS=t")) + (list (format "INSIDE_EMACS=%s,comint" emacs-version)) + process-environment)) + (default-directory + (if (file-accessible-directory-p default-directory) + default-directory + "/")) + proc decoding encoding changed) + (let ((exec-path (if (file-name-directory command) + ;; If the command has slashes, make sure we + ;; first look relative to the current directory. + (cons default-directory exec-path) exec-path))) + (setq proc (apply 'start-file-process name buffer command switches))) + ;; Some file name handler cannot start a process, fe ange-ftp. + (unless (processp proc) (error "No process started")) + (let ((coding-systems (process-coding-system proc))) + (setq decoding (car coding-systems) + encoding (cdr coding-systems))) + ;; Even if start-file-process left the coding system for encoding data + ;; sent from the process undecided, we had better use the same one + ;; as what we use for decoding. But, we should suppress EOL + ;; conversion. + (if (and decoding (not encoding)) + (setq encoding (coding-system-change-eol-conversion decoding 'unix) + changed t)) + (if changed + (set-process-coding-system proc decoding encoding)) + proc)) + + + + +(defalias 'scomint-send-string 'process-send-string) + +(defun scomint-send-eof () + "Send an EOF to the current buffer's process." + (interactive) + (scomint-send-input t t) + (process-send-eof)) + +(defun scomint-send-input (&optional no-newline artificial) + "Send input to process. +After the process output mark, sends all text from the process mark to +point as input to the process. + +This command also sends and inserts a final newline, unless +NO-NEWLINE is non-nil." + (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") + (widen) + (let* ((pmark (process-mark proc)) + (input (if (>= (point) (marker-position pmark)) + (buffer-substring pmark (point))))) + + (unless no-newline + (insert ?\n)) + + (let ((beg (marker-position pmark)) + (end (if no-newline (point) (1- (point)))) + (inhibit-modification-hooks t)) + (when (> end beg) + (add-text-properties beg end + '(front-sticky t + font-lock-face scomint-highlight-input)) + + (unless (no-newline) + ;; Cover the terminating newline + (add-text-properties end (1+ end) + '(rear-nonsticky t + field boundary + inhibit-line-move-field-capture t)))) + + ;; Update the markers before we send the input + ;; in case we get output amidst sending the input. + (set-marker scomint-last-input-start pmark) + (set-marker scomint-last-input-end (point)) + (set-marker (process-mark proc) (point)) + (scomint-send-string + proc + (concat input (unless no-newline "\n")))))))) + + +(defun scomint-truncate-buffer (&optional string) + "Truncate the buffer to `scomint-buffer-maximum-size'." + (interactive) + (if comint-buffer-maximum-size + (save-excursion + (save-restriction + (widen) + (if (> (point-max) comint-buffer-maximum-size) + (let ((inhibit-read-only t)) + (delete-region (point-min) + (- (point-max) comint-buffer-maximum-size)))))))) + +(defun scomint-strip-ctrl-m (&optional string) + "Strip trailing `^M' characters from the current output group." + (interactive) + (let ((pmark (process-mark (get-buffer-process (current-buffer))))) + (save-excursion + (condition-case nil + (goto-char + (if (interactive-p) scomint-last-input-end scomint-last-output-start)) + (error nil)) + (while (re-search-forward "\r+$" pmark t) + (replace-match "" t t))))) + +;; The purpose of using this filter for comint processes +;; is to keep comint-last-input-end from moving forward +;; when output is inserted. +(defun scomint-output-filter (process string) + (let ((oprocbuf (process-buffer process))) + ;; First check for killed buffer or no input. + (when (and string oprocbuf (buffer-name oprocbuf)) + (with-current-buffer oprocbuf + ;; Insert STRING + (let ((inhibit-read-only t) + ;; The point should float after any insertion we do. + (saved-point (copy-marker (point) t))) + + ;; We temporarly remove any buffer narrowing, in case the + ;; process mark is outside of the restriction + (save-restriction + (widen) + + (goto-char (process-mark process)) + (set-marker scomint-last-output-start (point)) + + ;; insert-before-markers is a bad thing. XXX + ;; Luckily we don't have to use it any more, we use + ;; window-point-insertion-type instead. + (insert string) + + ;; Advance process-mark + (set-marker (process-mark process) (point)) + + ;; Run these hooks with point where the user had it. + (goto-char saved-point) + (run-hook-with-args 'comint-output-filter-functions string) + (scomint-truncate-buffer) + + (set-marker saved-point (point)) + + (goto-char (process-mark process)) ; in case a filter moved it + + (unless comint-use-prompt-regexp + (let ((inhibit-read-only t) + (inhibit-modification-hooks t)) + (add-text-properties comint-last-output-start (point) + '(front-sticky + (field inhibit-line-move-field-capture) + rear-nonsticky t + field output + inhibit-line-move-field-capture t)))) + + ;; Highlight the prompt, where we define `prompt' to mean + ;; the most recent output that doesn't end with a newline. + (let ((prompt-start (save-excursion (forward-line 0) (point))) + (inhibit-read-only t) + (inhibit-modification-hooks t)) + (when comint-prompt-read-only + (or (= (point-min) prompt-start) + (get-text-property (1- prompt-start) 'read-only) + (put-text-property + (1- prompt-start) prompt-start 'read-only 'fence)) + (add-text-properties + prompt-start (point) + '(read-only t rear-nonsticky t front-sticky (read-only)))) + (unless (and (bolp) (null comint-last-prompt-overlay)) + ;; Need to create or move the prompt overlay (in the case + ;; where there is no prompt ((bolp) == t), we still do + ;; this if there's already an existing overlay). + (if comint-last-prompt-overlay + ;; Just move an existing overlay + (move-overlay comint-last-prompt-overlay + prompt-start (point)) + ;; Need to create the overlay + (setq comint-last-prompt-overlay + (make-overlay prompt-start (point))) + (overlay-put comint-last-prompt-overlay + 'font-lock-face 'scomint-highlight-prompt)))) + + (goto-char saved-point))))))) + + + +(provide 'scomint) + +;;; scomint.el ends here -- cgit v1.2.3