aboutsummaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorNoam Postavsky2018-01-18 08:22:47 -0500
committerNoam Postavsky2018-01-18 22:25:35 -0500
commit47019a521f774fbd13441e178a6a82c9989b9912 (patch)
treeaa36a88fe09995b83b18ca615d7e7df78690fc27
parent256bd99a8bfae91a3c91ae20166af45918d1e986 (diff)
downloademacs-47019a521f774fbd13441e178a6a82c9989b9912.tar.gz
emacs-47019a521f774fbd13441e178a6a82c9989b9912.zip
Switch term.el to lexical binding, and clean up code a bit
* lisp/term.el (term-terminal-state): Remove. (term-do-line-wrapping): New variable, equivalent to state 1. (term-terminal-previous-parameter, term-terminal-parameter) (term-terminal-more-parameters) (term-terminal-previous-parameter-2) (term-terminal-previous-parameter-3) (term-terminal-previous-parameter-4): Remove. (term-move-to-column): New function, for absolute column movement. (term-control-seq-regexp, term-control-seq-prefix-regexp): New constants. (term-emulate-terminal, term-pager-discard): Use them via string-match instead of implementing a state machine in elisp. Handle all unprocessed input via term-terminal-undecoded-bytes (this solves Bug#17231). (term-handle-ansi-escape): Take a list of escape sequence parameters as an argument, rather than via dynamic variables. (term-erase-in-display): Consult the argument, not the dynamically bound term-terminal-parameter (which happened to be the same as the argument up until now).
Diffstat
-rw-r--r--lisp/term.el663
1 files changed, 281 insertions, 382 deletions
diff --git a/lisp/term.el b/lisp/term.el
index ca83b4f8dcf..1a373935c9d 100644
--- a/lisp/term.el
+++ b/lisp/term.el
@@ -1,4 +1,4 @@
1;;; term.el --- general command interpreter in a window stuff 1;;; term.el --- general command interpreter in a window stuff -*- lexical-binding: t -*-
2 2
3;; Copyright (C) 1988, 1990, 1992, 1994-1995, 2001-2018 Free Software 3;; Copyright (C) 1988, 1990, 1992, 1994-1995, 2001-2018 Free Software
4;; Foundation, Inc. 4;; Foundation, Inc.
@@ -101,12 +101,8 @@
101;; ---------------------------------------- 101;; ----------------------------------------
102;; 102;;
103;; 103;;
104;; ANSI colorization should work well, I've decided to limit the interpreter 104;; ANSI colorization should work well. Blink, is not supported.
105;; to five outstanding commands (like ESC [ 01;04;32;41;07m. 105;; Currently it's mapped as bold.
106;; You shouldn't need more, if you do, tell me and I'll increase it. It's
107;; so easy you could do it yourself...
108;;
109;; Blink, is not supported. Currently it's mapped as bold.
110;; 106;;
111;; ---------------------------------------- 107;; ----------------------------------------
112;; 108;;
@@ -392,21 +388,14 @@ contains saved term-home-marker from original sub-buffer.")
392 "Current vertical row (relative to home-marker) or nil if unknown.") 388 "Current vertical row (relative to home-marker) or nil if unknown.")
393(defvar term-insert-mode nil) 389(defvar term-insert-mode nil)
394(defvar term-vertical-motion) 390(defvar term-vertical-motion)
395(defvar term-terminal-state 0 391(defvar term-do-line-wrapping nil
396 "State of the terminal emulator: 392 "Last character was a graphic in the last column.
397state 0: Normal state
398state 1: Last character was a graphic in the last column.
399If next char is graphic, first move one column right 393If next char is graphic, first move one column right
400\(and line warp) before displaying it. 394\(and line warp) before displaying it.
401This emulates (more or less) the behavior of xterm. 395This emulates (more or less) the behavior of xterm.")
402state 2: seen ESC
403state 3: seen ESC [ (or ESC [ ?)
404state 4: term-terminal-parameter contains pending output.")
405(defvar term-kill-echo-list nil 396(defvar term-kill-echo-list nil
406 "A queue of strings whose echo we want suppressed.") 397 "A queue of strings whose echo we want suppressed.")
407(defvar term-terminal-parameter)
408(defvar term-terminal-undecoded-bytes nil) 398(defvar term-terminal-undecoded-bytes nil)
409(defvar term-terminal-previous-parameter)
410(defvar term-current-face 'term) 399(defvar term-current-face 'term)
411(defvar term-scroll-start 0 "Top-most line (inclusive) of scrolling region.") 400(defvar term-scroll-start 0 "Top-most line (inclusive) of scrolling region.")
412(defvar term-scroll-end) ; Number of line (zero-based) after scrolling region. 401(defvar term-scroll-end) ; Number of line (zero-based) after scrolling region.
@@ -750,12 +739,6 @@ Buffer local variable.")
750(defvar term-ansi-current-reverse nil) 739(defvar term-ansi-current-reverse nil)
751(defvar term-ansi-current-invisible nil) 740(defvar term-ansi-current-invisible nil)
752 741
753;; Four should be enough, if you want more, just add. -mm
754(defvar term-terminal-more-parameters 0)
755(defvar term-terminal-previous-parameter-2 -1)
756(defvar term-terminal-previous-parameter-3 -1)
757(defvar term-terminal-previous-parameter-4 -1)
758
759;;; Faces 742;;; Faces
760(defvar ansi-term-color-vector 743(defvar ansi-term-color-vector
761 [term 744 [term
@@ -1089,15 +1072,9 @@ Entry to this mode runs the hooks on `term-mode-hook'."
1089 (make-local-variable 'term-ansi-current-reverse) 1072 (make-local-variable 'term-ansi-current-reverse)
1090 (make-local-variable 'term-ansi-current-invisible) 1073 (make-local-variable 'term-ansi-current-invisible)
1091 1074
1092 (make-local-variable 'term-terminal-parameter)
1093 (make-local-variable 'term-terminal-undecoded-bytes) 1075 (make-local-variable 'term-terminal-undecoded-bytes)
1094 (make-local-variable 'term-terminal-previous-parameter)
1095 (make-local-variable 'term-terminal-previous-parameter-2)
1096 (make-local-variable 'term-terminal-previous-parameter-3)
1097 (make-local-variable 'term-terminal-previous-parameter-4)
1098 (make-local-variable 'term-terminal-more-parameters)
1099 1076
1100 (make-local-variable 'term-terminal-state) 1077 (make-local-variable 'term-do-line-wrapping)
1101 (make-local-variable 'term-kill-echo-list) 1078 (make-local-variable 'term-kill-echo-list)
1102 (make-local-variable 'term-start-line-column) 1079 (make-local-variable 'term-start-line-column)
1103 (make-local-variable 'term-current-column) 1080 (make-local-variable 'term-current-column)
@@ -2658,10 +2635,8 @@ See `term-prompt-regexp'."
2658 (cond (term-current-column) 2635 (cond (term-current-column)
2659 ((setq term-current-column (current-column))))) 2636 ((setq term-current-column (current-column)))))
2660 2637
2661;; Move DELTA column right (or left if delta < 0 limiting at column 0). 2638(defun term-move-to-column (column)
2662 2639 (setq term-current-column column)
2663(defun term-move-columns (delta)
2664 (setq term-current-column (max 0 (+ (term-current-column) delta)))
2665 (let ((point-at-eol (line-end-position))) 2640 (let ((point-at-eol (line-end-position)))
2666 (move-to-column term-current-column t) 2641 (move-to-column term-current-column t)
2667 ;; If move-to-column extends the current line it will use the face 2642 ;; If move-to-column extends the current line it will use the face
@@ -2670,6 +2645,11 @@ See `term-prompt-regexp'."
2670 (when (> (point) point-at-eol) 2645 (when (> (point) point-at-eol)
2671 (put-text-property point-at-eol (point) 'font-lock-face 'default)))) 2646 (put-text-property point-at-eol (point) 'font-lock-face 'default))))
2672 2647
2648;; Move DELTA column right (or left if delta < 0 limiting at column 0).
2649(defun term-move-columns (delta)
2650 (term-move-to-column
2651 (max 0 (+ (term-current-column) delta))))
2652
2673;; Insert COUNT copies of CHAR in the default face. 2653;; Insert COUNT copies of CHAR in the default face.
2674(defun term-insert-char (char count) 2654(defun term-insert-char (char count)
2675 (let ((old-point (point))) 2655 (let ((old-point (point)))
@@ -2761,27 +2741,42 @@ See `term-prompt-regexp'."
2761;; This is the standard process filter for term buffers. 2741;; This is the standard process filter for term buffers.
2762;; It emulates (most of the features of) a VT100/ANSI-style terminal. 2742;; It emulates (most of the features of) a VT100/ANSI-style terminal.
2763 2743
2744;; References:
2745;; [ctlseqs]: http://invisible-island.net/xterm/ctlseqs/ctlseqs.html
2746;; [ECMA-48]: http://www.ecma-international.org/publications/standards/Ecma-048.htm
2747;; [vt100]: https://vt100.net/docs/vt100-ug/chapter3.html
2748
2749(defconst term-control-seq-regexp
2750 (concat
2751 ;; A control character,
2752 "\\(?:[\r\n\000\007\t\b\016\017]\\|"
2753 ;; some Emacs specific control sequences, implemented by
2754 ;; `term-command-hook',
2755 "\032[^\n]+\r?\n\\|"
2756 ;; a C1 escape coded character (see [ECMA-48] section 5.3 "Elements
2757 ;; of the C1 set"),
2758 "\e\\(?:[DM78c]\\|"
2759 ;; another Emacs specific control sequence,
2760 "AnSiT[^\n]+\r?\n\\|"
2761 ;; or an escape sequence (section 5.4 "Control Sequences"),
2762 "\\[\\([\x30-\x3F]*\\)[\x20-\x2F]*[\x40-\x7E]\\)\\)")
2763 "Regexp matching control sequences handled by term.el.")
2764
2765(defconst term-control-seq-prefix-regexp
2766 "[\032\e]")
2767
2764(defun term-emulate-terminal (proc str) 2768(defun term-emulate-terminal (proc str)
2765 (with-current-buffer (process-buffer proc) 2769 (with-current-buffer (process-buffer proc)
2766 (let* ((i 0) char funny 2770 (let* ((i 0) funny
2767 count ; number of decoded chars in substring
2768 count-bytes ; number of bytes
2769 decoded-substring 2771 decoded-substring
2770 save-point save-marker old-point temp win 2772 save-point save-marker win
2771 (inhibit-read-only t) 2773 (inhibit-read-only t)
2772 (buffer-undo-list t) 2774 (buffer-undo-list t)
2773 (selected (selected-window)) 2775 (selected (selected-window))
2774 last-win 2776 last-win
2775 handled-ansi-message
2776 (str-length (length str))) 2777 (str-length (length str)))
2777 (save-selected-window 2778 (save-selected-window
2778 2779
2779 (let ((newstr (term-handle-ansi-terminal-messages str)))
2780 (unless (eq str newstr)
2781 (setq handled-ansi-message t
2782 str newstr)))
2783 (setq str-length (length str))
2784
2785 (when (marker-buffer term-pending-delete-marker) 2780 (when (marker-buffer term-pending-delete-marker)
2786 ;; Delete text following term-pending-delete-marker. 2781 ;; Delete text following term-pending-delete-marker.
2787 (delete-region term-pending-delete-marker (process-mark proc)) 2782 (delete-region term-pending-delete-marker (process-mark proc))
@@ -2811,298 +2806,214 @@ See `term-prompt-regexp'."
2811 (setq str (concat term-terminal-undecoded-bytes str)) 2806 (setq str (concat term-terminal-undecoded-bytes str))
2812 (setq str-length (length str)) 2807 (setq str-length (length str))
2813 (setq term-terminal-undecoded-bytes nil)) 2808 (setq term-terminal-undecoded-bytes nil))
2814 (cond ((eq term-terminal-state 4) ;; Have saved pending output. 2809
2815 (setq str (concat term-terminal-parameter str)) 2810 (while (< i str-length)
2816 (setq term-terminal-parameter nil) 2811 (setq funny (string-match term-control-seq-regexp str i))
2817 (setq str-length (length str)) 2812 (let ((ctl-params (and funny (match-string 1 str)))
2818 (setq term-terminal-state 0))) 2813 (ctl-params-end (and funny (match-end 1)))
2819 2814 (ctl-end (if funny (match-end 0)
2820 (while (< i str-length) 2815 (setq funny (string-match term-control-seq-prefix-regexp str i))
2821 (setq char (aref str i)) 2816 (if funny
2822 (cond ((< term-terminal-state 2) 2817 (setq term-terminal-undecoded-bytes
2823 ;; Look for prefix of regular chars 2818 (substring str funny))
2824 (setq funny 2819 (setq funny str-length))
2825 (string-match "[\r\n\000\007\033\t\b\032\016\017]" 2820 ;; The control sequence ends somewhere
2826 str i)) 2821 ;; past the end of this string.
2827 (when (not funny) (setq funny str-length)) 2822 (1+ str-length))))
2828 (cond ((> funny i) 2823 (when (> funny i)
2829 (cond ((eq term-terminal-state 1) 2824 (when term-do-line-wrapping
2830 ;; We are in state 1, we need to wrap 2825 (term-down 1 t)
2831 ;; around. Go to the beginning of 2826 (term-move-to-column 0)
2832 ;; the next line and switch to state 2827 (setq term-do-line-wrapping nil))
2833 ;; 0. 2828 ;; Handle non-control data. Decode the string before
2834 (term-down 1 t) 2829 ;; counting characters, to avoid garbling of certain
2835 (term-move-columns (- (term-current-column))) 2830 ;; multibyte characters (bug#1006).
2836 (setq term-terminal-state 0))) 2831 (setq decoded-substring
2837 ;; Decode the string before counting 2832 (decode-coding-string
2838 ;; characters, to avoid garbling of certain 2833 (substring str i funny)
2839 ;; multibyte characters (bug#1006). 2834 locale-coding-system t))
2840 (setq decoded-substring 2835 ;; Check for multibyte characters that ends
2841 (decode-coding-string 2836 ;; before end of string, and save it for
2842 (substring str i funny) 2837 ;; next time.
2843 locale-coding-system)) 2838 (when (= funny str-length)
2844 (setq count (length decoded-substring)) 2839 (let ((partial 0)
2845 ;; Check for multibyte characters that ends 2840 (count (length decoded-substring)))
2846 ;; before end of string, and save it for 2841 (while (eq (char-charset (aref decoded-substring
2847 ;; next time. 2842 (- count 1 partial)))
2848 (when (= funny str-length) 2843 'eight-bit)
2849 (let ((partial 0)) 2844 (cl-incf partial))
2850 (while (eq (char-charset (aref decoded-substring 2845 (when (> partial 0)
2851 (- count 1 partial))) 2846 (setq term-terminal-undecoded-bytes
2852 'eight-bit) 2847 (substring decoded-substring (- partial)))
2853 (cl-incf partial)) 2848 (setq decoded-substring
2854 (when (> partial 0) 2849 (substring decoded-substring 0 (- partial)))
2855 (setq term-terminal-undecoded-bytes 2850 (cl-decf str-length partial)
2856 (substring decoded-substring (- partial))) 2851 (cl-decf funny partial))))
2857 (setq decoded-substring 2852
2858 (substring decoded-substring 0 (- partial))) 2853 ;; Insert a string, check how many columns
2859 (cl-decf str-length partial) 2854 ;; we moved, then delete that many columns
2860 (cl-decf count partial) 2855 ;; following point if not eob nor insert-mode.
2861 (cl-decf funny partial)))) 2856 (let ((old-column (term-horizontal-column))
2862 (setq temp (- (+ (term-horizontal-column) count) 2857 (old-point (point))
2863 term-width)) 2858 columns)
2864 (cond ((or term-suppress-hard-newline (<= temp 0))) 2859 (unless term-suppress-hard-newline
2865 ;; All count chars fit in line. 2860 (while (> (+ (length decoded-substring) old-column)
2866 ((> count temp) ;; Some chars fit. 2861 term-width)
2867 ;; This iteration, handle only what fits. 2862 (insert (substring decoded-substring 0
2868 (setq count (- count temp)) 2863 (- term-width old-column)))
2869 (setq count-bytes 2864 ;; Since we've enough text to fill the whole line,
2870 (length 2865 ;; delete previous text regardless of
2871 (encode-coding-string 2866 ;; `term-insert-mode's value.
2872 (substring decoded-substring 0 count) 2867 (delete-region (point) (line-end-position))
2873 'binary))) 2868 (term-down 1 t)
2874 (setq temp 0) 2869 (term-move-columns (- (term-current-column)))
2875 (setq funny (+ count-bytes i))) 2870 (setq decoded-substring
2876 ((or (not (or term-pager-count 2871 (substring decoded-substring (- term-width old-column)))
2877 term-scroll-with-delete)) 2872 (setq old-column 0)))
2878 (> (term-handle-scroll 1) 0)) 2873 (insert decoded-substring)
2879 (term-adjust-current-row-cache 1) 2874 (setq term-current-column (current-column)
2880 (setq count (min count term-width)) 2875 columns (- term-current-column old-column))
2881 (setq count-bytes 2876 (when (not (or (eobp) term-insert-mode))
2882 (length 2877 (let ((pos (point)))
2883 (encode-coding-string 2878 (term-move-columns columns)
2884 (substring decoded-substring 0 count) 2879 (delete-region pos (point))))
2885 'binary))) 2880 ;; In insert mode if the current line
2886 (setq funny (+ count-bytes i)) 2881 ;; has become too long it needs to be
2887 (setq term-start-line-column 2882 ;; chopped off.
2888 term-current-column)) 2883 (when term-insert-mode
2889 (t ;; Doing PAGER processing. 2884 (let ((pos (point)))
2890 (setq count 0 funny i) 2885 (end-of-line)
2891 (setq term-current-column nil) 2886 (when (> (current-column) term-width)
2892 (setq term-start-line-column nil))) 2887 (delete-region (- (point) (- (current-column) term-width))
2893 (setq old-point (point)) 2888 (point)))
2894 2889 (goto-char pos)))
2895 ;; Insert a string, check how many columns 2890
2896 ;; we moved, then delete that many columns 2891 (put-text-property old-point (point)
2897 ;; following point if not eob nor insert-mode. 2892 'font-lock-face term-current-face))
2898 (let ((old-column (current-column)) 2893 ;; If the last char was written in last column,
2899 columns pos) 2894 ;; back up one column, but remember we did so.
2900 (insert (decode-coding-string (substring str i funny) locale-coding-system)) 2895 ;; Thus we emulate xterm/vt100-style line-wrapping.
2901 (setq term-current-column (current-column) 2896 (cond ((eq (term-current-column) term-width)
2902 columns (- term-current-column old-column)) 2897 (term-move-columns -1)
2903 (when (not (or (eobp) term-insert-mode)) 2898 (setq term-do-line-wrapping t)))
2904 (setq pos (point)) 2899 (setq term-current-column nil)
2905 (term-move-columns columns) 2900 (setq i funny))
2906 (delete-region pos (point))) 2901 (pcase-exhaustive (and (<= ctl-end str-length) (aref str i))
2907 ;; In insert mode if the current line 2902 (?\t ;; TAB (terminfo: ht)
2908 ;; has become too long it needs to be 2903 ;; The line cannot exceed term-width. TAB at
2909 ;; chopped off. 2904 ;; the end of a line should not cause wrapping.
2910 (when term-insert-mode 2905 (let ((col (term-current-column)))
2911 (setq pos (point)) 2906 (term-move-to-column
2912 (end-of-line) 2907 (min (1- term-width)
2913 (when (> (current-column) term-width) 2908 (+ col 8 (- (mod col 8)))))))
2914 (delete-region (- (point) (- (current-column) term-width)) 2909 (?\r ;; (terminfo: cr)
2915 (point))) 2910 (term-vertical-motion 0)
2916 (goto-char pos))) 2911 (setq term-current-column term-start-line-column))
2917 (setq term-current-column nil) 2912 (?\n ;; (terminfo: cud1, ind)
2918 2913 (unless (and term-kill-echo-list
2919 (put-text-property old-point (point) 2914 (term-check-kill-echo-list))
2920 'font-lock-face term-current-face) 2915 (term-down 1 t)))
2921 ;; If the last char was written in last column, 2916 (?\b ;; (terminfo: cub1)
2922 ;; back up one column, but remember we did so. 2917 (term-move-columns -1))
2923 ;; Thus we emulate xterm/vt100-style line-wrapping. 2918 (?\C-g ;; (terminfo: bel)
2924 (cond ((eq temp 0) 2919 (beep t))
2925 (term-move-columns -1) 2920 (?\032 ; Emacs specific control sequence.
2926 (setq term-terminal-state 1))) 2921 (funcall term-command-hook
2927 (setq i (1- funny))) 2922 (decode-coding-string
2928 ((and (setq term-terminal-state 0) 2923 (substring str (1+ i)
2929 (eq char ?\^I)) ; TAB (terminfo: ht) 2924 (- ctl-end
2930 (setq count (term-current-column)) 2925 (if (eq (aref str (- ctl-end 2)) ?\r)
2931 ;; The line cannot exceed term-width. TAB at 2926 2 1)))
2932 ;; the end of a line should not cause wrapping. 2927 locale-coding-system t)))
2933 (setq count (min term-width 2928 (?\e
2934 (+ count 8 (- (mod count 8))))) 2929 (pcase (aref str (1+ i))
2935 (if (> term-width count) 2930 (?\[
2936 (progn 2931 ;; We only handle control sequences with a single
2937 (term-move-columns 2932 ;; "Final" byte (see [ECMA-48] section 5.4).
2938 (- count (term-current-column))) 2933 (when (eq ctl-params-end (1- ctl-end))
2939 (setq term-current-column count)) 2934 (term-handle-ansi-escape
2940 (when (> term-width (term-current-column)) 2935 proc
2941 (term-move-columns 2936 (mapcar ;; We don't distinguish empty params
2942 (1- (- term-width (term-current-column))))) 2937 ;; from 0 (according to [ECMA-48] we
2943 (when (= term-width (term-current-column)) 2938 ;; should, but all commands we support
2944 (term-move-columns -1)))) 2939 ;; default to 0 values anyway).
2945 ((eq char ?\r) ;; (terminfo: cr) 2940 #'string-to-number
2946 (term-vertical-motion 0) 2941 (split-string ctl-params ";"))
2947 (setq term-current-column term-start-line-column)) 2942 (aref str (1- ctl-end)))))
2948 ((eq char ?\n) ;; (terminfo: cud1, ind) 2943 (?D ;; Scroll forward (apparently not documented in
2949 (unless (and term-kill-echo-list 2944 ;; [ECMA-48], [ctlseqs] mentions it as C1
2950 (term-check-kill-echo-list)) 2945 ;; character "Index" though).
2951 (term-down 1 t))) 2946 (term-handle-deferred-scroll)
2952 ((eq char ?\b) ;; (terminfo: cub1) 2947 (term-down 1 t))
2953 (term-move-columns -1)) 2948 (?M ;; Scroll reversed (terminfo: ri, ECMA-48
2954 ((eq char ?\033) ; Escape 2949 ;; "Reverse Linefeed").
2955 (setq term-terminal-state 2)) 2950 (if (or (< (term-current-row) term-scroll-start)
2956 ((eq char 0)) ; NUL: Do nothing 2951 (>= (1- (term-current-row))
2957 ((eq char ?\016)) ; Shift Out - ignored 2952 term-scroll-start))
2958 ((eq char ?\017)) ; Shift In - ignored 2953 ;; Scrolling up will not move outside
2959 ((eq char ?\^G) ;; (terminfo: bel) 2954 ;; the scroll region.
2960 (beep t)) 2955 (term-down -1)
2961 ((eq char ?\032) 2956 ;; Scrolling the scroll region is needed.
2962 (let ((end (string-match "\r?\n" str i))) 2957 (term-down -1 t)))
2963 (if end 2958 (?7 ;; Save cursor (terminfo: sc, not in [ECMA-48],
2964 (progn 2959 ;; [ctlseqs] has it as "DECSC").
2965 (unless handled-ansi-message 2960 (term-handle-deferred-scroll)
2966 (funcall term-command-hook 2961 (setq term-saved-cursor
2967 (decode-coding-string 2962 (list (term-current-row)
2968 (substring str (1+ i) end) 2963 (term-horizontal-column)
2969 locale-coding-system))) 2964 term-ansi-current-bg-color
2970 (setq i (1- (match-end 0)))) 2965 term-ansi-current-bold
2971 (setq term-terminal-parameter (substring str i)) 2966 term-ansi-current-color
2972 (setq term-terminal-state 4) 2967 term-ansi-current-invisible
2973 (setq i str-length)))) 2968 term-ansi-current-reverse
2974 (t ; insert char FIXME: Should never happen 2969 term-ansi-current-underline
2975 (term-move-columns 1) 2970 term-current-face)))
2976 (backward-delete-char 1) 2971 (?8 ;; Restore cursor (terminfo: rc, [ctlseqs]
2977 (insert char)))) 2972 ;; "DECRC").
2978 ((eq term-terminal-state 2) ; Seen Esc 2973 (when term-saved-cursor
2979 (cond ((eq char ?\133) ;; ?\133 = ?[ 2974 (term-goto (nth 0 term-saved-cursor)
2980 2975 (nth 1 term-saved-cursor))
2981 ;; Some modifications to cope with multiple 2976 (setq term-ansi-current-bg-color
2982 ;; settings like ^[[01;32;43m -mm 2977 (nth 2 term-saved-cursor)
2983 ;; Note that now the init value of 2978 term-ansi-current-bold
2984 ;; term-terminal-previous-parameter has been 2979 (nth 3 term-saved-cursor)
2985 ;; changed to -1 2980 term-ansi-current-color
2986 2981 (nth 4 term-saved-cursor)
2987 (setq term-terminal-parameter 0) 2982 term-ansi-current-invisible
2988 (setq term-terminal-previous-parameter -1) 2983 (nth 5 term-saved-cursor)
2989 (setq term-terminal-previous-parameter-2 -1) 2984 term-ansi-current-reverse
2990 (setq term-terminal-previous-parameter-3 -1) 2985 (nth 6 term-saved-cursor)
2991 (setq term-terminal-previous-parameter-4 -1) 2986 term-ansi-current-underline
2992 (setq term-terminal-more-parameters 0) 2987 (nth 7 term-saved-cursor)
2993 (setq term-terminal-state 3)) 2988 term-current-face
2994 ((eq char ?D) ;; scroll forward 2989 (nth 8 term-saved-cursor))))
2995 (term-handle-deferred-scroll) 2990 (?c ;; \Ec - Reset (terminfo: rs1, [ctlseqs] "RIS").
2996 (term-down 1 t) 2991 ;; This is used by the "clear" program.
2997 (setq term-terminal-state 0)) 2992 (term-reset-terminal))
2998 ;; ((eq char ?E) ;; (terminfo: nw), not used for 2993 (?A ;; An \eAnSiT sequence (Emacs specific).
2999 ;; ;; now, but this is a working 2994 (term-handle-ansi-terminal-messages
3000 ;; ;; implementation 2995 (substring str i ctl-end)))))
3001 ;; (term-down 1) 2996 ;; Ignore NUL, Shift Out, Shift In.
3002 ;; (term-goto term-current-row 0) 2997 ((or ?\0 #xE #xF 'nil) nil))
3003 ;; (setq term-terminal-state 0)) 2998 (if (term-handling-pager)
3004 ((eq char ?M) ;; scroll reversed (terminfo: ri) 2999 (progn
3005 (if (or (< (term-current-row) term-scroll-start) 3000 ;; Finish stuff to get ready to handle PAGER.
3006 (>= (1- (term-current-row)) 3001 (if (> (% (current-column) term-width) 0)
3007 term-scroll-start)) 3002 (setq term-terminal-undecoded-bytes
3008 ;; Scrolling up will not move outside 3003 (substring str i))
3009 ;; the scroll region. 3004 ;; We're at column 0. Goto end of buffer; to compensate,
3010 (term-down -1) 3005 ;; prepend a ?\r for later. This looks more consistent.
3011 ;; Scrolling the scroll region is needed. 3006 (if (zerop i)
3012 (term-down -1 t)) 3007 (setq term-terminal-undecoded-bytes
3013 (setq term-terminal-state 0)) 3008 (concat "\r" (substring str i)))
3014 ((eq char ?7) ;; Save cursor (terminfo: sc) 3009 (setq term-terminal-undecoded-bytes (substring str (1- i)))
3015 (term-handle-deferred-scroll) 3010 (aset term-terminal-undecoded-bytes 0 ?\r))
3016 (setq term-saved-cursor 3011 (goto-char (point-max)))
3017 (list (term-current-row) 3012 (make-local-variable 'term-pager-old-filter)
3018 (term-horizontal-column) 3013 (setq term-pager-old-filter (process-filter proc))
3019 term-ansi-current-bg-color 3014 (set-process-filter proc term-pager-filter)
3020 term-ansi-current-bold 3015 (setq i str-length))
3021 term-ansi-current-color 3016 (setq i ctl-end)))))
3022 term-ansi-current-invisible
3023 term-ansi-current-reverse
3024 term-ansi-current-underline
3025 term-current-face)
3026 )
3027 (setq term-terminal-state 0))
3028 ((eq char ?8) ;; Restore cursor (terminfo: rc)
3029 (when term-saved-cursor
3030 (term-goto (nth 0 term-saved-cursor)
3031 (nth 1 term-saved-cursor))
3032 (setq term-ansi-current-bg-color
3033 (nth 2 term-saved-cursor)
3034 term-ansi-current-bold
3035 (nth 3 term-saved-cursor)
3036 term-ansi-current-color
3037 (nth 4 term-saved-cursor)
3038 term-ansi-current-invisible
3039 (nth 5 term-saved-cursor)
3040 term-ansi-current-reverse
3041 (nth 6 term-saved-cursor)
3042 term-ansi-current-underline
3043 (nth 7 term-saved-cursor)
3044 term-current-face
3045 (nth 8 term-saved-cursor)))
3046 (setq term-terminal-state 0))
3047 ((eq char ?c) ;; \Ec - Reset (terminfo: rs1)
3048 ;; This is used by the "clear" program.
3049 (setq term-terminal-state 0)
3050 (term-reset-terminal))
3051 ;; The \E#8 reset sequence for xterm. We
3052 ;; probably don't need to handle it, but this
3053 ;; is the code to parse it.
3054 ;; ((eq char ?#)
3055 ;; (when (eq (aref str (1+ i)) ?8)
3056 ;; (setq i (1+ i))
3057 ;; (setq term-scroll-start 0)
3058 ;; (setq term-scroll-end term-height)
3059 ;; (setq term-terminal-state 0)))
3060 ((setq term-terminal-state 0))))
3061 ((eq term-terminal-state 3) ; Seen Esc [
3062 (cond ((and (>= char ?0) (<= char ?9))
3063 (setq term-terminal-parameter
3064 (+ (* 10 term-terminal-parameter) (- char ?0))))
3065 ((eq char ?\;)
3066 ;; Some modifications to cope with multiple
3067 ;; settings like ^[[01;32;43m -mm
3068 (setq term-terminal-more-parameters 1)
3069 (setq term-terminal-previous-parameter-4
3070 term-terminal-previous-parameter-3)
3071 (setq term-terminal-previous-parameter-3
3072 term-terminal-previous-parameter-2)
3073 (setq term-terminal-previous-parameter-2
3074 term-terminal-previous-parameter)
3075 (setq term-terminal-previous-parameter
3076 term-terminal-parameter)
3077 (setq term-terminal-parameter 0))
3078 ((eq char ??)) ; Ignore ?
3079 (t
3080 (term-handle-ansi-escape proc char)
3081 (setq term-terminal-more-parameters 0)
3082 (setq term-terminal-previous-parameter-4 -1)
3083 (setq term-terminal-previous-parameter-3 -1)
3084 (setq term-terminal-previous-parameter-2 -1)
3085 (setq term-terminal-previous-parameter -1)
3086 (setq term-terminal-state 0)))))
3087 (when (term-handling-pager)
3088 ;; Finish stuff to get ready to handle PAGER.
3089 (if (> (% (current-column) term-width) 0)
3090 (setq term-terminal-parameter
3091 (substring str i))
3092 ;; We're at column 0. Goto end of buffer; to compensate,
3093 ;; prepend a ?\r for later. This looks more consistent.
3094 (if (zerop i)
3095 (setq term-terminal-parameter
3096 (concat "\r" (substring str i)))
3097 (setq term-terminal-parameter (substring str (1- i)))
3098 (aset term-terminal-parameter 0 ?\r))
3099 (goto-char (point-max)))
3100 (setq term-terminal-state 4)
3101 (make-local-variable 'term-pager-old-filter)
3102 (setq term-pager-old-filter (process-filter proc))
3103 (set-process-filter proc term-pager-filter)
3104 (setq i str-length))
3105 (setq i (1+ i))))
3106 3017
3107 (when (>= (term-current-row) term-height) 3018 (when (>= (term-current-row) term-height)
3108 (term-handle-deferred-scroll)) 3019 (term-handle-deferred-scroll))
@@ -3333,87 +3244,83 @@ option is enabled. See `term-set-goto-process-mark'."
3333;; Handle a character assuming (eq terminal-state 2) - 3244;; Handle a character assuming (eq terminal-state 2) -
3334;; i.e. we have previously seen Escape followed by ?[. 3245;; i.e. we have previously seen Escape followed by ?[.
3335 3246
3336(defun term-handle-ansi-escape (proc char) 3247(defun term-handle-ansi-escape (proc params char)
3337 (cond 3248 (cond
3338 ((or (eq char ?H) ;; cursor motion (terminfo: cup,home) 3249 ((or (eq char ?H) ;; cursor motion (terminfo: cup,home)
3339 ;; (eq char ?f) ;; xterm seems to handle this sequence too, not 3250 ;; (eq char ?f) ;; xterm seems to handle this sequence too, not
3340 ;; needed for now 3251 ;; needed for now
3341 ) 3252 )
3342 (when (<= term-terminal-parameter 0)
3343 (setq term-terminal-parameter 1))
3344 (when (<= term-terminal-previous-parameter 0)
3345 (setq term-terminal-previous-parameter 1))
3346 (when (> term-terminal-previous-parameter term-height)
3347 (setq term-terminal-previous-parameter term-height))
3348 (when (> term-terminal-parameter term-width)
3349 (setq term-terminal-parameter term-width))
3350 (term-goto 3253 (term-goto
3351 (1- term-terminal-previous-parameter) 3254 (1- (max 1 (min (or (nth 0 params) 0) term-height)))
3352 (1- term-terminal-parameter))) 3255 (1- (max 1 (min (or (nth 1 params) 0) term-width)))))
3353 ;; \E[A - cursor up (terminfo: cuu, cuu1) 3256 ;; \E[A - cursor up (terminfo: cuu, cuu1)
3354 ((eq char ?A) 3257 ((eq char ?A)
3355 (term-handle-deferred-scroll) 3258 (term-handle-deferred-scroll)
3356 (let ((tcr (term-current-row))) 3259 (let ((tcr (term-current-row))
3260 (scroll-amount (car params)))
3357 (term-down 3261 (term-down
3358 (if (< (- tcr term-terminal-parameter) term-scroll-start) 3262 (if (< (- tcr scroll-amount) term-scroll-start)
3359 ;; If the amount to move is before scroll start, move 3263 ;; If the amount to move is before scroll start, move
3360 ;; to scroll start. 3264 ;; to scroll start.
3361 (- term-scroll-start tcr) 3265 (- term-scroll-start tcr)
3362 (if (>= term-terminal-parameter tcr) 3266 (if (>= scroll-amount tcr)
3363 (- tcr) 3267 (- tcr)
3364 (- (max 1 term-terminal-parameter)))) t))) 3268 (- (max 1 scroll-amount))))
3269 t)))
3365 ;; \E[B - cursor down (terminfo: cud) 3270 ;; \E[B - cursor down (terminfo: cud)
3366 ((eq char ?B) 3271 ((eq char ?B)
3367 (let ((tcr (term-current-row))) 3272 (let ((tcr (term-current-row))
3273 (scroll-amount (car params)))
3368 (unless (= tcr (1- term-scroll-end)) 3274 (unless (= tcr (1- term-scroll-end))
3369 (term-down 3275 (term-down
3370 (if (> (+ tcr term-terminal-parameter) term-scroll-end) 3276 (if (> (+ tcr scroll-amount) term-scroll-end)
3371 (- term-scroll-end 1 tcr) 3277 (- term-scroll-end 1 tcr)
3372 (max 1 term-terminal-parameter)) t)))) 3278 (max 1 scroll-amount))
3279 t))))
3373 ;; \E[C - cursor right (terminfo: cuf, cuf1) 3280 ;; \E[C - cursor right (terminfo: cuf, cuf1)
3374 ((eq char ?C) 3281 ((eq char ?C)
3375 (term-move-columns 3282 (term-move-columns
3376 (max 1 3283 (max 1
3377 (if (>= (+ term-terminal-parameter (term-current-column)) term-width) 3284 (if (>= (+ (car params) (term-current-column)) term-width)
3378 (- term-width (term-current-column) 1) 3285 (- term-width (term-current-column) 1)
3379 term-terminal-parameter)))) 3286 (car params)))))
3380 ;; \E[D - cursor left (terminfo: cub) 3287 ;; \E[D - cursor left (terminfo: cub)
3381 ((eq char ?D) 3288 ((eq char ?D)
3382 (term-move-columns (- (max 1 term-terminal-parameter)))) 3289 (term-move-columns (- (max 1 (car params)))))
3383 ;; \E[G - cursor motion to absolute column (terminfo: hpa) 3290 ;; \E[G - cursor motion to absolute column (terminfo: hpa)
3384 ((eq char ?G) 3291 ((eq char ?G)
3385 (term-move-columns (- (max 0 (min term-width term-terminal-parameter)) 3292 (term-move-columns (- (max 0 (min term-width (car params)))
3386 (term-current-column)))) 3293 (term-current-column))))
3387 ;; \E[J - clear to end of screen (terminfo: ed, clear) 3294 ;; \E[J - clear to end of screen (terminfo: ed, clear)
3388 ((eq char ?J) 3295 ((eq char ?J)
3389 (term-erase-in-display term-terminal-parameter)) 3296 (term-erase-in-display (car params)))
3390 ;; \E[K - clear to end of line (terminfo: el, el1) 3297 ;; \E[K - clear to end of line (terminfo: el, el1)
3391 ((eq char ?K) 3298 ((eq char ?K)
3392 (term-erase-in-line term-terminal-parameter)) 3299 (term-erase-in-line (car params)))
3393 ;; \E[L - insert lines (terminfo: il, il1) 3300 ;; \E[L - insert lines (terminfo: il, il1)
3394 ((eq char ?L) 3301 ((eq char ?L)
3395 (term-insert-lines (max 1 term-terminal-parameter))) 3302 (term-insert-lines (max 1 (car params))))
3396 ;; \E[M - delete lines (terminfo: dl, dl1) 3303 ;; \E[M - delete lines (terminfo: dl, dl1)
3397 ((eq char ?M) 3304 ((eq char ?M)
3398 (term-delete-lines (max 1 term-terminal-parameter))) 3305 (term-delete-lines (max 1 (car params))))
3399 ;; \E[P - delete chars (terminfo: dch, dch1) 3306 ;; \E[P - delete chars (terminfo: dch, dch1)
3400 ((eq char ?P) 3307 ((eq char ?P)
3401 (term-delete-chars (max 1 term-terminal-parameter))) 3308 (term-delete-chars (max 1 (car params))))
3402 ;; \E[@ - insert spaces (terminfo: ich) 3309 ;; \E[@ - insert spaces (terminfo: ich)
3403 ((eq char ?@) 3310 ((eq char ?@)
3404 (term-insert-spaces (max 1 term-terminal-parameter))) 3311 (term-insert-spaces (max 1 (car params))))
3405 ;; \E[?h - DEC Private Mode Set 3312 ;; \E[?h - DEC Private Mode Set
3406 ((eq char ?h) 3313 ((eq char ?h)
3407 (cond ((eq term-terminal-parameter 4) ;; (terminfo: smir) 3314 (cond ((eq (car params) 4) ;; (terminfo: smir)
3408 (setq term-insert-mode t)) 3315 (setq term-insert-mode t))
3409 ;; ((eq term-terminal-parameter 47) ;; (terminfo: smcup) 3316 ;; ((eq (car params) 47) ;; (terminfo: smcup)
3410 ;; (term-switch-to-alternate-sub-buffer t)) 3317 ;; (term-switch-to-alternate-sub-buffer t))
3411 )) 3318 ))
3412 ;; \E[?l - DEC Private Mode Reset 3319 ;; \E[?l - DEC Private Mode Reset
3413 ((eq char ?l) 3320 ((eq char ?l)
3414 (cond ((eq term-terminal-parameter 4) ;; (terminfo: rmir) 3321 (cond ((eq (car params) 4) ;; (terminfo: rmir)
3415 (setq term-insert-mode nil)) 3322 (setq term-insert-mode nil))
3416 ;; ((eq term-terminal-parameter 47) ;; (terminfo: rmcup) 3323 ;; ((eq (car params) 47) ;; (terminfo: rmcup)
3417 ;; (term-switch-to-alternate-sub-buffer nil)) 3324 ;; (term-switch-to-alternate-sub-buffer nil))
3418 )) 3325 ))
3419 3326
@@ -3421,15 +3328,7 @@ option is enabled. See `term-set-goto-process-mark'."
3421 ;; \E[m - Set/reset modes, set bg/fg 3328 ;; \E[m - Set/reset modes, set bg/fg
3422 ;;(terminfo: smso,rmso,smul,rmul,rev,bold,sgr0,invis,op,setab,setaf) 3329 ;;(terminfo: smso,rmso,smul,rmul,rev,bold,sgr0,invis,op,setab,setaf)
3423 ((eq char ?m) 3330 ((eq char ?m)
3424 (when (= term-terminal-more-parameters 1) 3331 (mapc #'term-handle-colors-array params))
3425 (when (>= term-terminal-previous-parameter-4 0)
3426 (term-handle-colors-array term-terminal-previous-parameter-4))
3427 (when (>= term-terminal-previous-parameter-3 0)
3428 (term-handle-colors-array term-terminal-previous-parameter-3))
3429 (when (>= term-terminal-previous-parameter-2 0)
3430 (term-handle-colors-array term-terminal-previous-parameter-2))
3431 (term-handle-colors-array term-terminal-previous-parameter))
3432 (term-handle-colors-array term-terminal-parameter))
3433 3332
3434 ;; \E[6n - Report cursor position (terminfo: u7) 3333 ;; \E[6n - Report cursor position (terminfo: u7)
3435 ((eq char ?n) 3334 ((eq char ?n)
@@ -3442,8 +3341,8 @@ option is enabled. See `term-set-goto-process-mark'."
3442 ;; \E[r - Set scrolling region (terminfo: csr) 3341 ;; \E[r - Set scrolling region (terminfo: csr)
3443 ((eq char ?r) 3342 ((eq char ?r)
3444 (term-set-scroll-region 3343 (term-set-scroll-region
3445 (1- term-terminal-previous-parameter) 3344 (1- (or (nth 0 params) 0))
3446 (1- term-terminal-parameter))) 3345 (1- (or (nth 1 params) 0))))
3447 (t))) 3346 (t)))
3448 3347
3449(defun term-set-scroll-region (top bottom) 3348(defun term-set-scroll-region (top bottom)
@@ -3631,7 +3530,7 @@ The top-most line is line 0."
3631 3530
3632(defun term-pager-discard () 3531(defun term-pager-discard ()
3633 (interactive) 3532 (interactive)
3634 (setq term-terminal-parameter "") 3533 (setq term-terminal-undecoded-bytes "")
3635 (interrupt-process nil t) 3534 (interrupt-process nil t)
3636 (term-pager-continue term-height)) 3535 (term-pager-continue term-height))
3637 3536
@@ -3809,7 +3708,7 @@ all pending output has been dealt with."))
3809If KIND is 0, erase from (point) to (point-max); 3708If KIND is 0, erase from (point) to (point-max);
3810if KIND is 1, erase from home to point; else erase from home to point-max." 3709if KIND is 1, erase from home to point; else erase from home to point-max."
3811 (term-handle-deferred-scroll) 3710 (term-handle-deferred-scroll)
3812 (cond ((eq term-terminal-parameter 0) 3711 (cond ((eq kind 0)
3813 (let ((need-unwrap (bolp))) 3712 (let ((need-unwrap (bolp)))
3814 (delete-region (point) (point-max)) 3713 (delete-region (point) (point-max))
3815 (when need-unwrap (term-unwrap-line)))) 3714 (when need-unwrap (term-unwrap-line))))
generated by cgit v1.2.1 (git 2.18.0) at 2026-02-13 22:51:30 +0000