-;; 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>
(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.
(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"
(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 ((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 0))))
((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 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