-;; term.el --- general command interpreter in a window stuff
+;;; term.el --- general command interpreter in a window stuff
+
;; Copyright (C) 1988, 1990, 1992, 1994, 1995 Free Software Foundation, Inc.
;; Author: Per Bothner <bothner@cygnus.com>
;; GNU General Public License for more details.
;; You should have received a copy of the GNU General Public License
-;; along with GNU Emacs; see the file COPYING. If not, write to
-;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
+;; along with GNU Emacs; see the file COPYING. If not, write to the
+;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
+;; Boston, MA 02111-1307, USA.
;;; Commentary:
-;;; The changelog is at the end of this file.
+;; 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.
-;;; - Per Bothner (bothner@cygnus.com)
+;; Please send me bug reports, bug fixes, and extensions, so that I can
+;; merge them into the master source.
+;; - Per Bothner (bothner@cygnus.com)
-;;; This file defines a general command-interpreter-in-a-buffer package
-;;; (term mode). The idea is that you can build specific process-in-a-buffer
-;;; modes on top of term 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.).
+;; This file defines a general command-interpreter-in-a-buffer package
+;; (term mode). The idea is that you can build specific process-in-a-buffer
+;; modes on top of term 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.).
-;;; For hints on converting existing process modes (e.g., tex-mode,
-;;; background, dbx, gdb, kermit, prolog, telnet) to use term-mode
-;;; instead of shell-mode, see the notes at the end of this file.
+;; For hints on converting existing process modes (e.g., tex-mode,
+;; background, dbx, gdb, kermit, prolog, telnet) to use term-mode
+;; instead of shell-mode, see the notes at the end of this file.
\f
-;;; Brief Command Documentation:
-;;;============================================================================
-;;; Term Mode Commands: (common to all derived modes, like cmushell & cmulisp
-;;; mode)
-;;;
-;;; m-p term-previous-input Cycle backwards in input history
-;;; m-n term-next-input Cycle forwards
-;;; m-r term-previous-matching-input Previous input matching a regexp
-;;; m-s comint-next-matching-input Next input that matches
-;;; return term-send-input
-;;; c-c c-a term-bol Beginning of line; skip prompt.
-;;; c-d term-delchar-or-maybe-eof Delete char unless at end of buff.
-;;; c-c c-u term-kill-input ^u
-;;; c-c c-w backward-kill-word ^w
-;;; c-c c-c term-interrupt-subjob ^c
-;;; c-c c-z term-stop-subjob ^z
-;;; c-c c-\ term-quit-subjob ^\
-;;; c-c c-o term-kill-output Delete last batch of process output
-;;; c-c c-r term-show-output Show last batch of process output
-;;; c-c c-h term-dynamic-list-input-ring List input history
-;;;
-;;; Not bound by default in term-mode
-;;; term-send-invisible Read a line w/o echo, and send to proc
-;;; (These are bound in shell-mode)
-;;; term-dynamic-complete Complete filename at point.
-;;; term-dynamic-list-completions List completions in help buffer.
-;;; term-replace-by-expanded-filename Expand and complete filename at point;
-;;; replace with expanded/completed name.
-;;; term-kill-subjob No mercy.
-;;; term-show-maximum-output Show as much output as possible.
-;;; term-continue-subjob Send CONT signal to buffer's process
-;;; group. Useful if you accidentally
-;;; suspend your process (with C-c C-z).
-
-;;; term-mode-hook is the term mode hook. Basically for your keybindings.
-;;; term-load-hook is run after loading in this package.
-
-;;; Code:
-
-;;; This is passed to the inferior in the EMACS environment variable,
-;;; so it is important to increase it if there are protocol-relevant changes.
+;; Brief Command Documentation:
+;;============================================================================
+;; Term Mode Commands: (common to all derived modes, like cmushell & cmulisp
+;; mode)
+;;
+;; m-p term-previous-input Cycle backwards in input history
+;; m-n term-next-input Cycle forwards
+;; m-r term-previous-matching-input Previous input matching a regexp
+;; m-s comint-next-matching-input Next input that matches
+;; return term-send-input
+;; c-c c-a term-bol Beginning of line; skip prompt.
+;; c-d term-delchar-or-maybe-eof Delete char unless at end of buff.
+;; c-c c-u term-kill-input ^u
+;; c-c c-w backward-kill-word ^w
+;; c-c c-c term-interrupt-subjob ^c
+;; c-c c-z term-stop-subjob ^z
+;; c-c c-\ term-quit-subjob ^\
+;; c-c c-o term-kill-output Delete last batch of process output
+;; c-c c-r term-show-output Show last batch of process output
+;; c-c c-h term-dynamic-list-input-ring List input history
+;;
+;; Not bound by default in term-mode
+;; term-send-invisible Read a line w/o echo, and send to proc
+;; (These are bound in shell-mode)
+;; term-dynamic-complete Complete filename at point.
+;; term-dynamic-list-completions List completions in help buffer.
+;; term-replace-by-expanded-filename Expand and complete filename at point;
+;; replace with expanded/completed name.
+;; term-kill-subjob No mercy.
+;; term-show-maximum-output Show as much output as possible.
+;; term-continue-subjob Send CONT signal to buffer's process
+;; group. Useful if you accidentally
+;; suspend your process (with C-c C-z).
+
+;; term-mode-hook is the term mode hook. Basically for your keybindings.
+;; term-load-hook is run after loading in this package.
+
+;; Code:
+
+;; This is passed to the inferior in the EMACS environment variable,
+;; so it is important to increase it if there are protocol-relevant changes.
(defconst term-protocol-version "0.95")
(require 'ring)
"Called each time a process is exec'd by term-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 term-mode buffer (e.g.,
-(process-kill-without-query)). In contrast, the term-mode-hook is only
+\(process-kill-without-query)). In contrast, the term-mode-hook is only
executed once when the buffer is created.")
(defvar term-mode-map nil)
(defvar term-raw-map nil
"Keyboard map for sending characters directly to the inferior process.")
-(defvar term-escape-char nil)
+(defvar term-escape-char nil
+ "Escape character for char-sub-mode of term mode.
+Do not change it directly; use term-set-escape-char instead.")
(defvar term-raw-escape-map nil)
(defvar term-pager-break-map nil)
(defvar term-ptyp t
"True if communications via pty; false if by pipe. Buffer local.
-This is to work around a bug in emacs process signalling.")
+This is to work around a bug in emacs process signaling.")
(defvar term-last-input-match ""
"Last string searched for by term input history search, for defaulting.
(goto-char (process-mark proc))
(if (term-pager-enabled)
(setq term-pager-count (term-current-row)))
- (send-string proc chars))))
+ (process-send-string proc chars))))
(defun term-send-raw ()
"Send the last character typed through the terminal-emulator
(defun term-mouse-paste (click arg)
"Insert the last stretch of killed text at the position clicked on."
(interactive "e\nP")
- (mouse-set-point click)
- (setq this-command 'yank)
- (term-send-raw-string (current-kill (cond
- ((listp arg) 0)
- ((eq arg '-) -1)
- (t (1- arg))))))
+ (term-if-xemacs
+ (term-send-raw-string (or (condition-case () (x-get-selection) (error ()))
+ (x-get-cutbuffer)
+ (error "No selection or cut buffer available"))))
+ (term-ifnot-xemacs
+ ;; Give temporary modes such as isearch a chance to turn off.
+ (run-hooks 'mouse-leave-buffer-hook)
+ (setq this-command 'yank)
+ (term-send-raw-string (current-kill (cond
+ ((listp arg) 0)
+ ((eq arg '-) -1)
+ (t (1- arg)))))))
;; Which would be better: "\e[A" or "\eOA"? readline accepts either.
(defun term-send-up () (interactive) (term-send-raw-string "\e[A"))
(defun term-send-left () (interactive) (term-send-raw-string "\e[D"))
(defun term-set-escape-char (c)
+ "Change term-escape-char and keymaps that depend on it."
(if term-escape-char
(define-key term-raw-map term-escape-char 'term-send-raw))
(setq c (make-string 1 c))
(define-key term-raw-map c term-raw-escape-map)
- ;; Define standard binings in term-raw-escape-map
+ ;; Define standard bindings in term-raw-escape-map
(define-key term-raw-escape-map "\C-x"
(lookup-key (current-global-map) "\C-x"))
(define-key term-raw-escape-map "\C-v"
(copy-keymap (lookup-key (current-global-map) "\C-x")))
(term-if-emacs19
(term-if-xemacs
- (define-key term-raw-map [(button2)] 'term-mouse-paste))
+ (define-key term-raw-map [button2] 'term-mouse-paste))
(term-ifnot-xemacs
(define-key term-raw-map [mouse-2] 'term-mouse-paste)
(define-key term-raw-map [menu-bar terminal] term-terminal-menu)
- (define-key term-raw-map [menu-bar signals] term-signals-menu)
+ (define-key term-raw-map [menu-bar signals] term-signals-menu))
(define-key term-raw-map [up] 'term-send-up)
(define-key term-raw-map [down] 'term-send-down)
(define-key term-raw-map [right] 'term-send-right)
(define-key term-raw-map [left] 'term-send-left))
- (term-set-escape-char ?\C-c))))
+ (term-set-escape-char ?\C-c)))
;; FIXME: Emit message? Cfr ilisp-raw-message
(if (term-in-line-mode)
(progn
(if (term-in-char-mode)
(if (term-pager-enabled) '(": char page %s") '(": char %s"))
(if (term-pager-enabled) '(": line page %s") '(": line %s"))))
- (set-buffer-modified-p (buffer-modified-p))) ;; Force mode line update.
+ (force-mode-line-update))
(defun term-check-proc (buffer)
"True if there is a process associated w/buffer BUFFER, and
:so=\\E[7m:se=\\E[m:us=\\E[4m:ue=\\E[m:md=\\E[1m:mr=\\E[7m:me=\\E[m\
:UP=\\E[%%dA:DO=\\E[%%dB:LE=\\E[%%dD:RI=\\E[%%dC"
;;; : -undefine ic
- "termcap capabilties supported")
+ "termcap capabilities supported")
;;; This auxiliary function cranks up the process for term-exec in
;;; the appropriate environment.
(let ((argpart "[^ \n\t\"'`]+\\|\\(\"[^\"]*\"\\|'[^']*'\\|`[^`]*`\\)")
(args ()) (pos 0)
(count 0)
- beg str value quotes)
+ beg str quotes)
;; Build a list of all the args until we have as many as we want.
(while (and (or (null mth) (<= count mth))
(string-match argpart string pos))
(while (not done)
(if stars
(message "%s%s" prompt (make-string (length ans) ?*))
- (message prompt))
+ (message "%s" prompt))
(setq c (read-char))
(cond ((= c ?\C-g)
;; This function may get called from a process filter, where
(let ((H)
(todo (+ count (/ (current-column) term-width))))
(end-of-line)
- ;; The loop interates over buffer lines;
+ ;; The loop iterates over buffer lines;
;; H is the number of screen lines in the current line, i.e.
;; the ceiling of dividing the buffer line width by term-width.
(while (and (<= (setq H (max (/ (+ (current-column) term-width -1)
(progn (beginning-of-line)
(not (bobp))))
(setq todo (- todo H))
- (backward-char)) ;; Move to end of previos line
+ (backward-char)) ;; Move to end of previous line.
(if (and (>= todo H) (> todo 0))
(+ count todo (- 1 H)) ;; Hit beginning of buffer.
(move-to-column (* (- H todo 1) term-width))
;; This iteration, handle only what fits.
(setq count (- count temp))
(setq funny (+ count i)))
- ((> (term-handle-scroll 1) 0)
+ ((or (not (or term-pager-count
+ term-scroll-with-delete))
+ (> (term-handle-scroll 1) 0))
+ (term-adjust-current-row-cache 1)
(setq count (min count term-width))
(setq funny (+ count i))
- (term-adjust-current-row-cache 1)
(setq term-start-line-column
term-current-column))
(t ;; Doing PAGER processing.
(setq count 0 funny i)
(setq term-current-column nil)
(setq term-start-line-column nil)))
- (if term-insert-mode
- ;; Inserting spaces, then deleting them, then
- ;; inserting the actual text seems clumsy, but
- ;; it is simple, and the overhead is miniscule.
- (term-insert-spaces count))
(setq old-point (point))
- (term-move-columns count)
- (delete-region old-point (point))
+ ;; In the common case that we're at the end of
+ ;; the buffer, we can save a little work.
+ (cond ((/= (point) (point-max))
+ (if term-insert-mode
+ ;; Inserting spaces, then deleting them,
+ ;; then inserting the actual text is
+ ;; inefficient, but it is simple, and
+ ;; the actual overhead is miniscule.
+ (term-insert-spaces count))
+ (term-move-columns count)
+ (delete-region old-point (point)))
+ (t (setq term-current-column (+ (term-current-column) count))))
(insert (substring str i funny))
(put-text-property old-point (point)
'face term-current-face)
(setq count (+ count 8 (- (mod count 8))))
(if (< (move-to-column count nil) count)
(term-insert-char char 1))
- (setq term-current-column count)
- (setq term-start-line-column nil))
- ((eq char ?\b)
- (term-move-columns -1))
+ (setq term-current-column count))
((eq char ?\r)
- (term-vertical-motion 0)
- (setq term-current-column nil))
+ ;; Optimize CRLF at end of buffer:
+ (cond ((and (< (setq temp (1+ i)) str-length)
+ (eq (aref str temp) ?\n)
+ (= (point) (point-max))
+ (not (or term-pager-count
+ term-kill-echo-list
+ term-scroll-with-delete)))
+ (insert ?\n)
+ (term-adjust-current-row-cache 1)
+ (setq term-start-line-column 0)
+ (setq term-current-column 0)
+ (setq i temp))
+ (t ;; Not followed by LF or can't optimize:
+ (term-vertical-motion 0)
+ (setq term-current-column term-start-line-column))))
((eq char ?\n)
(if (not (and term-kill-echo-list
(term-check-kill-echo-list)))
- (term-down 1 0 t)))
+ (term-down 1 t)))
+ ((eq char ?\b)
+ (term-move-columns -1))
((eq char ?\033) ; Escape
(setq term-terminal-state 2))
((eq char 0)) ; NUL: Do nothing
(setq term-terminal-previous-parameter 0)
(setq term-terminal-state 3))
((eq char ?D) ;; scroll forward
- (term-down 1 0 t)
+ (term-handle-deferred-scroll)
+ (term-down 1 t)
(setq term-terminal-state 0))
((eq char ?M) ;; scroll reversed
(term-insert-lines 1)
(setq term-terminal-state 0))
((eq char ?7) ;; Save cursor
+ (term-handle-deferred-scroll)
(setq term-saved-cursor
(cons (term-current-row)
(term-horizontal-column)))
(setq i str-length)))
(setq i (1+ i))))
+ (if (>= (term-current-row) term-height)
+ (term-handle-deferred-scroll))
+
(set-marker (process-mark proc) (point))
(if save-point
(progn (goto-char save-point)
(set-buffer previous-buffer)
(select-window selected))))
+(defun term-handle-deferred-scroll ()
+ (let ((count (- (term-current-row) term-height)))
+ (if (>= count 0)
+ (save-excursion
+ (goto-char term-home-marker)
+ (term-vertical-motion (1+ count))
+ (set-marker term-home-marker (point))
+ (setq term-current-row (1- term-height))))))
+
;;; Handle a character assuming (eq terminal-state 2) -
-;;; i.e. we have previousely seen Escape followed by ?[.
+;;; i.e. we have previously seen Escape followed by ?[.
(defun term-handle-ansi-escape (proc char)
(cond
(1- term-terminal-parameter)))
;; \E[A - cursor up
((eq char ?A)
- (term-down (- (max 1 term-terminal-parameter)) 0 t))
+ (term-handle-deferred-scroll)
+ (term-down (- (max 1 term-terminal-parameter)) t))
;; \E[B - cursor down
((eq char ?B)
- (term-down (max 1 term-terminal-parameter) 0 t))
+ (term-down (max 1 term-terminal-parameter) t))
;; \E[C - cursor right
((eq char ?C)
(term-move-columns (max 1 term-terminal-parameter)))
(t (setq term-current-face 'default))))
;; \E[6n - Report cursor position
((eq char ?n)
+ (term-handle-deferred-scroll)
(process-send-string proc
(format "\e[%s;%sR"
(1+ (term-current-row))
(defun term-scroll-region (top bottom)
"Set scrolling region.
TOP is the top-most line (inclusive) of the new scrolling region,
-while BOTTOM is the line folling the new scrolling region (e.g. exclusive).
+while BOTTOM is the line following the new scrolling region (e.g. exclusive).
The top-most line is line 0."
(setq term-scroll-start
(if (or (< top 0) (>= top term-height))
;; If asked to switch to (from) the alternate sub-buffer, and already (not)
;; using it, do nothing. This test is needed for some programs (including
;; emacs) that emit the ti termcap string twice, for unknown reason.
+ (term-handle-deferred-scroll)
(if (eq set (not (term-using-alternate-sub-buffer)))
(let ((row (term-current-row))
(col (term-horizontal-column)))
;;; "down" as needed so that is no more that a window-full above (point-max).
(defun term-goto-home ()
+ (term-handle-deferred-scroll)
(goto-char term-home-marker)
(setq term-current-row 0)
(setq term-current-column (current-column))
(setq term-start-line-column term-current-column))
-;;; FIXME: This can be optimized some.
(defun term-goto (row col)
- (term-goto-home)
- (term-down row col))
+ (term-handle-deferred-scroll)
+ (cond ((and term-current-row (>= row term-current-row))
+ ;; I assume this is a worthwhile optimization.
+ (term-vertical-motion 0)
+ (setq term-current-column term-start-line-column)
+ (setq row (- row term-current-row)))
+ (t
+ (term-goto-home)))
+ (term-down row)
+ (term-move-columns col))
; The page is full, so enter "pager" mode, and wait for input.
(defun term-process-pager ()
(if (not term-pager-break-map)
(let* ((map (make-keymap))
- (i 0) tmp)
+ (i 0) tmp)
; (while (< i 128)
; (define-key map (make-string 1 i) 'term-send-raw)
; (setq i (1+ i)))
(setq tmp (make-sparse-keymap "More pages?"))
(define-key tmp [help] '("Help" . term-pager-help))
(define-key tmp [disable]
- '("Diable paging" . term-fake-pager-disable))
+ '("Disable paging" . term-fake-pager-disable))
(define-key tmp [discard]
'("Discard remaining output" . term-pager-discard))
(define-key tmp [eob] '("Goto to end" . term-pager-eob))
mode-line-buffer-identification
" [Type ? for help] "
"%-"))
- (set-buffer-modified-p (buffer-modified-p))) ;;No-op, but updates mode line.
+ (force-mode-line-update))
(defun term-pager-line (lines)
(interactive "p")
(use-local-map term-pager-old-local-map)
(setq term-pager-old-local-map nil)
(setq mode-line-format term-old-mode-line-format)
- (set-buffer-modified-p (buffer-modified-p)) ;; Updates mode line.
+ (force-mode-line-update)
(setq term-pager-count new-count)
(set-process-filter process term-pager-old-filter)
(funcall term-pager-old-filter process "")
(delete-region save-top (point))
(goto-char save-point)
(term-vertical-motion down)
+ (term-adjust-current-row-cache (- scroll-needed))
+ (setq term-current-column nil)
(term-insert-char ?\n scroll-needed))
((and (numberp term-pager-count)
(< (setq term-pager-count (- term-pager-count down))
(setq down 0)
(term-process-pager))
(t
+ (term-adjust-current-row-cache (- scroll-needed))
(term-vertical-motion scroll-needed)
(set-marker term-home-marker (point))))
(goto-char save-point)
- (set-marker save-point nil)
- (setq term-current-column nil)
- (setq term-current-row nil))))
+ (set-marker save-point nil))))
down)
-(defun term-down (down right &optional check-for-scroll)
- "Move down DOWN screen lines vertically, and RIGHT columns horizontally."
+(defun term-down (down &optional check-for-scroll)
+ "Move down DOWN screen lines vertically."
(let ((start-column (term-horizontal-column)))
- (if check-for-scroll
+ (if (and check-for-scroll (or term-scroll-with-delete term-pager-count))
(setq down (term-handle-scroll down)))
(term-adjust-current-row-cache down)
- (setq down (- down (term-vertical-motion down)))
- ; Extend buffer with extra blank lines if needed.
- (if (> down 0) (term-insert-char ?\n down))
- (setq term-current-column nil)
- (setq term-start-line-column (current-column))
- (move-to-column (+ term-start-line-column start-column right) t)))
+ (if (/= (point) (point-max))
+ (setq down (- down (term-vertical-motion down))))
+ ;; Extend buffer with extra blank lines if needed.
+ (cond ((> down 0)
+ (term-insert-char ?\n down)
+ (setq term-current-column 0)
+ (setq term-start-line-column 0))
+ (t
+ (setq term-current-column nil)
+ (setq term-start-line-column (current-column))))
+ (if start-column
+ (term-move-columns start-column))))
;; Assuming point is at the beginning of a screen line,
;; if the line above point wraps around, add a ?\n to undo the wrapping.
If KIND is 0, erase from (point) to (point-max);
if KIND is 1, erase from home to point; else erase from home to point-max.
Should only be called when point is at the start of a screen line."
+ (term-handle-deferred-scroll)
(cond ((eq term-terminal-parameter 0)
(delete-region (point) (point-max))
(term-unwrap-line))
(move-to-column (+ (term-current-column) count) t)
(delete-region save-point (point))))
+;;; Insert COUNT spaces after point, but do not change any of
+;;; following screen lines. Hence we may have to delete characters
+;;; at teh end of this screen line to make room.
+
(defun term-insert-spaces (count)
(let ((save-point (point)) (save-eol))
(term-vertical-motion 1)
(save-current-column term-current-column)
(save-start-line-column term-start-line-column)
(save-current-row (term-current-row)))
- (term-down lines 0)
+ (term-down lines)
(delete-region start (point))
- (term-down (- term-scroll-end save-current-row lines) 0)
+ (term-down (- term-scroll-end save-current-row lines))
(term-insert-char ?\n lines)
(setq term-current-column save-current-column)
(setq term-start-line-column save-start-line-column)
(save-current-column term-current-column)
(save-start-line-column term-start-line-column)
(save-current-row (term-current-row)))
- (term-down (- term-scroll-end save-current-row lines) 0)
+ (term-down (- term-scroll-end save-current-row lines))
(setq start-deleted (point))
- (term-down lines 0)
+ (term-down lines)
(delete-region start-deleted (point))
(goto-char start)
(setq term-current-column save-current-column)
;;; want them present in specific modes.
(defvar term-completion-autolist nil
- "*If non-nil, automatically list possiblities on partial completion.
+ "*If non-nil, automatically list possibilities on partial completion.
This mirrors the optional behavior of tcsh.")
(defvar term-completion-addsuffix t