Mercurial > emacs
changeset 57163:22cfa0559b07
(term-emulate-terminal): Turn off undo for output.
Use with-current-buffer and save-selected-window.
| author | Richard M. Stallman <rms@gnu.org> |
|---|---|
| date | Mon, 20 Sep 2004 15:59:31 +0000 |
| parents | a9bbdf07a7d6 |
| children | 11b507f888a6 |
| files | lisp/term.el |
| diffstat | 1 files changed, 293 insertions(+), 297 deletions(-) [+] |
line wrap: on
line diff
--- a/lisp/term.el Mon Sep 20 15:54:10 2004 +0000 +++ b/lisp/term.el Mon Sep 20 15:59:31 2004 +0000 @@ -2635,314 +2635,310 @@ ;;; It emulates (most of the features of) a VT100/ANSI-style terminal. (defun term-emulate-terminal (proc str) - (let* ((previous-buffer (current-buffer)) - (i 0) char funny count save-point save-marker old-point temp win - (selected (selected-window)) - last-win - (str-length (length str))) - (unwind-protect - (progn - (set-buffer (process-buffer proc)) - -;;; Let's handle the messages. -mm - - (setq str (term-handle-ansi-terminal-messages str)) - (setq str-length (length str)) - - (if (marker-buffer term-pending-delete-marker) - (progn - ;; Delete text following term-pending-delete-marker. - (delete-region term-pending-delete-marker (process-mark proc)) - (set-marker term-pending-delete-marker nil))) - - (if (eq (window-buffer) (current-buffer)) - (progn - (setq term-vertical-motion (symbol-function 'vertical-motion)) - (term-check-size proc)) - (setq term-vertical-motion - (symbol-function 'buffer-vertical-motion))) - - (setq save-marker (copy-marker (process-mark proc))) - - (if (/= (point) (process-mark proc)) - (progn (setq save-point (point-marker)) - (goto-char (process-mark proc)))) - - (save-restriction - ;; If the buffer is in line mode, and there is a partial - ;; input line, save the line (by narrowing to leave it - ;; outside the restriction ) until we're done with output. - (if (and (> (point-max) (process-mark proc)) - (term-in-line-mode)) - (narrow-to-region (point-min) (process-mark proc))) - - (if term-log-buffer - (princ str term-log-buffer)) - (cond ((eq term-terminal-state 4) ;; Have saved pending output. - (setq str (concat term-terminal-parameter str)) - (setq term-terminal-parameter nil) - (setq str-length (length str)) - (setq term-terminal-state 0))) - - (while (< i str-length) - (setq char (aref str i)) - (cond ((< term-terminal-state 2) - ;; Look for prefix of regular chars - (setq funny - (string-match "[\r\n\000\007\033\t\b\032\016\017]" - str i)) - (if (not funny) (setq funny str-length)) - (cond ((> funny i) - (cond ((eq term-terminal-state 1) - (term-move-columns 1) - (setq term-terminal-state 0))) - (setq count (- funny i)) - (setq temp (- (+ (term-horizontal-column) count) - term-width)) - (cond ((<= temp 0)) ;; All count chars fit in line. - ((> count temp) ;; Some chars fit. - ;; This iteration, handle only what fits. - (setq count (- count temp)) - (setq funny (+ count i))) - ((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)) - (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))) - (setq old-point (point)) - - ;; Insert a string, check how many columns - ;; we moved, then delete that many columns - ;; following point if not eob nor insert-mode. - (let ((old-column (current-column)) - columns pos) - (insert (substring str i funny)) - (setq term-current-column (current-column) - columns (- term-current-column old-column)) - (when (not (or (eobp) term-insert-mode)) - (setq pos (point)) - (term-move-columns columns) - (delete-region pos (point)))) - (setq term-current-column nil) - - (put-text-property old-point (point) - 'face term-current-face) - ;; If the last char was written in last column, - ;; back up one column, but remember we did so. - ;; Thus we emulate xterm/vt100-style line-wrapping. - (cond ((eq temp 0) - (term-move-columns -1) - (setq term-terminal-state 1))) - (setq i (1- funny))) - ((and (setq term-terminal-state 0) - (eq char ?\^I)) ; TAB - ;; FIXME: Does not handle line wrap! - (setq count (term-current-column)) - (setq count (+ count 8 (- (mod count 8)))) - (if (< (move-to-column count nil) count) - (term-insert-char char 1)) - (setq term-current-column count)) - ((eq char ?\r) - ;; 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 t))) - ((eq char ?\b) - (term-move-columns -1)) - ((eq char ?\033) ; Escape - (setq term-terminal-state 2)) - ((eq char 0)) ; NUL: Do nothing - ((eq char ?\016)) ; Shift Out - ignored - ((eq char ?\017)) ; Shift In - ignored - ((eq char ?\^G) - (beep t)) ; Bell - ((eq char ?\032) - (let ((end (string-match "\r?$" str i))) - (if end - (funcall term-command-hook - (prog1 (substring str (1+ i) end) - (setq i (match-end 0)))) - (setq term-terminal-parameter - (substring str i)) - (setq term-terminal-state 4) - (setq i str-length)))) - (t ; insert char FIXME: Should never happen - (term-move-columns 1) - (backward-delete-char 1) - (insert char)))) - ((eq term-terminal-state 2) ; Seen Esc - (cond ((eq char ?\133) ;; ?\133 = ?[ + (with-current-buffer (process-buffer proc) + (let* ((i 0) char funny count save-point save-marker old-point temp win + (buffer-undo-list t) + (selected (selected-window)) + last-win + (str-length (length str))) + (save-selected-window + + ;; Let's handle the messages. -mm + + (setq str (term-handle-ansi-terminal-messages str)) + (setq str-length (length str)) + + (if (marker-buffer term-pending-delete-marker) + (progn + ;; Delete text following term-pending-delete-marker. + (delete-region term-pending-delete-marker (process-mark proc)) + (set-marker term-pending-delete-marker nil))) + + (if (eq (window-buffer) (current-buffer)) + (progn + (setq term-vertical-motion (symbol-function 'vertical-motion)) + (term-check-size proc)) + (setq term-vertical-motion + (symbol-function 'buffer-vertical-motion))) + + (setq save-marker (copy-marker (process-mark proc))) + + (if (/= (point) (process-mark proc)) + (progn (setq save-point (point-marker)) + (goto-char (process-mark proc)))) + + (save-restriction + ;; If the buffer is in line mode, and there is a partial + ;; input line, save the line (by narrowing to leave it + ;; outside the restriction ) until we're done with output. + (if (and (> (point-max) (process-mark proc)) + (term-in-line-mode)) + (narrow-to-region (point-min) (process-mark proc))) + + (if term-log-buffer + (princ str term-log-buffer)) + (cond ((eq term-terminal-state 4) ;; Have saved pending output. + (setq str (concat term-terminal-parameter str)) + (setq term-terminal-parameter nil) + (setq str-length (length str)) + (setq term-terminal-state 0))) + + (while (< i str-length) + (setq char (aref str i)) + (cond ((< term-terminal-state 2) + ;; Look for prefix of regular chars + (setq funny + (string-match "[\r\n\000\007\033\t\b\032\016\017]" + str i)) + (if (not funny) (setq funny str-length)) + (cond ((> funny i) + (cond ((eq term-terminal-state 1) + (term-move-columns 1) + (setq term-terminal-state 0))) + (setq count (- funny i)) + (setq temp (- (+ (term-horizontal-column) count) + term-width)) + (cond ((<= temp 0)) ;; All count chars fit in line. + ((> count temp) ;; Some chars fit. + ;; This iteration, handle only what fits. + (setq count (- count temp)) + (setq funny (+ count i))) + ((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)) + (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))) + (setq old-point (point)) + + ;; Insert a string, check how many columns + ;; we moved, then delete that many columns + ;; following point if not eob nor insert-mode. + (let ((old-column (current-column)) + columns pos) + (insert (substring str i funny)) + (setq term-current-column (current-column) + columns (- term-current-column old-column)) + (when (not (or (eobp) term-insert-mode)) + (setq pos (point)) + (term-move-columns columns) + (delete-region pos (point)))) + (setq term-current-column nil) + + (put-text-property old-point (point) + 'face term-current-face) + ;; If the last char was written in last column, + ;; back up one column, but remember we did so. + ;; Thus we emulate xterm/vt100-style line-wrapping. + (cond ((eq temp 0) + (term-move-columns -1) + (setq term-terminal-state 1))) + (setq i (1- funny))) + ((and (setq term-terminal-state 0) + (eq char ?\^I)) ; TAB + ;; FIXME: Does not handle line wrap! + (setq count (term-current-column)) + (setq count (+ count 8 (- (mod count 8)))) + (if (< (move-to-column count nil) count) + (term-insert-char char 1)) + (setq term-current-column count)) + ((eq char ?\r) + ;; 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 t))) + ((eq char ?\b) + (term-move-columns -1)) + ((eq char ?\033) ; Escape + (setq term-terminal-state 2)) + ((eq char 0)) ; NUL: Do nothing + ((eq char ?\016)) ; Shift Out - ignored + ((eq char ?\017)) ; Shift In - ignored + ((eq char ?\^G) + (beep t)) ; Bell + ((eq char ?\032) + (let ((end (string-match "\r?$" str i))) + (if end + (funcall term-command-hook + (prog1 (substring str (1+ i) end) + (setq i (match-end 0)))) + (setq term-terminal-parameter + (substring str i)) + (setq term-terminal-state 4) + (setq i str-length)))) + (t ; insert char FIXME: Should never happen + (term-move-columns 1) + (backward-delete-char 1) + (insert char)))) + ((eq term-terminal-state 2) ; Seen Esc + (cond ((eq char ?\133) ;; ?\133 = ?[ ;;; Some modifications to cope with multiple settings like ^[[01;32;43m -mm ;;; Note that now the init value of term-terminal-previous-parameter has ;;; been changed to -1 - (make-local-variable 'term-terminal-parameter) - (make-local-variable 'term-terminal-previous-parameter) - (make-local-variable 'term-terminal-previous-parameter-2) - (make-local-variable 'term-terminal-previous-parameter-3) - (make-local-variable 'term-terminal-previous-parameter-4) - (make-local-variable 'term-terminal-more-parameters) - (setq term-terminal-parameter 0) - (setq term-terminal-previous-parameter -1) - (setq term-terminal-previous-parameter-2 -1) - (setq term-terminal-previous-parameter-3 -1) - (setq term-terminal-previous-parameter-4 -1) - (setq term-terminal-more-parameters 0) - (setq term-terminal-state 3)) - ((eq char ?D) ;; scroll forward - (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 term-terminal-state 0)) - ((eq char ?8) ;; Restore cursor - (if term-saved-cursor - (term-goto (car term-saved-cursor) - (cdr term-saved-cursor))) - (setq term-terminal-state 0)) - ((setq term-terminal-state 0)))) - ((eq term-terminal-state 3) ; Seen Esc [ - (cond ((and (>= char ?0) (<= char ?9)) - (setq term-terminal-parameter - (+ (* 10 term-terminal-parameter) (- char ?0)))) - ((eq char ?\;) + (make-local-variable 'term-terminal-parameter) + (make-local-variable 'term-terminal-previous-parameter) + (make-local-variable 'term-terminal-previous-parameter-2) + (make-local-variable 'term-terminal-previous-parameter-3) + (make-local-variable 'term-terminal-previous-parameter-4) + (make-local-variable 'term-terminal-more-parameters) + (setq term-terminal-parameter 0) + (setq term-terminal-previous-parameter -1) + (setq term-terminal-previous-parameter-2 -1) + (setq term-terminal-previous-parameter-3 -1) + (setq term-terminal-previous-parameter-4 -1) + (setq term-terminal-more-parameters 0) + (setq term-terminal-state 3)) + ((eq char ?D) ;; scroll forward + (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 term-terminal-state 0)) + ((eq char ?8) ;; Restore cursor + (if term-saved-cursor + (term-goto (car term-saved-cursor) + (cdr term-saved-cursor))) + (setq term-terminal-state 0)) + ((setq term-terminal-state 0)))) + ((eq term-terminal-state 3) ; Seen Esc [ + (cond ((and (>= char ?0) (<= char ?9)) + (setq term-terminal-parameter + (+ (* 10 term-terminal-parameter) (- char ?0)))) + ((eq char ?\;) ;;; Some modifications to cope with multiple settings like ^[[01;32;43m -mm - (setq term-terminal-more-parameters 1) - (setq term-terminal-previous-parameter-4 - term-terminal-previous-parameter-3) - (setq term-terminal-previous-parameter-3 - term-terminal-previous-parameter-2) - (setq term-terminal-previous-parameter-2 - term-terminal-previous-parameter) - (setq term-terminal-previous-parameter - term-terminal-parameter) - (setq term-terminal-parameter 0)) - ((eq char ??)) ; Ignore ? - (t - (term-handle-ansi-escape proc char) - (setq term-terminal-more-parameters 0) - (setq term-terminal-previous-parameter-4 -1) - (setq term-terminal-previous-parameter-3 -1) - (setq term-terminal-previous-parameter-2 -1) - (setq term-terminal-previous-parameter -1) - (setq term-terminal-state 0))))) - (if (term-handling-pager) - ;; Finish stuff to get ready to handle PAGER. - (progn - (if (> (% (current-column) term-width) 0) + (setq term-terminal-more-parameters 1) + (setq term-terminal-previous-parameter-4 + term-terminal-previous-parameter-3) + (setq term-terminal-previous-parameter-3 + term-terminal-previous-parameter-2) + (setq term-terminal-previous-parameter-2 + term-terminal-previous-parameter) + (setq term-terminal-previous-parameter + term-terminal-parameter) + (setq term-terminal-parameter 0)) + ((eq char ??)) ; Ignore ? + (t + (term-handle-ansi-escape proc char) + (setq term-terminal-more-parameters 0) + (setq term-terminal-previous-parameter-4 -1) + (setq term-terminal-previous-parameter-3 -1) + (setq term-terminal-previous-parameter-2 -1) + (setq term-terminal-previous-parameter -1) + (setq term-terminal-state 0))))) + (if (term-handling-pager) + ;; Finish stuff to get ready to handle PAGER. + (progn + (if (> (% (current-column) term-width) 0) + (setq term-terminal-parameter + (substring str i)) + ;; We're at column 0. Goto end of buffer; to compensate, + ;; prepend a ?\r for later. This looks more consistent. + (if (zerop i) (setq term-terminal-parameter - (substring str i)) - ;; We're at column 0. Goto end of buffer; to compensate, - ;; prepend a ?\r for later. This looks more consistent. - (if (zerop i) - (setq term-terminal-parameter - (concat "\r" (substring str i))) - (setq term-terminal-parameter (substring str (1- i))) - (aset term-terminal-parameter 0 ?\r)) - (goto-char (point-max))) - (setq term-terminal-state 4) - (make-local-variable 'term-pager-old-filter) - (setq term-pager-old-filter (process-filter proc)) - (set-process-filter proc term-pager-filter) - (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-marker save-point nil))) - - ;; Check for a pending filename-and-line number to display. - ;; We do this before scrolling, because we might create a new window. - (if (and term-pending-frame - (eq (window-buffer selected) (current-buffer))) - (progn (term-display-line (car term-pending-frame) - (cdr term-pending-frame)) - (setq term-pending-frame nil) - ;; We have created a new window, so check the window size. - (term-check-size proc))) - - ;; Scroll each window displaying the buffer but (by default) - ;; only if the point matches the process-mark we started with. - (setq win selected) - ;; Avoid infinite loop in strange case where minibuffer window - ;; is selected but not active. - (while (window-minibuffer-p win) - (setq win (next-window win nil t))) - (setq last-win win) - (while (progn - (setq win (next-window win nil t)) - (if (eq (window-buffer win) (process-buffer proc)) - (let ((scroll term-scroll-to-bottom-on-output)) - (select-window win) - (if (or (= (point) save-marker) - (eq scroll t) (eq scroll 'all) - ;; Maybe user wants point to jump to the end. - (and (eq selected win) - (or (eq scroll 'this) (not save-point))) - (and (eq scroll 'others) - (not (eq selected win)))) - (progn - (goto-char term-home-marker) - (recenter 0) - (goto-char (process-mark proc)) - (if (not (pos-visible-in-window-p (point) win)) - (recenter -1)))) - ;; Optionally scroll so that the text - ;; ends at the bottom of the window. - (if (and term-scroll-show-maximum-output - (>= (point) (process-mark proc))) - (save-excursion - (goto-char (point-max)) - (recenter -1))))) - (not (eq win last-win)))) + (concat "\r" (substring str i))) + (setq term-terminal-parameter (substring str (1- i))) + (aset term-terminal-parameter 0 ?\r)) + (goto-char (point-max))) + (setq term-terminal-state 4) + (make-local-variable 'term-pager-old-filter) + (setq term-pager-old-filter (process-filter proc)) + (set-process-filter proc term-pager-filter) + (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-marker save-point nil))) + + ;; Check for a pending filename-and-line number to display. + ;; We do this before scrolling, because we might create a new window. + (if (and term-pending-frame + (eq (window-buffer selected) (current-buffer))) + (progn (term-display-line (car term-pending-frame) + (cdr term-pending-frame)) + (setq term-pending-frame nil) + ;; We have created a new window, so check the window size. + (term-check-size proc))) + + ;; Scroll each window displaying the buffer but (by default) + ;; only if the point matches the process-mark we started with. + (setq win selected) + ;; Avoid infinite loop in strange case where minibuffer window + ;; is selected but not active. + (while (window-minibuffer-p win) + (setq win (next-window win nil t))) + (setq last-win win) + (while (progn + (setq win (next-window win nil t)) + (if (eq (window-buffer win) (process-buffer proc)) + (let ((scroll term-scroll-to-bottom-on-output)) + (select-window win) + (if (or (= (point) save-marker) + (eq scroll t) (eq scroll 'all) + ;; Maybe user wants point to jump to the end. + (and (eq selected win) + (or (eq scroll 'this) (not save-point))) + (and (eq scroll 'others) + (not (eq selected win)))) + (progn + (goto-char term-home-marker) + (recenter 0) + (goto-char (process-mark proc)) + (if (not (pos-visible-in-window-p (point) win)) + (recenter -1)))) + ;; Optionally scroll so that the text + ;; ends at the bottom of the window. + (if (and term-scroll-show-maximum-output + (>= (point) (process-mark proc))) + (save-excursion + (goto-char (point-max)) + (recenter -1))))) + (not (eq win last-win)))) ;;; Stolen from comint.el and adapted -mm - (if (> term-buffer-maximum-size 0) - (save-excursion - (goto-char (process-mark (get-buffer-process (current-buffer)))) - (forward-line (- term-buffer-maximum-size)) - (beginning-of-line) - (delete-region (point-min) (point)))) + (if (> term-buffer-maximum-size 0) + (save-excursion + (goto-char (process-mark (get-buffer-process (current-buffer)))) + (forward-line (- term-buffer-maximum-size)) + (beginning-of-line) + (delete-region (point-min) (point)))) ;;; - (set-marker save-marker nil)) - ;; unwind-protect cleanup-forms follow: - (set-buffer previous-buffer) - (select-window selected)))) + (set-marker save-marker nil))))) (defun term-handle-deferred-scroll () (let ((count (- (term-current-row) term-height)))