From 6f071752f90566de6e881fa8962a7b94d4736883 Mon Sep 17 00:00:00 2001 From: Daniel Colascione Date: Sun, 2 Mar 2025 15:53:17 -0500 Subject: [PATCH] Add auto-margin enable/disable to term * test/lisp/term-tests.el (term-line-wrap-no-auto-margins): add test * lisp/term.el (term-auto-margins): new variable (term-mode): documentation (term-termcap-format): mention auto-margins flag (term-emulate-terminal): support it (term-reset-terminal): reset it (term-handle-ansi-escape): notice it * etc/e/eterm-color.ti: add auto margin capability * etc/e/README: fix build documentation * etc/NEWS: mention auto-margins (cherry picked from commit 13b1436d975b270cb1001cf475fa65cc854ec462) --- etc/e/README | 3 ++ etc/e/eterm-color | Bin 1318 -> 1330 bytes etc/e/eterm-color.ti | 6 ++- etc/e/eterm-direct | Bin 1397 -> 1409 bytes lisp/term.el | 107 ++++++++++++++++++++++++++-------------- test/lisp/term-tests.el | 24 +++++++++ 6 files changed, 102 insertions(+), 38 deletions(-) diff --git a/etc/e/README b/etc/e/README index 1293292a878..7a1a6406c7d 100644 --- a/etc/e/README +++ b/etc/e/README @@ -7,6 +7,9 @@ version. If it is necessary, use: tic -o ../ ./eterm-color.ti +(Sometimes tic puts output in etc/65 instead of etc/e. Move it to etc/e +yourself if it does that.) + The compiled files are used by lisp/term.el, so if they are moved, term.el needs to be changed. terminfo requires them to be stored in an 'e' subdirectory (the first character of the file name). diff --git a/etc/e/eterm-color b/etc/e/eterm-color index fadac25ffcb55b3b3f6812e9c80f848e94f3dcc3..fb497ecca8cf35bad98c84e5c051ec3e6b870c11 100644 GIT binary patch delta 112 zcmZ3+wTX*ciqV}xl7XKglkwU{?zN08vW&`%lN}kwm^2wDKV&>Sc>^OalOE&bg^YS! y#*B81|AD|6q(Dl{2h0HpAV45UlNWP1?zN1QKQKx$$udrU$aomY}AeCOs-i%$FqnQ;LC%3b#1^~*VDU|>K diff --git a/etc/e/eterm-color.ti b/etc/e/eterm-color.ti index 84b27aef5d9..fb9e59c97cf 100644 --- a/etc/e/eterm-color.ti +++ b/etc/e/eterm-color.ti @@ -4,8 +4,8 @@ eterm-color|Emacs term.el terminal emulator term-protocol-version 0.96, # copyright, constituting the only possible expression of the algorithm # in this format. # -# When updating this file, etc/e/eterm-color should be regenerated by -# running "make e/eterm-color" in the etc directory. +# When updating this file, etc/e/eterm-color should be regenerated by +# following the instructions in etc/e/README. # Any change to this file should be done at the same time with a # corresponding change to the TERMCAP environment variable in term.el. # Comments in term.el specify where each of these capabilities is implemented. @@ -80,6 +80,8 @@ eterm-color|Emacs term.el terminal emulator term-protocol-version 0.96, u7=\E[6n, smcup=\E[47h, rmcup=\E[47l, + smam=\E[?7h, + rmam=\E[?7l, # rs2 may need to be added eterm-direct|Emacs term.el with direct-color indexing term-protocol-version 0.96, diff --git a/etc/e/eterm-direct b/etc/e/eterm-direct index f4c16621eb185d7d0de14b56fb2e2b73a57adab8..945707fa6c4a058c13bbbc752ad5103701958ea5 100644 GIT binary patch delta 109 zcmey$)yT~)#}vpQ$-vK$$@q68_f;UJ|G5TAXKphb2#Iw&CSdTjGXr784S|V_U1X07qDCf0B9f{vH$=8 delta 92 zcmZqV{>sHI#}vpQ$-vK$$@p<2_f^Kp0!&hjvXd2=g@LR+%>Vx@LD@2#>WoH=|AD|9 fBrbFfnyoO diff --git a/lisp/term.el b/lisp/term.el index 8516c7f7c0a..a7bb7057dc1 100644 --- a/lisp/term.el +++ b/lisp/term.el @@ -348,6 +348,10 @@ 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-auto-margins t + "When non-nil, terminal will automatically wrap lines at the right margin. +This can be toggled by the application using DECAWM escape sequences.") + (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 @@ -1144,6 +1148,7 @@ Entry to this mode runs the hooks on `term-mode-hook'." (setq-local term-last-input-start (make-marker)) (setq-local term-last-input-end (make-marker)) (setq-local term-last-input-match "") + (setq-local term-auto-margins t) ;; Always display the onscreen keyboard. (setq-local touch-screen-display-keyboard t) @@ -1678,7 +1683,7 @@ Using \"emacs\" loses, because bash disables editing if $TERM == emacs.") :mk=\\E[8m:cb=\\E[1K:op=\\E[39;49m:Co#256:pa#32767\ :AB=\\E[48;5;%%dm:AF=\\E[38;5;%%dm:cr=^M\ :bl=^G:do=^J:le=^H:ta=^I:se=\\E[27m:ue=\\E[24m\ -:kb=^?:kD=^[[3~:sc=\\E7:rc=\\E8:r1=\\Ec:" +:kb=^?:kD=^[[3~:sc=\\E7:rc=\\E8:r1=\\Ec:RA=\\E[?7l:SA=\\E[?7h:" ;; : -undefine ic ;; don't define :te=\\E[2J\\E[?47l\\E8:ti=\\E7\\E[?47h\ "Termcap capabilities supported.") @@ -3124,19 +3129,24 @@ See `term-prompt-regexp'." (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))) + (let* ((here-length (- term-width old-column)) + (to-insert (substring decoded-substring 0 here-length))) + (setf decoded-substring (substring decoded-substring here-length)) + (insert to-insert) + (setf term-current-column nil) + ;; 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)) + (if term-auto-margins + (progn + (term-move-to-column 0) + (term-down 1 t) + (add-text-properties (1- (point)) (point) + '(term-line-wrap t rear-nonsticky t)) + (setq old-column 0)) + (term-move-columns -1) + (setf old-column (term-current-column)))))) (insert decoded-substring) (setq term-current-column (current-column) columns (- term-current-column old-column)) @@ -3158,14 +3168,18 @@ See `term-prompt-regexp'." (put-text-property old-point (point) 'font-lock-face term-current-face)) - ;; If the last char was written in last column, + ;; If the last char was written in last column and auto-margins is enabled, ;; back up one column, but remember we did so. ;; Thus we emulate xterm/vt100-style line-wrapping. + ;; If auto-margins is disabled, the cursor stays at the last column + ;; and further output is discarded until a cursor movement occurs. (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))) + ;; Only set line-wrapping if auto-margins is enabled + (when term-auto-margins + ;; 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)) @@ -3201,15 +3215,19 @@ See `term-prompt-regexp'." ;; 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))))) + (let* ((private (string-prefix-p "?" ctl-params)) + (ctl-params + (if private (substring ctl-params 1) ctl-params))) + (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)) + private)))) (?D ;; Scroll forward (apparently not documented in ;; [ECMA-48], [ctlseqs] mentions it as C1 ;; character "Index" though). @@ -3422,7 +3440,8 @@ option is enabled. See `term-set-goto-process-mark'." (setq term-current-row 0) (setq term-current-column 1) (term--reset-scroll-region) - (setq term-insert-mode nil)) + (setq term-insert-mode nil) + (setq term-auto-margins t)) (defun term--color-as-hex (for-foreground) "Return the current ANSI color as a hexadecimal color string. @@ -3565,8 +3584,11 @@ color is unset in the terminal state." ;; Handle a character assuming (eq terminal-state 2) - ;; i.e. we have previously seen Escape followed by ?[. -(defun term-handle-ansi-escape (proc params char) +(defun term-handle-ansi-escape (proc params char &optional private) (cond + ((and private (not (memq char '(?h ?l)))) + ;; Recognize private capabilities only for mode entry and exit + nil) ((or (eq char ?H) ;; cursor motion (terminfo: cup,home) ;; (eq char ?f) ;; xterm seems to handle this sequence too, not ;; needed for now @@ -3629,17 +3651,30 @@ color is unset in the terminal state." ((eq char ?@) (term-insert-spaces (max 1 (car params)))) ;; \E[?h - DEC Private Mode Set + + ;; N.B. we previously had a bug in which we'd decode \e[?h or + ;; \e[?l as a command with zero in the params field and so + ;; didn't recognize DEC private escape sequences. However, the + ;; termcap and terminfo files had the non-? (question mark means DEC + ;; private) versions, so things kind of worked anyway. To preserve + ;; compatibility, we recognize both private- and non-private + ;; messages for capabilities we added before we fixed the bug but + ;; require the private flag for capabilities we added after. ((eq char ?h) - (cond ((eq (car params) 4) ;; (terminfo: smir) - (setq term-insert-mode t)) - ((eq (car params) 47) ;; (terminfo: smcup) - (term-switch-to-alternate-sub-buffer t)))) + (cond ((eq (car params) 4) ;; (terminfo: smir) + (setq term-insert-mode t)) + ((and private (eq (car params) 7)) ;; (terminfo: smam) + (setq term-auto-margins t)) + ((eq (car params) 47) ;; (terminfo: smcup) + (term-switch-to-alternate-sub-buffer t)))) ;; \E[?l - DEC Private Mode Reset ((eq char ?l) - (cond ((eq (car params) 4) ;; (terminfo: rmir) - (setq term-insert-mode nil)) + (cond ((eq (car params) 4) ;; (terminfo: rmir) + (setq term-insert-mode nil)) + ((and private (eq (car params) 7)) ;; (terminfo: rmam) + (setq term-auto-margins nil)) ((eq (car params) 47) ;; (terminfo: rmcup) - (term-switch-to-alternate-sub-buffer nil)))) + (term-switch-to-alternate-sub-buffer nil)))) ;; Modified to allow ansi coloring -mm ;; \E[m - Set/reset modes, set bg/fg diff --git a/test/lisp/term-tests.el b/test/lisp/term-tests.el index 65531b66d09..5ef8c1174df 100644 --- a/test/lisp/term-tests.el +++ b/test/lisp/term-tests.el @@ -129,6 +129,30 @@ first line\r_next line\r\n")) (term-test-screen-from-input 40 12 (let ((str (make-string 30 ?a))) (list str str)))))) +(ert-deftest term-line-wrap-no-auto-margins () + (skip-when (memq system-type '(windows-nt ms-dos))) + (let* ((width 40) + (line (cl-loop for i upfrom 0 to 60 + collect (+ ?a (% i 26)) into chars + finally return (apply #'string chars))) + (expected (concat (substring line 0 (1- width)) + (substring line (1- (length line))))) + (rmam "\e[?7l")) + (should + (equal (term-test-screen-from-input width 12 (concat rmam line)) + expected)) + ;; Again, but split input into chunks. + (should (equal + (term-test-screen-from-input + width 12 + (cl-loop + with step = 3 + with n = (length line) + for i upfrom 0 below n by step + collect (substring line i (min n (+ i step))) into parts + finally return (cons rmam parts))) + expected)))) + (ert-deftest term-colors () (skip-when (memq system-type '(windows-nt ms-dos))) (pcase-dolist (`(,str ,expected) ansi-test-strings) -- 2.39.5