diff options
Diffstat (limited to 'lisp/term.el')
| -rw-r--r-- | lisp/term.el | 836 |
1 files changed, 375 insertions, 461 deletions
diff --git a/lisp/term.el b/lisp/term.el index cbef68dc0ac..586a887a29f 100644 --- a/lisp/term.el +++ b/lisp/term.el @@ -1,4 +1,4 @@ -;;; term.el --- general command interpreter in a window stuff +;;; term.el --- general command interpreter in a window stuff -*- lexical-binding: t -*- ;; Copyright (C) 1988, 1990, 1992, 1994-1995, 2001-2019 Free Software ;; Foundation, Inc. @@ -101,12 +101,8 @@ ;; ---------------------------------------- ;; ;; -;; ANSI colorization should work well, I've decided to limit the interpreter -;; to five outstanding commands (like ESC [ 01;04;32;41;07m. -;; You shouldn't need more, if you do, tell me and I'll increase it. It's -;; so easy you could do it yourself... -;; -;; Blink, is not supported. Currently it's mapped as bold. +;; ANSI colorization should work well. Blink, is not supported. +;; Currently it's mapped as bold. ;; ;; ---------------------------------------- ;; @@ -288,17 +284,6 @@ ;; 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.). - -;; 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. - ;; Brief Command Documentation: ;;============================================================================ @@ -396,28 +381,23 @@ contains saved term-home-marker from original sub-buffer.") "Current vertical row (relative to home-marker) or nil if unknown.") (defvar term-insert-mode nil) (defvar term-vertical-motion) -(defvar term-terminal-state 0 - "State of the terminal emulator: -state 0: Normal state -state 1: Last character was a graphic in the last column. +(defvar term-do-line-wrapping nil + "Last character was a graphic in the last column. If next char is graphic, first move one column right \(and line warp) before displaying it. -This emulates (more or less) the behavior of xterm. -state 2: seen ESC -state 3: seen ESC [ (or ESC [ ?) -state 4: term-terminal-parameter contains pending output.") +This emulates (more or less) the behavior of xterm.") (defvar term-kill-echo-list nil "A queue of strings whose echo we want suppressed.") -(defvar term-terminal-parameter) (defvar term-terminal-undecoded-bytes nil) -(defvar term-terminal-previous-parameter) (defvar term-current-face 'term) (defvar term-scroll-start 0 "Top-most line (inclusive) of scrolling region.") (defvar term-scroll-end) ; Number of line (zero-based) after scrolling region. (defvar term-pager-count nil "Number of lines before we need to page; if nil, paging is disabled.") (defvar term-saved-cursor nil) -(defvar term-command-hook) +(define-obsolete-variable-alias 'term-command-hook + 'term-command-function "27.1") +(defvar term-command-function #'term-command-hook) (defvar term-log-buffer nil) (defvar term-scroll-with-delete nil "If t, forward scrolling should be implemented by delete to @@ -556,6 +536,8 @@ This means text can automatically reflow if the window is resized." :version "24.4" :type 'boolean :group 'term) +(make-obsolete-variable 'term-suppress-hard-newline nil + "27.1") ;; Where gud-display-frame should put the debugging arrow. This is ;; set by the marker-filter, which scans the debugger's output for @@ -590,16 +572,13 @@ These functions get one argument, a string containing the text to send. This variable is buffer-local.") -(defvar term-input-sender (function term-simple-send) +(defvar term-input-sender #'term-simple-send "Function to actually send to PROCESS the STRING submitted by user. Usually this is just `term-simple-send', but if your mode needs to massage the input string, this is your hook. This is called from the user command `term-send-input'. `term-simple-send' just sends the string plus a newline.") -(defvar term-partial-ansi-terminal-message nil - "Keep partial ansi terminal messages for future processing.") - (defcustom term-eol-on-send t "Non-nil means go to the end of the line before sending input. See `term-send-input'." @@ -757,12 +736,6 @@ Buffer local variable.") (defvar term-ansi-current-reverse nil) (defvar term-ansi-current-invisible nil) -;; Four should be enough, if you want more, just add. -mm -(defvar term-terminal-more-parameters 0) -(defvar term-terminal-previous-parameter-2 -1) -(defvar term-terminal-previous-parameter-3 -1) -(defvar term-terminal-previous-parameter-4 -1) - ;;; Faces (defvar ansi-term-color-vector [term @@ -1056,8 +1029,6 @@ Entry to this mode runs the hooks on `term-mode-hook'." (set (make-local-variable 'term-last-input-start) (make-marker)) (set (make-local-variable 'term-last-input-end) (make-marker)) (set (make-local-variable 'term-last-input-match) "") - (set (make-local-variable 'term-command-hook) - (symbol-function 'term-command-hook)) ;; These local variables are set to their local values: (make-local-variable 'term-saved-home-marker) @@ -1084,8 +1055,6 @@ Entry to this mode runs the hooks on `term-mode-hook'." (make-local-variable 'ange-ftp-default-password) (make-local-variable 'ange-ftp-generate-anonymous-password) - (make-local-variable 'term-partial-ansi-terminal-message) - ;; You may want to have different scroll-back sizes -mm (make-local-variable 'term-buffer-maximum-size) @@ -1098,15 +1067,9 @@ Entry to this mode runs the hooks on `term-mode-hook'." (make-local-variable 'term-ansi-current-reverse) (make-local-variable 'term-ansi-current-invisible) - (make-local-variable 'term-terminal-parameter) (make-local-variable 'term-terminal-undecoded-bytes) - (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) - (make-local-variable 'term-terminal-state) + (make-local-variable 'term-do-line-wrapping) (make-local-variable 'term-kill-echo-list) (make-local-variable 'term-start-line-column) (make-local-variable 'term-current-column) @@ -1119,21 +1082,18 @@ Entry to this mode runs the hooks on `term-mode-hook'." (make-local-variable 'term-pager-old-local-map) (make-local-variable 'term-old-mode-map) (make-local-variable 'term-insert-mode) - (make-local-variable 'term-dynamic-complete-functions) (make-local-variable 'term-completion-fignore) (make-local-variable 'term-get-old-input) (make-local-variable 'term-matching-input-from-input-string) (make-local-variable 'term-input-autoexpand) (make-local-variable 'term-input-ignoredups) (make-local-variable 'term-delimiter-argument-list) - (make-local-variable 'term-input-filter-functions) (make-local-variable 'term-input-filter) (make-local-variable 'term-input-sender) (make-local-variable 'term-eol-on-send) (make-local-variable 'term-scroll-to-bottom-on-output) (make-local-variable 'term-scroll-show-maximum-output) (make-local-variable 'term-ptyp) - (make-local-variable 'term-exec-hook) (set (make-local-variable 'term-vertical-motion) 'vertical-motion) (set (make-local-variable 'term-pending-delete-marker) (make-marker)) (make-local-variable 'term-current-face) @@ -1145,6 +1105,9 @@ Entry to this mode runs the hooks on `term-mode-hook'." (set (make-local-variable 'font-lock-defaults) '(nil t)) (add-function :filter-return + (local 'filter-buffer-substring-function) + #'term--filter-buffer-substring) + (add-function :filter-return (local 'window-adjust-process-window-size-function) (lambda (size) (when size @@ -1160,9 +1123,51 @@ Entry to this mode runs the hooks on `term-mode-hook'." (setq term-input-ring (make-ring term-input-ring-size))) (term-update-mode-line)) +(defun term--remove-fake-newlines () + (goto-char (point-min)) + (let (fake-newline) + (while (setq fake-newline (next-single-property-change (point) + 'term-line-wrap)) + (goto-char fake-newline) + (cl-assert (eq ?\n (char-after))) + (let ((inhibit-read-only t)) + (delete-char 1))))) + +(defun term--filter-buffer-substring (content) + (with-temp-buffer + (insert content) + (term--remove-fake-newlines) + (buffer-string))) + +(defun term--unwrap-visible-long-lines (width) + ;; Unwrap lines longer than width using fake newlines. Only do it + ;; for lines that are currently visible (i.e. following the home + ;; marker). Invisible lines don't have to be unwrapped since they + ;; are unreachable using the cursor movement anyway. Not having to + ;; unwrap the entire buffer means the runtime of this function is + ;; bounded by the size of the screen instead of the buffer size. + + (save-excursion + ;; We will just assume that our accounting for the home marker is + ;; correct, i.e. programs will not try to reach any position + ;; earlier than this marker. + (goto-char term-home-marker) + + (move-to-column width) + (while (not (eobp)) + (if (eolp) + (forward-char) + (let ((inhibit-read-only t)) + (term-unwrap-line))) + (move-to-column width)))) + (defun term-reset-size (height width) (when (or (/= height term-height) (/= width term-width)) + ;; Delete all newlines used for wrapping + (when (/= width term-width) + (save-excursion + (term--remove-fake-newlines))) (let ((point (point))) (setq term-height height) (setq term-width width) @@ -1175,7 +1180,8 @@ Entry to this mode runs the hooks on `term-mode-hook'." (setq term-start-line-column nil) (setq term-current-row nil) (setq term-current-column nil) - (goto-char point)))) + (goto-char point)) + (term--unwrap-visible-long-lines width))) ;; Recursive routine used to check if any string in term-kill-echo-list ;; matches part of the buffer before point. @@ -1308,16 +1314,14 @@ intervention from Emacs, except for the escape character (usually C-c)." (add-hook 'post-command-hook #'term-goto-process-mark-maybe nil t) ;; Send existing partial line to inferior (without newline). - (let ((pmark (process-mark (get-buffer-process (current-buffer)))) - (save-input-sender term-input-sender)) + (let ((pmark (process-mark (get-buffer-process (current-buffer))))) (when (> (point) pmark) (unwind-protect (progn - (setq term-input-sender - (symbol-function 'term-send-string)) + (add-function :override term-input-sender #'term-send-string) (end-of-line) (term-send-input)) - (setq term-input-sender save-input-sender)))) + (remove-function term-input-sender #'term-send-string)))) (term-update-mode-line))) (defun term-line-mode () @@ -1447,8 +1451,8 @@ buffer. The hook `term-exec-hook' is run after each exec." ;; Jump to the end, and set the process mark. (goto-char (point-max)) (set-marker (process-mark proc) (point)) - (set-process-filter proc 'term-emulate-terminal) - (set-process-sentinel proc 'term-sentinel) + (set-process-filter proc #'term-emulate-terminal) + (set-process-sentinel proc #'term-sentinel) ;; Feed it the startfile. (when startfile ;;This is guaranteed to wait long enough @@ -1577,7 +1581,7 @@ Nil if unknown.") (when (term--bash-needs-EMACSp) (push (format "EMACS=%s (term:%s)" emacs-version term-protocol-version) process-environment)) - (apply 'start-process name buffer + (apply #'start-process name buffer "/bin/sh" "-c" (format "stty -nl echo rows %d columns %d sane 2>/dev/null;\ if [ $1 = .. ]; then shift; fi; exec \"$@\"" @@ -1980,8 +1984,8 @@ A useful command to bind to SPC. See `term-replace-by-expanded-history'." (defun term-within-quotes (beg end) "Return t if the number of quotes between BEG and END is odd. Quotes are single and double." - (let ((countsq (term-how-many-region "\\(^\\|[^\\\\]\\)'" beg end)) - (countdq (term-how-many-region "\\(^\\|[^\\\\]\\)\"" beg end))) + (let ((countsq (term-how-many-region "\\(^\\|[^\\]\\)'" beg end)) + (countdq (term-how-many-region "\\(^\\|[^\\]\\)\"" beg end))) (or (= (mod countsq 2) 1) (= (mod countdq 2) 1)))) (defun term-how-many-region (regexp beg end) @@ -2071,7 +2075,7 @@ Argument 0 is the command name." (let ((n (or nth (1- count))) (m (if mth (1- (- count mth)) 0))) (mapconcat - (function (lambda (a) a)) (nthcdr n (nreverse (nthcdr m args))) " ")))) + #'identity (nthcdr n (nreverse (nthcdr m args))) " ")))) ;;; ;;; Input processing stuff [line mode] @@ -2151,10 +2155,7 @@ Similarly for Soar, Scheme, etc." (not (string-equal (ring-ref term-input-ring 0) history)))) (ring-insert term-input-ring history)) - (let ((functions term-input-filter-functions)) - (while functions - (funcall (car functions) (concat input "\n")) - (setq functions (cdr functions)))) + (run-hook-with-args 'term-input-filter-functions (concat input "\n")) (setq term-input-ring-index nil) ;; Update the markers before we send the input @@ -2244,6 +2245,7 @@ filter and C-g is pressed, this function returns nil rather than a string). Note that the keystrokes comprising the text can still be recovered \(temporarily) with \\[view-lossage]. This may be a security bug for some applications." + (declare (obsolete read-passwd "27.1")) (let ((ans "") (c 0) (echo-keystrokes 0) @@ -2703,10 +2705,8 @@ See `term-prompt-regexp'." (cond (term-current-column) ((setq term-current-column (current-column))))) -;; Move DELTA column right (or left if delta < 0 limiting at column 0). - -(defun term-move-columns (delta) - (setq term-current-column (max 0 (+ (term-current-column) delta))) +(defun term-move-to-column (column) + (setq term-current-column column) (let ((point-at-eol (line-end-position))) (move-to-column term-current-column t) ;; If move-to-column extends the current line it will use the face @@ -2715,6 +2715,11 @@ See `term-prompt-regexp'." (when (> (point) point-at-eol) (put-text-property point-at-eol (point) 'font-lock-face 'default)))) +;; Move DELTA column right (or left if delta < 0 limiting at column 0). +(defun term-move-columns (delta) + (term-move-to-column + (max 0 (+ (term-current-column) delta)))) + ;; Insert COUNT copies of CHAR in the default face. (defun term-insert-char (char count) (let ((old-point (point))) @@ -2747,11 +2752,6 @@ See `term-prompt-regexp'." ;;difference ;-) -mm (defun term-handle-ansi-terminal-messages (message) - ;; Handle stored partial message - (when term-partial-ansi-terminal-message - (setq message (concat term-partial-ansi-terminal-message message)) - (setq term-partial-ansi-terminal-message nil)) - ;; Is there a command here? (while (string-match "\eAnSiT.+\n" message) ;; Extract the command code and the argument. @@ -2802,11 +2802,6 @@ See `term-prompt-regexp'." (setq ange-ftp-default-user nil) (setq ange-ftp-default-password nil) (setq ange-ftp-generate-anonymous-password nil))))) - ;; If there is a partial message at the end of the string, store it - ;; for future use. - (when (string-match "\eAnSiT.+$" message) - (setq term-partial-ansi-terminal-message (match-string 0 message)) - (setq message (replace-match "" t t message))) message) @@ -2814,27 +2809,42 @@ See `term-prompt-regexp'." ;; This is the standard process filter for term buffers. ;; It emulates (most of the features of) a VT100/ANSI-style terminal. +;; References: +;; [ctlseqs]: http://invisible-island.net/xterm/ctlseqs/ctlseqs.html +;; [ECMA-48]: http://www.ecma-international.org/publications/standards/Ecma-048.htm +;; [vt100]: https://vt100.net/docs/vt100-ug/chapter3.html + +(defconst term-control-seq-regexp + (concat + ;; A control character, + "\\(?:[\r\n\000\007\t\b\016\017]\\|" + ;; some Emacs specific control sequences, implemented by + ;; `term-command-hook', + "\032[^\n]+\r?\n\\|" + ;; a C1 escape coded character (see [ECMA-48] section 5.3 "Elements + ;; of the C1 set"), + "\e\\(?:[DM78c]\\|" + ;; another Emacs specific control sequence, + "AnSiT[^\n]+\r?\n\\|" + ;; or an escape sequence (section 5.4 "Control Sequences"), + "\\[\\([\x30-\x3F]*\\)[\x20-\x2F]*[\x40-\x7E]\\)\\)") + "Regexp matching control sequences handled by term.el.") + +(defconst term-control-seq-prefix-regexp + "[\032\e]") + (defun term-emulate-terminal (proc str) (with-current-buffer (process-buffer proc) - (let* ((i 0) char funny - count ; number of decoded chars in substring - count-bytes ; number of bytes + (let* ((i 0) funny decoded-substring - save-point save-marker old-point temp win + save-point save-marker win (inhibit-read-only t) (buffer-undo-list t) (selected (selected-window)) last-win - handled-ansi-message (str-length (length str))) (save-selected-window - (let ((newstr (term-handle-ansi-terminal-messages str))) - (unless (eq str newstr) - (setq handled-ansi-message t - str newstr))) - (setq str-length (length str)) - (when (marker-buffer term-pending-delete-marker) ;; Delete text following term-pending-delete-marker. (delete-region term-pending-delete-marker (process-mark proc)) @@ -2864,298 +2874,223 @@ See `term-prompt-regexp'." (setq str (concat term-terminal-undecoded-bytes str)) (setq str-length (length str)) (setq term-terminal-undecoded-bytes nil)) - (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)) - (when (not funny) (setq funny str-length)) - (cond ((> funny i) - (cond ((eq term-terminal-state 1) - ;; We are in state 1, we need to wrap - ;; around. Go to the beginning of - ;; the next line and switch to state - ;; 0. - (term-down 1 t) - (term-move-columns (- (term-current-column))) - (setq term-terminal-state 0))) - ;; 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)) - (setq count (length decoded-substring)) - ;; Check for multibyte characters that ends - ;; before end of string, and save it for - ;; next time. - (when (= funny str-length) - (let ((partial 0)) - (while (eq (char-charset (aref decoded-substring - (- count 1 partial))) - 'eight-bit) - (cl-incf partial)) - (when (> 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 count partial) - (cl-decf funny partial)))) - (setq temp (- (+ (term-horizontal-column) count) - term-width)) - (cond ((or term-suppress-hard-newline (<= temp 0))) - ;; All count chars fit in line. - ((> count temp) ;; Some chars fit. - ;; This iteration, handle only what fits. - (setq count (- count temp)) - (setq count-bytes - (length - (encode-coding-string - (substring decoded-substring 0 count) - 'binary))) - (setq temp 0) - (setq funny (+ count-bytes 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 count-bytes - (length - (encode-coding-string - (substring decoded-substring 0 count) - 'binary))) - (setq funny (+ count-bytes 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 (decode-coding-string (substring str i funny) locale-coding-system)) - (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))) - ;; In insert mode if the current line - ;; has become too long it needs to be - ;; chopped off. - (when term-insert-mode - (setq pos (point)) - (end-of-line) - (when (> (current-column) term-width) - (delete-region (- (point) (- (current-column) term-width)) - (point))) - (goto-char pos))) - (setq term-current-column nil) - - (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. - (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 (terminfo: ht) - (setq count (term-current-column)) - ;; The line cannot exceed term-width. TAB at - ;; the end of a line should not cause wrapping. - (setq count (min term-width - (+ count 8 (- (mod count 8))))) - (if (> term-width count) - (progn - (term-move-columns - (- count (term-current-column))) - (setq term-current-column count)) - (when (> term-width (term-current-column)) - (term-move-columns - (1- (- term-width (term-current-column))))) - (when (= term-width (term-current-column)) - (term-move-columns -1)))) - ((eq char ?\r) ;; (terminfo: cr) - (term-vertical-motion 0) - (setq term-current-column term-start-line-column)) - ((eq char ?\n) ;; (terminfo: cud1, ind) - (unless (and term-kill-echo-list - (term-check-kill-echo-list)) - (term-down 1 t))) - ((eq char ?\b) ;; (terminfo: cub1) - (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) ;; (terminfo: bel) - (beep t)) - ((eq char ?\032) - (let ((end (string-match "\r?\n" str i))) - (if end - (progn - (unless handled-ansi-message - (funcall term-command-hook - (decode-coding-string - (substring str (1+ i) end) - locale-coding-system))) - (setq i (1- (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 - - (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 ?E) ;; (terminfo: nw), not used for - ;; ;; now, but this is a working - ;; ;; implementation - ;; (term-down 1) - ;; (term-goto term-current-row 0) - ;; (setq term-terminal-state 0)) - ((eq char ?M) ;; scroll reversed (terminfo: ri) - (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)) - (setq term-terminal-state 0)) - ((eq char ?7) ;; Save cursor (terminfo: sc) - (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) - ) - (setq term-terminal-state 0)) - ((eq char ?8) ;; Restore cursor (terminfo: rc) - (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))) - (setq term-terminal-state 0)) - ((eq char ?c) ;; \Ec - Reset (terminfo: rs1) - ;; This is used by the "clear" program. - (setq term-terminal-state 0) - (term-reset-terminal)) - ;; The \E#8 reset sequence for xterm. We - ;; probably don't need to handle it, but this - ;; is the code to parse it. - ;; ((eq char ?#) - ;; (when (eq (aref str (1+ i)) ?8) - ;; (setq i (1+ i)) - ;; (setq term-scroll-start 0) - ;; (setq term-scroll-end term-height) - ;; (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))))) - (when (term-handling-pager) - ;; Finish stuff to get ready to handle PAGER. - (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 - (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)))) + + (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 (eq (char-charset (aref decoded-substring + (- count 1 partial))) + 'eight-bit) + (cl-incf partial)) + (when (> 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))) + (put-text-property (1- (point)) (point) 'term-line-wrap 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 + (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) + (make-local-variable 'term-pager-old-filter) + (setq 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)) @@ -3388,86 +3323,81 @@ option is enabled. See `term-set-goto-process-mark'." ;; Handle a character assuming (eq terminal-state 2) - ;; i.e. we have previously seen Escape followed by ?[. -(defun term-handle-ansi-escape (proc char) +(defun term-handle-ansi-escape (proc params char) (cond ((or (eq char ?H) ;; cursor motion (terminfo: cup,home) ;; (eq char ?f) ;; xterm seems to handle this sequence too, not ;; needed for now ) - (when (<= term-terminal-parameter 0) - (setq term-terminal-parameter 1)) - (when (<= term-terminal-previous-parameter 0) - (setq term-terminal-previous-parameter 1)) - (when (> term-terminal-previous-parameter term-height) - (setq term-terminal-previous-parameter term-height)) - (when (> term-terminal-parameter term-width) - (setq term-terminal-parameter term-width)) (term-goto - (1- term-terminal-previous-parameter) - (1- term-terminal-parameter))) + (1- (max 1 (min (or (nth 0 params) 0) term-height))) + (1- (max 1 (min (or (nth 1 params) 0) term-width))))) ;; \E[A - cursor up (terminfo: cuu, cuu1) ((eq char ?A) (term-handle-deferred-scroll) - (let ((tcr (term-current-row))) + (let ((tcr (term-current-row)) + (scroll-amount (car params))) (term-down - (if (< (- tcr term-terminal-parameter) term-scroll-start) + (if (< (- tcr scroll-amount) term-scroll-start) ;; If the amount to move is before scroll start, move ;; to scroll start. (- term-scroll-start tcr) - (if (>= term-terminal-parameter tcr) + (if (>= scroll-amount tcr) (- tcr) - (- (max 1 term-terminal-parameter)))) t))) + (- (max 1 scroll-amount)))) + t))) ;; \E[B - cursor down (terminfo: cud) ((eq char ?B) - (let ((tcr (term-current-row))) + (let ((tcr (term-current-row)) + (scroll-amount (car params))) (unless (>= tcr term-scroll-end) (term-down - (min (- term-scroll-end tcr) (max 1 term-terminal-parameter)) + (min (- term-scroll-end tcr) (max 1 scroll-amount)) t)))) ;; \E[C - cursor right (terminfo: cuf, cuf1) ((eq char ?C) (term-move-columns (max 1 - (if (>= (+ term-terminal-parameter (term-current-column)) term-width) + (if (>= (+ (car params) (term-current-column)) term-width) (- term-width (term-current-column) 1) - term-terminal-parameter)))) + (car params))))) ;; \E[D - cursor left (terminfo: cub) ((eq char ?D) - (term-move-columns (- (max 1 term-terminal-parameter)))) + (term-move-columns (- (max 1 (car params))))) ;; \E[G - cursor motion to absolute column (terminfo: hpa) ((eq char ?G) - (term-move-columns (- (max 0 (min term-width term-terminal-parameter)) + (term-move-columns (- (max 0 (min term-width (car params))) (term-current-column)))) ;; \E[J - clear to end of screen (terminfo: ed, clear) ((eq char ?J) - (term-erase-in-display term-terminal-parameter)) + (term-erase-in-display (car params))) ;; \E[K - clear to end of line (terminfo: el, el1) ((eq char ?K) - (term-erase-in-line term-terminal-parameter)) + (term-erase-in-line (car params))) ;; \E[L - insert lines (terminfo: il, il1) ((eq char ?L) - (term-insert-lines (max 1 term-terminal-parameter))) + (term-insert-lines (max 1 (car params)))) ;; \E[M - delete lines (terminfo: dl, dl1) ((eq char ?M) - (term-delete-lines (max 1 term-terminal-parameter))) + (term-delete-lines (max 1 (car params)))) ;; \E[P - delete chars (terminfo: dch, dch1) ((eq char ?P) - (term-delete-chars (max 1 term-terminal-parameter))) + (term-delete-chars (max 1 (car params)))) ;; \E[@ - insert spaces (terminfo: ich) ((eq char ?@) - (term-insert-spaces (max 1 term-terminal-parameter))) + (term-insert-spaces (max 1 (car params)))) ;; \E[?h - DEC Private Mode Set ((eq char ?h) - (cond ((eq term-terminal-parameter 4) ;; (terminfo: smir) + (cond ((eq (car params) 4) ;; (terminfo: smir) (setq term-insert-mode t)) - ;; ((eq term-terminal-parameter 47) ;; (terminfo: smcup) + ;; ((eq (car params) 47) ;; (terminfo: smcup) ;; (term-switch-to-alternate-sub-buffer t)) )) ;; \E[?l - DEC Private Mode Reset ((eq char ?l) - (cond ((eq term-terminal-parameter 4) ;; (terminfo: rmir) + (cond ((eq (car params) 4) ;; (terminfo: rmir) (setq term-insert-mode nil)) - ;; ((eq term-terminal-parameter 47) ;; (terminfo: rmcup) + ;; ((eq (car params) 47) ;; (terminfo: rmcup) ;; (term-switch-to-alternate-sub-buffer nil)) )) @@ -3475,15 +3405,7 @@ option is enabled. See `term-set-goto-process-mark'." ;; \E[m - Set/reset modes, set bg/fg ;;(terminfo: smso,rmso,smul,rmul,rev,bold,sgr0,invis,op,setab,setaf) ((eq char ?m) - (when (= term-terminal-more-parameters 1) - (when (>= term-terminal-previous-parameter-4 0) - (term-handle-colors-array term-terminal-previous-parameter-4)) - (when (>= term-terminal-previous-parameter-3 0) - (term-handle-colors-array term-terminal-previous-parameter-3)) - (when (>= term-terminal-previous-parameter-2 0) - (term-handle-colors-array term-terminal-previous-parameter-2)) - (term-handle-colors-array term-terminal-previous-parameter)) - (term-handle-colors-array term-terminal-parameter)) + (mapc #'term-handle-colors-array params)) ;; \E[6n - Report cursor position (terminfo: u7) ((eq char ?n) @@ -3496,8 +3418,8 @@ option is enabled. See `term-set-goto-process-mark'." ;; \E[r - Set scrolling region (terminfo: csr) ((eq char ?r) (term-set-scroll-region - (1- term-terminal-previous-parameter) - (1- term-terminal-parameter))) + (1- (or (nth 0 params) 0)) + (1- (or (nth 1 params) 0)))) (t))) (defun term-set-scroll-region (top bottom) @@ -3547,7 +3469,7 @@ The top-most line is line 0." ;; (setq term-current-row 0) ;; (term-goto row col)))) -;; Default value for the symbol term-command-hook. +;; Default value for the symbol term-command-function. (defun term-command-hook (string) (cond ((equal string "") @@ -3685,7 +3607,7 @@ The top-most line is line 0." (defun term-pager-discard () (interactive) - (setq term-terminal-parameter "") + (setq term-terminal-undecoded-bytes "") (interrupt-process nil t) (term-pager-continue term-height)) @@ -3829,7 +3751,10 @@ all pending output has been dealt with.")) ;; if the line above point wraps around, add a ?\n to undo the wrapping. ;; FIXME: Probably should be called more than it is. (defun term-unwrap-line () - (when (not (bolp)) (insert-before-markers ?\n))) + (when (not (bolp)) + (let ((old-point (point))) + (insert-before-markers ?\n) + (put-text-property old-point (point) 'term-line-wrap t)))) (defun term-erase-in-line (kind) (when (= kind 1) ;; erase left of point @@ -3863,7 +3788,7 @@ all pending output has been dealt with.")) 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." (term-handle-deferred-scroll) - (cond ((eq term-terminal-parameter 0) + (cond ((eq kind 0) (let ((need-unwrap (bolp))) (delete-region (point) (point-max)) (when need-unwrap (term-unwrap-line)))) @@ -4098,9 +4023,7 @@ Calls the functions in `term-dynamic-complete-functions' to perform completion until a function returns non-nil, at which point completion is assumed to have occurred." (interactive) - (let ((functions term-dynamic-complete-functions)) - (while (and functions (null (funcall (car functions)))) - (setq functions (cdr functions))))) + (run-hook-with-args-until-success 'term-dynamic-complete-functions)) (defun term-dynamic-complete-filename () @@ -4200,7 +4123,6 @@ Returns `listed' if a completion listing was shown. See also `term-dynamic-complete-filename'." (declare (obsolete completion-in-region "23.2")) (let* ((completion-ignore-case nil) - (candidates (mapcar (function (lambda (x) (list x))) candidates)) (completions (all-completions stub candidates))) (cond ((null completions) (message "No completions of %s" stub) @@ -4425,9 +4347,9 @@ well as the newer ports COM10 and higher." (setq serial-name-history file-name-history)) (when (or (null x) (and (stringp x) (zerop (length x)))) (error "No serial port selected")) - (when (and (not (serial-port-is-file-p)) - (not (string-match "\\\\" x))) - (set 'x (concat "\\\\.\\" x))) + (when (not (or (serial-port-is-file-p) + (string-match "\\\\" x))) + (setq x (concat "\\\\.\\" x))) x)) (defun serial-read-speed () @@ -4481,8 +4403,8 @@ use in that buffer. (term-char-mode) (goto-char (point-max)) (set-marker (process-mark process) (point)) - (set-process-filter process 'term-emulate-terminal) - (set-process-sentinel process 'term-sentinel)) + (set-process-filter process #'term-emulate-terminal) + (set-process-sentinel process #'term-sentinel)) (switch-to-buffer buffer) buffer)) @@ -4619,27 +4541,19 @@ The return value may be nil for a special serial port." ;; term-mode will take care of it. The following example, from shell.el, ;; is typical: ;; -;; (defvar shell-mode-map '()) -;; (cond ((not shell-mode-map) -;; (setq shell-mode-map (copy-keymap term-mode-map)) -;; (define-key shell-mode-map "\C-c\C-f" 'shell-forward-command) -;; (define-key shell-mode-map "\C-c\C-b" 'shell-backward-command) -;; (define-key shell-mode-map "\t" 'term-dynamic-complete) -;; (define-key shell-mode-map "\M-?" -;; 'term-dynamic-list-filename-completions))) -;; -;; (defun shell-mode () -;; (interactive) -;; (term-mode) -;; (setq term-prompt-regexp shell-prompt-pattern) -;; (setq major-mode 'shell-mode) -;; (setq mode-name "Shell") -;; (use-local-map shell-mode-map) -;; (make-local-variable 'shell-directory-stack) -;; (setq shell-directory-stack nil) -;; (add-hook 'term-input-filter-functions 'shell-directory-tracker) -;; (run-mode-hooks 'shell-mode-hook)) +;; (defvar shell-mode-map +;; (let ((map (make-sparse-keymap))) +;; (define-key map "\C-c\C-f" 'shell-forward-command) +;; (define-key map "\C-c\C-b" 'shell-backward-command) +;; (define-key map "\t" 'term-dynamic-complete) +;; (define-key map "\M-?" +;; 'term-dynamic-list-filename-completions))) ;; +;; (define-derived-mode shell-mode term-mode "Shell" +;; "A shell mode." +;; (setq-local term-prompt-regexp shell-prompt-pattern) +;; (setq-local shell-directory-stack nil) +;; (add-hook 'term-input-filter-functions #'shell-directory-tracker nil t)) ;; ;; Completion for term-mode users ;; |