- (let* ((previous-buffer (current-buffer))
- (i 0) char funny count save-point save-marker old-point temp win
- (selected (selected-window))
- (str-length (length str)))
- (unwind-protect
- (progn
- (set-buffer (process-buffer proc))
-
-;;; Let's handle the messages. -mm
-
- (setq str (term-handle-ansi-terminal-messages str))
- (setq str-length (length str))
-
- (if (marker-buffer term-pending-delete-marker)
- (progn
- ;; Delete text following term-pending-delete-marker.
- (delete-region term-pending-delete-marker (process-mark proc))
- (set-marker term-pending-delete-marker nil)))
-
- (if (eq (window-buffer) (current-buffer))
- (progn
- (setq term-vertical-motion (symbol-function 'vertical-motion))
- (term-check-size proc))
- (setq term-vertical-motion
- (symbol-function 'buffer-vertical-motion)))
-
- (setq save-marker (copy-marker (process-mark proc)))
-
- (if (/= (point) (process-mark proc))
- (progn (setq save-point (point-marker))
- (goto-char (process-mark proc))))
-
- (save-restriction
- ;; If the buffer is in line mode, and there is a partial
- ;; input line, save the line (by narrowing to leave it
- ;; outside the restriction ) until we're done with output.
- (if (and (> (point-max) (process-mark proc))
- (term-in-line-mode))
- (narrow-to-region (point-min) (process-mark proc)))
-
- (if term-log-buffer
- (princ str term-log-buffer))
- (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))
- (if (not funny) (setq funny str-length))
- (cond ((> funny i)
- (cond ((eq term-terminal-state 1)
- (term-move-columns 1)
- (setq term-terminal-state 0)))
- (setq count (- funny i))
- (setq temp (- (+ (term-horizontal-column) count)
- term-width))
- (cond ((<= temp 0)) ;; All count chars fit in line.
- ((> count temp) ;; Some chars fit.
- ;; This iteration, handle only what fits.
- (setq count (- count temp))
- (setq funny (+ count 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 funny (+ count 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))
- ;; In the common case that we're at the end of
- ;; the buffer, we can save a little work.
- (cond ((/= (point) (point-max))
- (if term-insert-mode
- ;; Inserting spaces, then deleting them,
- ;; then inserting the actual text is
- ;; inefficient, but it is simple, and
- ;; the actual overhead is miniscule.
- (term-insert-spaces count))
- (term-move-columns count)
- (delete-region old-point (point)))
- (t (setq term-current-column (+ (term-current-column) count))))
- (insert (substring str i funny))
- (put-text-property old-point (point)
- '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
- ;; FIXME: Does not handle line wrap!
- (setq count (term-current-column))
- (setq count (+ count 8 (- (mod count 8))))
- (if (< (move-to-column count nil) count)
- (term-insert-char char 1))
- (setq term-current-column count))
- ((eq char ?\r)
- ;; Optimize CRLF at end of buffer:
- (cond ((and (< (setq temp (1+ i)) str-length)
- (eq (aref str temp) ?\n)
- (= (point) (point-max))
- (not (or term-pager-count
- term-kill-echo-list
- term-scroll-with-delete)))
- (insert ?\n)
- (term-adjust-current-row-cache 1)
- (setq term-start-line-column 0)
- (setq term-current-column 0)
- (setq i temp))
- (t ;; Not followed by LF or can't optimize:
- (term-vertical-motion 0)
- (setq term-current-column term-start-line-column))))
- ((eq char ?\n)
- (if (not (and term-kill-echo-list
- (term-check-kill-echo-list)))
- (term-down 1 t)))
- ((eq char ?\b)
- (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)
- (beep t)) ; Bell
- ((eq char ?\032)
- (let ((end (string-match "\n" str i)))
- (if end
- (progn (funcall term-command-hook
- (substring str (1+ i) (1- end)))
- (setq i end))
- (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 = ?[
+ (with-current-buffer (process-buffer proc)
+ (let* ((i 0) char funny count save-point save-marker old-point temp win
+ (buffer-undo-list t)
+ (selected (selected-window))
+ last-win
+ (str-length (length str)))
+ (save-selected-window
+
+ ;; Let's handle the messages. -mm
+
+ (setq str (term-handle-ansi-terminal-messages str))
+ (setq str-length (length str))
+
+ (if (marker-buffer term-pending-delete-marker)
+ (progn
+ ;; Delete text following term-pending-delete-marker.
+ (delete-region term-pending-delete-marker (process-mark proc))
+ (set-marker term-pending-delete-marker nil)))
+
+ (if (eq (window-buffer) (current-buffer))
+ (progn
+ (setq term-vertical-motion (symbol-function 'vertical-motion))
+ (term-check-size proc))
+ (setq term-vertical-motion
+ (symbol-function 'term-buffer-vertical-motion)))
+
+ (setq save-marker (copy-marker (process-mark proc)))
+
+ (if (/= (point) (process-mark proc))
+ (progn (setq save-point (point-marker))
+ (goto-char (process-mark proc))))
+
+ (save-restriction
+ ;; If the buffer is in line mode, and there is a partial
+ ;; input line, save the line (by narrowing to leave it
+ ;; outside the restriction ) until we're done with output.
+ (if (and (> (point-max) (process-mark proc))
+ (term-in-line-mode))
+ (narrow-to-region (point-min) (process-mark proc)))
+
+ (if term-log-buffer
+ (princ str term-log-buffer))
+ (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))
+ (if (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)
+ (term-move-columns (- (term-current-column)))
+ (setq term-terminal-state 0)))
+ (setq count (- funny i))
+ (setq temp (- (+ (term-horizontal-column) count)
+ term-width))
+ (cond ((<= temp 0)) ;; All count chars fit in line.
+ ((> count temp) ;; Some chars fit.
+ ;; This iteration, handle only what fits.
+ (setq count (- count temp))
+ (setq temp 0)
+ (setq funny (+ count 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 funny (+ count 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 if the 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)
+ '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)
+ ;; Optimize CRLF at end of buffer:
+ (cond ((and (< (setq temp (1+ i)) str-length)
+ (eq (aref str temp) ?\n)
+ (= (point) (point-max))
+ (not (or term-pager-count
+ term-kill-echo-list
+ term-scroll-with-delete)))
+ (insert ?\n)
+ (term-adjust-current-row-cache 1)
+ (setq term-start-line-column 0)
+ (setq term-current-column 0)
+ (setq i temp))
+ (t ;; Not followed by LF or can't optimize:
+ (term-vertical-motion 0)
+ (setq term-current-column term-start-line-column))))
+ ((eq char ?\n)
+ (if (not (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)
+ (beep t)) ; Bell
+ ((eq char ?\032)
+ (let ((end (string-match "\r?$" str i)))
+ (if end
+ (funcall term-command-hook
+ (prog1 (substring str (1+ i) end)
+ (setq i (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 = ?[