From 9730575f3a2599be0a4f9c3d1ef5321bf1294e93 Mon Sep 17 00:00:00 2001 From: Lars Ingebrigtsen Date: Fri, 5 Feb 2021 10:13:23 +0100 Subject: [PATCH] Protect against killed buffers in term-emulate-terminal * lisp/term.el (term-emulate-terminal): Ensure that the buffer is still alive before selecting it (bug#46323). This avoids an error when saying `C-x k' in an ansi-term buffer. --- lisp/term.el | 651 ++++++++++++++++++++++++++------------------------- 1 file changed, 326 insertions(+), 325 deletions(-) diff --git a/lisp/term.el b/lisp/term.el index 971f2703978..6beb17fb66f 100644 --- a/lisp/term.el +++ b/lisp/term.el @@ -2812,333 +2812,334 @@ See `term-prompt-regexp'." "[\032\e]") (defun term-emulate-terminal (proc str) - (with-current-buffer (process-buffer proc) - (let* ((i 0) funny - decoded-substring - save-point save-marker win - (inhibit-read-only t) - (buffer-undo-list t) - (selected (selected-window)) - last-win - (str-length (length str))) - (save-selected-window - - (when (marker-buffer term-pending-delete-marker) - ;; Delete text following term-pending-delete-marker. - (delete-region term-pending-delete-marker (process-mark proc)) - (set-marker term-pending-delete-marker nil)) - - (when (/= (point) (process-mark proc)) - (setq save-point (point-marker))) - - (setf term-vertical-motion - (if (eq (window-buffer) (current-buffer)) - 'vertical-motion - 'term-buffer-vertical-motion)) - (setq save-marker (copy-marker (process-mark proc))) - (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. - (when (and (> (point-max) (process-mark proc)) - (term-in-line-mode)) - (narrow-to-region (point-min) (process-mark proc))) - - (when term-log-buffer - (princ str term-log-buffer)) - (when term-terminal-undecoded-bytes - (setq str (concat term-terminal-undecoded-bytes str)) - (setq str-length (length str)) - (setq term-terminal-undecoded-bytes nil)) - - (while (< i str-length) - (setq funny (string-match term-control-seq-regexp str i)) - (let ((ctl-params (and funny (match-string 1 str))) - (ctl-params-end (and funny (match-end 1))) - (ctl-end (if funny (match-end 0) - (setq funny (string-match term-control-seq-prefix-regexp str i)) - (if funny - (setq term-terminal-undecoded-bytes - (substring str funny)) - (setq funny str-length)) - ;; The control sequence ends somewhere - ;; past the end of this string. - (1+ str-length)))) - (when (> funny i) - (when term-do-line-wrapping - (term-down 1 t) - (term-move-to-column 0) - (setq term-do-line-wrapping nil)) - ;; Handle non-control data. Decode the string before - ;; counting characters, to avoid garbling of certain - ;; multibyte characters (bug#1006). - (setq decoded-substring - (decode-coding-string - (substring str i funny) - locale-coding-system t)) - ;; Check for multibyte characters that ends - ;; before end of string, and save it for - ;; next time. - (when (= funny str-length) - (let ((partial 0) - (count (length decoded-substring))) - (while (and (< partial count) - (eq (char-charset (aref decoded-substring - (- count 1 partial))) - 'eight-bit)) - (cl-incf partial)) - (when (> count partial 0) - (setq term-terminal-undecoded-bytes - (substring decoded-substring (- partial))) - (setq decoded-substring - (substring decoded-substring 0 (- partial))) - (cl-decf str-length partial) - (cl-decf funny partial)))) - - ;; 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 (term-horizontal-column)) - (old-point (point)) - columns) - (unless term-suppress-hard-newline - (while (> (+ (length decoded-substring) old-column) - term-width) - (insert (substring decoded-substring 0 - (- term-width old-column))) - ;; Since we've enough text to fill the whole line, - ;; delete previous text regardless of - ;; `term-insert-mode's value. - (delete-region (point) (line-end-position)) - (term-down 1 t) - (term-move-columns (- (term-current-column))) - (add-text-properties (1- (point)) (point) - '(term-line-wrap t rear-nonsticky t)) - (setq decoded-substring - (substring decoded-substring (- term-width old-column))) - (setq old-column 0))) - (insert decoded-substring) - (setq term-current-column (current-column) - columns (- term-current-column old-column)) - (when (not (or (eobp) term-insert-mode)) - (let ((pos (point))) - (term-move-columns columns) - (delete-region pos (point)) - (setq term-current-column nil))) - ;; In insert mode if the current line - ;; has become too long it needs to be - ;; chopped off. - (when term-insert-mode - (let ((pos (point))) - (end-of-line) - (when (> (current-column) term-width) - (delete-region (- (point) (- (current-column) term-width)) - (point))) - (goto-char pos))) - - (put-text-property old-point (point) - 'font-lock-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. - (when (eq (term-current-column) term-width) - (term-move-columns -1) - ;; We check after ctrl sequence handling if point - ;; was moved (and leave line-wrapping state if so). - (setq term-do-line-wrapping (point))) - (setq term-current-column nil) - (setq i funny)) - (pcase-exhaustive (and (<= ctl-end str-length) (aref str i)) - (?\t ;; TAB (terminfo: ht) - ;; The line cannot exceed term-width. TAB at - ;; the end of a line should not cause wrapping. - (let ((col (term-current-column))) - (term-move-to-column - (min (1- term-width) - (+ col 8 (- (mod col 8))))))) - (?\r ;; (terminfo: cr) - (term-vertical-motion 0) - (setq term-current-column term-start-line-column)) - (?\n ;; (terminfo: cud1, ind) - (unless (and term-kill-echo-list - (term-check-kill-echo-list)) - (term-down 1 t))) - (?\b ;; (terminfo: cub1) - (term-move-columns -1)) - (?\C-g ;; (terminfo: bel) - (beep t)) - (?\032 ; Emacs specific control sequence. - (funcall term-command-function - (decode-coding-string - (substring str (1+ i) - (- ctl-end - (if (eq (aref str (- ctl-end 2)) ?\r) - 2 1))) - locale-coding-system t))) - (?\e - (pcase (aref str (1+ i)) - (?\[ - ;; We only handle control sequences with a single - ;; "Final" byte (see [ECMA-48] section 5.4). - (when (eq ctl-params-end (1- ctl-end)) - (term-handle-ansi-escape - proc - (mapcar ;; We don't distinguish empty params - ;; from 0 (according to [ECMA-48] we - ;; should, but all commands we support - ;; default to 0 values anyway). - #'string-to-number - (split-string ctl-params ";")) - (aref str (1- ctl-end))))) - (?D ;; Scroll forward (apparently not documented in - ;; [ECMA-48], [ctlseqs] mentions it as C1 - ;; character "Index" though). - (term-handle-deferred-scroll) - (term-down 1 t)) - (?M ;; Scroll reversed (terminfo: ri, ECMA-48 - ;; "Reverse Linefeed"). - (if (or (< (term-current-row) term-scroll-start) - (>= (1- (term-current-row)) - term-scroll-start)) - ;; Scrolling up will not move outside - ;; the scroll region. - (term-down -1) - ;; Scrolling the scroll region is needed. - (term-down -1 t))) - (?7 ;; Save cursor (terminfo: sc, not in [ECMA-48], - ;; [ctlseqs] has it as "DECSC"). - (term-handle-deferred-scroll) - (setq term-saved-cursor - (list (term-current-row) - (term-horizontal-column) - term-ansi-current-bg-color - term-ansi-current-bold - term-ansi-current-color - term-ansi-current-invisible - term-ansi-current-reverse - term-ansi-current-underline - term-current-face))) - (?8 ;; Restore cursor (terminfo: rc, [ctlseqs] - ;; "DECRC"). - (when term-saved-cursor - (term-goto (nth 0 term-saved-cursor) - (nth 1 term-saved-cursor)) - (setq term-ansi-current-bg-color - (nth 2 term-saved-cursor) - term-ansi-current-bold - (nth 3 term-saved-cursor) - term-ansi-current-color - (nth 4 term-saved-cursor) - term-ansi-current-invisible - (nth 5 term-saved-cursor) - term-ansi-current-reverse - (nth 6 term-saved-cursor) - term-ansi-current-underline - (nth 7 term-saved-cursor) - term-current-face - (nth 8 term-saved-cursor)))) - (?c ;; \Ec - Reset (terminfo: rs1, [ctlseqs] "RIS"). - ;; This is used by the "clear" program. - (term-reset-terminal)) - (?A ;; An \eAnSiT sequence (Emacs specific). - (term-handle-ansi-terminal-messages - (substring str i ctl-end))))) - ;; Ignore NUL, Shift Out, Shift In. - ((or ?\0 #xE #xF 'nil) nil)) - ;; Leave line-wrapping state if point was moved. - (unless (eq term-do-line-wrapping (point)) - (setq term-do-line-wrapping nil)) - (if (term-handling-pager) - (progn - ;; Finish stuff to get ready to handle PAGER. - (if (> (% (current-column) term-width) 0) + (when (buffer-live-p (process-buffer proc)) + (with-current-buffer (process-buffer proc) + (let* ((i 0) funny + decoded-substring + save-point save-marker win + (inhibit-read-only t) + (buffer-undo-list t) + (selected (selected-window)) + last-win + (str-length (length str))) + (save-selected-window + + (when (marker-buffer term-pending-delete-marker) + ;; Delete text following term-pending-delete-marker. + (delete-region term-pending-delete-marker (process-mark proc)) + (set-marker term-pending-delete-marker nil)) + + (when (/= (point) (process-mark proc)) + (setq save-point (point-marker))) + + (setf term-vertical-motion + (if (eq (window-buffer) (current-buffer)) + 'vertical-motion + 'term-buffer-vertical-motion)) + (setq save-marker (copy-marker (process-mark proc))) + (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. + (when (and (> (point-max) (process-mark proc)) + (term-in-line-mode)) + (narrow-to-region (point-min) (process-mark proc))) + + (when term-log-buffer + (princ str term-log-buffer)) + (when term-terminal-undecoded-bytes + (setq str (concat term-terminal-undecoded-bytes str)) + (setq str-length (length str)) + (setq term-terminal-undecoded-bytes nil)) + + (while (< i str-length) + (setq funny (string-match term-control-seq-regexp str i)) + (let ((ctl-params (and funny (match-string 1 str))) + (ctl-params-end (and funny (match-end 1))) + (ctl-end (if funny (match-end 0) + (setq funny (string-match term-control-seq-prefix-regexp str i)) + (if funny + (setq term-terminal-undecoded-bytes + (substring str funny)) + (setq funny str-length)) + ;; The control sequence ends somewhere + ;; past the end of this string. + (1+ str-length)))) + (when (> funny i) + (when term-do-line-wrapping + (term-down 1 t) + (term-move-to-column 0) + (setq term-do-line-wrapping nil)) + ;; Handle non-control data. Decode the string before + ;; counting characters, to avoid garbling of certain + ;; multibyte characters (bug#1006). + (setq decoded-substring + (decode-coding-string + (substring str i funny) + locale-coding-system t)) + ;; Check for multibyte characters that ends + ;; before end of string, and save it for + ;; next time. + (when (= funny str-length) + (let ((partial 0) + (count (length decoded-substring))) + (while (and (< partial count) + (eq (char-charset (aref decoded-substring + (- count 1 partial))) + 'eight-bit)) + (cl-incf partial)) + (when (> count partial 0) (setq term-terminal-undecoded-bytes - (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) + (substring decoded-substring (- partial))) + (setq decoded-substring + (substring decoded-substring 0 (- partial))) + (cl-decf str-length partial) + (cl-decf funny partial)))) + + ;; 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 (term-horizontal-column)) + (old-point (point)) + columns) + (unless term-suppress-hard-newline + (while (> (+ (length decoded-substring) old-column) + term-width) + (insert (substring decoded-substring 0 + (- term-width old-column))) + ;; Since we've enough text to fill the whole line, + ;; delete previous text regardless of + ;; `term-insert-mode's value. + (delete-region (point) (line-end-position)) + (term-down 1 t) + (term-move-columns (- (term-current-column))) + (add-text-properties (1- (point)) (point) + '(term-line-wrap t rear-nonsticky t)) + (setq decoded-substring + (substring decoded-substring (- term-width old-column))) + (setq old-column 0))) + (insert decoded-substring) + (setq term-current-column (current-column) + columns (- term-current-column old-column)) + (when (not (or (eobp) term-insert-mode)) + (let ((pos (point))) + (term-move-columns columns) + (delete-region pos (point)) + (setq term-current-column nil))) + ;; In insert mode if the current line + ;; has become too long it needs to be + ;; chopped off. + (when term-insert-mode + (let ((pos (point))) + (end-of-line) + (when (> (current-column) term-width) + (delete-region (- (point) (- (current-column) term-width)) + (point))) + (goto-char pos))) + + (put-text-property old-point (point) + 'font-lock-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. + (when (eq (term-current-column) term-width) + (term-move-columns -1) + ;; We check after ctrl sequence handling if point + ;; was moved (and leave line-wrapping state if so). + (setq term-do-line-wrapping (point))) + (setq term-current-column nil) + (setq i funny)) + (pcase-exhaustive (and (<= ctl-end str-length) (aref str i)) + (?\t ;; TAB (terminfo: ht) + ;; The line cannot exceed term-width. TAB at + ;; the end of a line should not cause wrapping. + (let ((col (term-current-column))) + (term-move-to-column + (min (1- term-width) + (+ col 8 (- (mod col 8))))))) + (?\r ;; (terminfo: cr) + (term-vertical-motion 0) + (setq term-current-column term-start-line-column)) + (?\n ;; (terminfo: cud1, ind) + (unless (and term-kill-echo-list + (term-check-kill-echo-list)) + (term-down 1 t))) + (?\b ;; (terminfo: cub1) + (term-move-columns -1)) + (?\C-g ;; (terminfo: bel) + (beep t)) + (?\032 ; Emacs specific control sequence. + (funcall term-command-function + (decode-coding-string + (substring str (1+ i) + (- ctl-end + (if (eq (aref str (- ctl-end 2)) ?\r) + 2 1))) + locale-coding-system t))) + (?\e + (pcase (aref str (1+ i)) + (?\[ + ;; We only handle control sequences with a single + ;; "Final" byte (see [ECMA-48] section 5.4). + (when (eq ctl-params-end (1- ctl-end)) + (term-handle-ansi-escape + proc + (mapcar ;; We don't distinguish empty params + ;; from 0 (according to [ECMA-48] we + ;; should, but all commands we support + ;; default to 0 values anyway). + #'string-to-number + (split-string ctl-params ";")) + (aref str (1- ctl-end))))) + (?D ;; Scroll forward (apparently not documented in + ;; [ECMA-48], [ctlseqs] mentions it as C1 + ;; character "Index" though). + (term-handle-deferred-scroll) + (term-down 1 t)) + (?M ;; Scroll reversed (terminfo: ri, ECMA-48 + ;; "Reverse Linefeed"). + (if (or (< (term-current-row) term-scroll-start) + (>= (1- (term-current-row)) + term-scroll-start)) + ;; Scrolling up will not move outside + ;; the scroll region. + (term-down -1) + ;; Scrolling the scroll region is needed. + (term-down -1 t))) + (?7 ;; Save cursor (terminfo: sc, not in [ECMA-48], + ;; [ctlseqs] has it as "DECSC"). + (term-handle-deferred-scroll) + (setq term-saved-cursor + (list (term-current-row) + (term-horizontal-column) + term-ansi-current-bg-color + term-ansi-current-bold + term-ansi-current-color + term-ansi-current-invisible + term-ansi-current-reverse + term-ansi-current-underline + term-current-face))) + (?8 ;; Restore cursor (terminfo: rc, [ctlseqs] + ;; "DECRC"). + (when term-saved-cursor + (term-goto (nth 0 term-saved-cursor) + (nth 1 term-saved-cursor)) + (setq term-ansi-current-bg-color + (nth 2 term-saved-cursor) + term-ansi-current-bold + (nth 3 term-saved-cursor) + term-ansi-current-color + (nth 4 term-saved-cursor) + term-ansi-current-invisible + (nth 5 term-saved-cursor) + term-ansi-current-reverse + (nth 6 term-saved-cursor) + term-ansi-current-underline + (nth 7 term-saved-cursor) + term-current-face + (nth 8 term-saved-cursor)))) + (?c ;; \Ec - Reset (terminfo: rs1, [ctlseqs] "RIS"). + ;; This is used by the "clear" program. + (term-reset-terminal)) + (?A ;; An \eAnSiT sequence (Emacs specific). + (term-handle-ansi-terminal-messages + (substring str i ctl-end))))) + ;; Ignore NUL, Shift Out, Shift In. + ((or ?\0 #xE #xF 'nil) nil)) + ;; Leave line-wrapping state if point was moved. + (unless (eq term-do-line-wrapping (point)) + (setq term-do-line-wrapping nil)) + (if (term-handling-pager) + (progn + ;; Finish stuff to get ready to handle PAGER. + (if (> (% (current-column) term-width) 0) (setq term-terminal-undecoded-bytes - (concat "\r" (substring str i))) - (setq term-terminal-undecoded-bytes (substring str (1- i))) - (aset term-terminal-undecoded-bytes 0 ?\r)) - (goto-char (point-max))) - ;; FIXME: Use (add-function :override (process-filter proc) - (setq-local term-pager-old-filter (process-filter proc)) - ;; FIXME: Where is `term-pager-filter' set to a function?! - (set-process-filter proc term-pager-filter) - (setq i str-length)) - (setq i ctl-end))))) - - (when (>= (term-current-row) term-height) - (term-handle-deferred-scroll)) - - (set-marker (process-mark proc) (point)) - (when (stringp decoded-substring) - (term-watch-for-password-prompt decoded-substring)) - (when save-point - (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. - (when (and term-pending-frame - (eq (window-buffer selected) (current-buffer))) - (term-display-line (car term-pending-frame) - (cdr term-pending-frame)) - (setq term-pending-frame nil)) - - ;; 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)) - (when (eq (window-buffer win) (process-buffer proc)) - (let ((scroll term-scroll-to-bottom-on-output)) - (select-window win) - (when (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)))) - (when term-scroll-snap-to-bottom - (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. - (when (and term-scroll-show-maximum-output - (>= (point) (process-mark proc)) - (or term-scroll-snap-to-bottom - (not (pos-visible-in-window-p - (point-max) win)))) - (save-excursion - (goto-char (point-max)) - (recenter -1))))) - (not (eq win last-win)))) - - ;; Stolen from comint.el and adapted -mm - (when (> 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))) - ;; This might be expensive, but we need it to handle something - ;; like `sleep 5 | less -c' in more-or-less real time. - (when (get-buffer-window (current-buffer)) - (redisplay)))) + (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-undecoded-bytes + (concat "\r" (substring str i))) + (setq term-terminal-undecoded-bytes (substring str (1- i))) + (aset term-terminal-undecoded-bytes 0 ?\r)) + (goto-char (point-max))) + ;; FIXME: Use (add-function :override (process-filter proc) + (setq-local term-pager-old-filter (process-filter proc)) + ;; FIXME: Where is `term-pager-filter' set to a function?! + (set-process-filter proc term-pager-filter) + (setq i str-length)) + (setq i ctl-end))))) + + (when (>= (term-current-row) term-height) + (term-handle-deferred-scroll)) + + (set-marker (process-mark proc) (point)) + (when (stringp decoded-substring) + (term-watch-for-password-prompt decoded-substring)) + (when save-point + (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. + (when (and term-pending-frame + (eq (window-buffer selected) (current-buffer))) + (term-display-line (car term-pending-frame) + (cdr term-pending-frame)) + (setq term-pending-frame nil)) + + ;; 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)) + (when (eq (window-buffer win) (process-buffer proc)) + (let ((scroll term-scroll-to-bottom-on-output)) + (select-window win) + (when (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)))) + (when term-scroll-snap-to-bottom + (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. + (when (and term-scroll-show-maximum-output + (>= (point) (process-mark proc)) + (or term-scroll-snap-to-bottom + (not (pos-visible-in-window-p + (point-max) win)))) + (save-excursion + (goto-char (point-max)) + (recenter -1))))) + (not (eq win last-win)))) + + ;; Stolen from comint.el and adapted -mm + (when (> 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))) + ;; This might be expensive, but we need it to handle something + ;; like `sleep 5 | less -c' in more-or-less real time. + (when (get-buffer-window (current-buffer)) + (redisplay))))) (defvar-local term-goto-process-mark t "Whether to reset point to the current process mark after this command. -- 2.39.2