(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 (and (< partial count)
- (eq (char-charset (aref decoded-substring
- (- count 1 partial)))
- 'eight-bit))
- (cl-incf partial))
- (when (> count partial 0)
- (setq term-terminal-undecoded-bytes
- (substring decoded-substring (- partial)))
- (setq decoded-substring
- (substring decoded-substring 0 (- partial)))
- (cl-decf str-length partial)
- (cl-decf 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)
++ (while (and (< partial count)
++ (eq (char-charset (aref decoded-substring
++ (- count 1 partial)))
++ 'eight-bit))
+ (cl-incf partial))
- (when (> partial 0)
++ (when (> count partial 0)
+ (setq term-terminal-undecoded-bytes
+ (substring decoded-substring (- partial)))
+ (setq decoded-substring
+ (substring decoded-substring 0 (- partial)))
+ (cl-decf str-length partial)
+ (cl-decf funny partial))))
+
+ ;; Insert a string, check how many columns
+ ;; we moved, then delete that many columns
+ ;; following point if not eob nor insert-mode.
+ (let ((old-column (term-horizontal-column))
+ (old-point (point))
+ columns)
+ (unless term-suppress-hard-newline
+ (while (> (+ (length decoded-substring) old-column)
+ term-width)
+ (insert (substring decoded-substring 0
+ (- term-width old-column)))
+ ;; Since we've enough text to fill the whole line,
+ ;; delete previous text regardless of
+ ;; `term-insert-mode's value.
+ (delete-region (point) (line-end-position))
+ (term-down 1 t)
+ (term-move-columns (- (term-current-column)))
+ (add-text-properties (1- (point)) (point)
+ '(term-line-wrap t rear-nonsticky t))
+ (setq decoded-substring
+ (substring decoded-substring (- term-width old-column)))
+ (setq old-column 0)))
+ (insert decoded-substring)
+ (setq term-current-column (current-column)
+ columns (- term-current-column old-column))
+ (when (not (or (eobp) term-insert-mode))
+ (let ((pos (point)))
+ (term-move-columns columns)
+ (delete-region pos (point))
+ (setq term-current-column nil)))
+ ;; In insert mode if the current line
+ ;; has become too long it needs to be
+ ;; chopped off.
+ (when term-insert-mode
+ (let ((pos (point)))
+ (end-of-line)
+ (when (> (current-column) term-width)
+ (delete-region (- (point) (- (current-column) term-width))
+ (point)))
+ (goto-char pos)))
+
+ (put-text-property old-point (point)
+ 'font-lock-face term-current-face))
+ ;; If the last char was written in last column,
+ ;; back up one column, but remember we did so.
+ ;; Thus we emulate xterm/vt100-style line-wrapping.
+ (when (eq (term-current-column) term-width)
+ (term-move-columns -1)
+ ;; We check after ctrl sequence handling if point
+ ;; was moved (and leave line-wrapping state if so).
+ (setq term-do-line-wrapping (point)))
+ (setq term-current-column nil)
+ (setq i funny))
+ (pcase-exhaustive (and (<= ctl-end str-length) (aref str i))
+ (?\t ;; TAB (terminfo: ht)
+ ;; The line cannot exceed term-width. TAB at
+ ;; the end of a line should not cause wrapping.
+ (let ((col (term-current-column)))
+ (term-move-to-column
+ (min (1- term-width)
+ (+ col 8 (- (mod col 8)))))))
+ (?\r ;; (terminfo: cr)
+ (term-vertical-motion 0)
+ (setq term-current-column term-start-line-column))
+ (?\n ;; (terminfo: cud1, ind)
+ (unless (and term-kill-echo-list
+ (term-check-kill-echo-list))
+ (term-down 1 t)))
+ (?\b ;; (terminfo: cub1)
+ (term-move-columns -1))
+ (?\C-g ;; (terminfo: bel)
+ (beep t))
+ (?\032 ; Emacs specific control sequence.
+ (funcall term-command-function
+ (decode-coding-string
+ (substring str (1+ i)
+ (- ctl-end
+ (if (eq (aref str (- ctl-end 2)) ?\r)
+ 2 1)))
+ locale-coding-system t)))
+ (?\e
+ (pcase (aref str (1+ i))
+ (?\[
+ ;; We only handle control sequences with a single
+ ;; "Final" byte (see [ECMA-48] section 5.4).
+ (when (eq ctl-params-end (1- ctl-end))
+ (term-handle-ansi-escape
+ proc
+ (mapcar ;; We don't distinguish empty params
+ ;; from 0 (according to [ECMA-48] we
+ ;; should, but all commands we support
+ ;; default to 0 values anyway).
+ #'string-to-number
+ (split-string ctl-params ";"))
+ (aref str (1- ctl-end)))))
+ (?D ;; Scroll forward (apparently not documented in
+ ;; [ECMA-48], [ctlseqs] mentions it as C1
+ ;; character "Index" though).
+ (term-handle-deferred-scroll)
+ (term-down 1 t))
+ (?M ;; Scroll reversed (terminfo: ri, ECMA-48
+ ;; "Reverse Linefeed").
+ (if (or (< (term-current-row) term-scroll-start)
+ (>= (1- (term-current-row))
+ term-scroll-start))
+ ;; Scrolling up will not move outside
+ ;; the scroll region.
+ (term-down -1)
+ ;; Scrolling the scroll region is needed.
+ (term-down -1 t)))
+ (?7 ;; Save cursor (terminfo: sc, not in [ECMA-48],
+ ;; [ctlseqs] has it as "DECSC").
+ (term-handle-deferred-scroll)
+ (setq term-saved-cursor
+ (list (term-current-row)
+ (term-horizontal-column)
+ term-ansi-current-bg-color
+ term-ansi-current-bold
+ term-ansi-current-color
+ term-ansi-current-invisible
+ term-ansi-current-reverse
+ term-ansi-current-underline
+ term-current-face)))
+ (?8 ;; Restore cursor (terminfo: rc, [ctlseqs]
+ ;; "DECRC").
+ (when term-saved-cursor
+ (term-goto (nth 0 term-saved-cursor)
+ (nth 1 term-saved-cursor))
+ (setq term-ansi-current-bg-color
+ (nth 2 term-saved-cursor)
+ term-ansi-current-bold
+ (nth 3 term-saved-cursor)
+ term-ansi-current-color
+ (nth 4 term-saved-cursor)
+ term-ansi-current-invisible
+ (nth 5 term-saved-cursor)
+ term-ansi-current-reverse
+ (nth 6 term-saved-cursor)
+ term-ansi-current-underline
+ (nth 7 term-saved-cursor)
+ term-current-face
+ (nth 8 term-saved-cursor))))
+ (?c ;; \Ec - Reset (terminfo: rs1, [ctlseqs] "RIS").
+ ;; This is used by the "clear" program.
+ (term-reset-terminal))
+ (?A ;; An \eAnSiT sequence (Emacs specific).
+ (term-handle-ansi-terminal-messages
+ (substring str i ctl-end)))))
+ ;; Ignore NUL, Shift Out, Shift In.
+ ((or ?\0 #xE #xF 'nil) nil))
+ ;; Leave line-wrapping state if point was moved.
+ (unless (eq term-do-line-wrapping (point))
+ (setq term-do-line-wrapping nil))
+ (if (term-handling-pager)
+ (progn
+ ;; Finish stuff to get ready to handle PAGER.
+ (if (> (% (current-column) term-width) 0)
+ (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))
projects / emacs.git / commitdiff