[Top][All Lists]
[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[Emacs-diffs] Changes to emacs/lisp/term.el
|
From: |
Richard M . Stallman |
|
Subject: |
[Emacs-diffs] Changes to emacs/lisp/term.el |
|
Date: |
Mon, 20 Sep 2004 12:06:02 -0400 |
Index: emacs/lisp/term.el
diff -c emacs/lisp/term.el:1.57 emacs/lisp/term.el:1.58
*** emacs/lisp/term.el:1.57 Fri Sep 17 21:07:12 2004
--- emacs/lisp/term.el Mon Sep 20 15:59:31 2004
***************
*** 2635,2948 ****
;;; It emulates (most of the features of) a VT100/ANSI-style terminal.
(defun term-emulate-terminal (proc str)
! (let* ((previous-buffer (current-buffer))
! (i 0) char funny count save-point save-marker old-point temp win
! (selected (selected-window))
! last-win
! (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))
!
! ;; 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 (substring str i funny))
! (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))))
! (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
! ;; 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 "\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 = ?[
;;; 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
! (make-local-variable 'term-terminal-parameter)
! (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)
! (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 ?M) ;; scroll reversed
! (term-insert-lines 1)
! (setq term-terminal-state 0))
! ((eq char ?7) ;; Save cursor
! (term-handle-deferred-scroll)
! (setq term-saved-cursor
! (cons (term-current-row)
! (term-horizontal-column)))
! (setq term-terminal-state 0))
! ((eq char ?8) ;; Restore cursor
! (if term-saved-cursor
! (term-goto (car term-saved-cursor)
! (cdr term-saved-cursor)))
! (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)))))
! (if (term-handling-pager)
! ;; Finish stuff to get ready to handle PAGER.
! (progn
! (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))))
!
! (if (>= (term-current-row) term-height)
! (term-handle-deferred-scroll))
!
! (set-marker (process-mark proc) (point))
! (if save-point
! (progn (goto-char save-point)
! (set-marker save-point nil)))
!
! ;; Check for a pending filename-and-line number to display.
! ;; We do this before scrolling, because we might create a new window.
! (if (and term-pending-frame
! (eq (window-buffer selected) (current-buffer)))
! (progn (term-display-line (car term-pending-frame)
! (cdr term-pending-frame))
! (setq term-pending-frame nil)
! ;; We have created a new window, so check the window size.
! (term-check-size proc)))
!
! ;; Scroll each window displaying the buffer but (by default)
! ;; only if the point matches the process-mark we started with.
! (setq win selected)
! ;; Avoid infinite loop in strange case where minibuffer window
! ;; is selected but not active.
! (while (window-minibuffer-p win)
! (setq win (next-window win nil t)))
! (setq last-win win)
! (while (progn
! (setq win (next-window win nil t))
! (if (eq (window-buffer win) (process-buffer proc))
! (let ((scroll term-scroll-to-bottom-on-output))
! (select-window win)
! (if (or (= (point) save-marker)
! (eq scroll t) (eq scroll 'all)
! ;; Maybe user wants point to jump to the end.
! (and (eq selected win)
! (or (eq scroll 'this) (not save-point)))
! (and (eq scroll 'others)
! (not (eq selected win))))
! (progn
! (goto-char term-home-marker)
! (recenter 0)
! (goto-char (process-mark proc))
! (if (not (pos-visible-in-window-p (point) win))
! (recenter -1))))
! ;; Optionally scroll so that the text
! ;; ends at the bottom of the window.
! (if (and term-scroll-show-maximum-output
! (>= (point) (process-mark proc)))
! (save-excursion
! (goto-char (point-max))
! (recenter -1)))))
! (not (eq win last-win))))
;;; Stolen from comint.el and adapted -mm
! (if (> term-buffer-maximum-size 0)
! (save-excursion
! (goto-char (process-mark (get-buffer-process
(current-buffer))))
! (forward-line (- term-buffer-maximum-size))
! (beginning-of-line)
! (delete-region (point-min) (point))))
;;;
! (set-marker save-marker nil))
! ;; unwind-protect cleanup-forms follow:
! (set-buffer previous-buffer)
! (select-window selected))))
(defun term-handle-deferred-scroll ()
(let ((count (- (term-current-row) term-height)))
--- 2635,2944 ----
;;; It emulates (most of the features of) a VT100/ANSI-style terminal.
(defun term-emulate-terminal (proc str)
! (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 '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))
!
! ;; 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 (substring str i funny))
! (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))))
! (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
! ;; 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 "\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 = ?[
;;; 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
! (make-local-variable 'term-terminal-parameter)
! (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)
! (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 ?M) ;; scroll reversed
! (term-insert-lines 1)
! (setq term-terminal-state 0))
! ((eq char ?7) ;; Save cursor
! (term-handle-deferred-scroll)
! (setq term-saved-cursor
! (cons (term-current-row)
! (term-horizontal-column)))
! (setq term-terminal-state 0))
! ((eq char ?8) ;; Restore cursor
! (if term-saved-cursor
! (term-goto (car term-saved-cursor)
! (cdr term-saved-cursor)))
! (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)))))
! (if (term-handling-pager)
! ;; Finish stuff to get ready to handle PAGER.
! (progn
! (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))))
!
! (if (>= (term-current-row) term-height)
! (term-handle-deferred-scroll))
!
! (set-marker (process-mark proc) (point))
! (if save-point
! (progn (goto-char save-point)
! (set-marker save-point nil)))
!
! ;; Check for a pending filename-and-line number to display.
! ;; We do this before scrolling, because we might create a new window.
! (if (and term-pending-frame
! (eq (window-buffer selected) (current-buffer)))
! (progn (term-display-line (car term-pending-frame)
! (cdr term-pending-frame))
! (setq term-pending-frame nil)
! ;; We have created a new window, so check the window size.
! (term-check-size proc)))
!
! ;; Scroll each window displaying the buffer but (by default)
! ;; only if the point matches the process-mark we started with.
! (setq win selected)
! ;; Avoid infinite loop in strange case where minibuffer window
! ;; is selected but not active.
! (while (window-minibuffer-p win)
! (setq win (next-window win nil t)))
! (setq last-win win)
! (while (progn
! (setq win (next-window win nil t))
! (if (eq (window-buffer win) (process-buffer proc))
! (let ((scroll term-scroll-to-bottom-on-output))
! (select-window win)
! (if (or (= (point) save-marker)
! (eq scroll t) (eq scroll 'all)
! ;; Maybe user wants point to jump to the end.
! (and (eq selected win)
! (or (eq scroll 'this) (not save-point)))
! (and (eq scroll 'others)
! (not (eq selected win))))
! (progn
! (goto-char term-home-marker)
! (recenter 0)
! (goto-char (process-mark proc))
! (if (not (pos-visible-in-window-p (point) win))
! (recenter -1))))
! ;; Optionally scroll so that the text
! ;; ends at the bottom of the window.
! (if (and term-scroll-show-maximum-output
! (>= (point) (process-mark proc)))
! (save-excursion
! (goto-char (point-max))
! (recenter -1)))))
! (not (eq win last-win))))
;;; Stolen from comint.el and adapted -mm
! (if (> term-buffer-maximum-size 0)
! (save-excursion
! (goto-char (process-mark (get-buffer-process (current-buffer))))
! (forward-line (- term-buffer-maximum-size))
! (beginning-of-line)
! (delete-region (point-min) (point))))
;;;
! (set-marker save-marker nil)))))
(defun term-handle-deferred-scroll ()
(let ((count (- (term-current-row) term-height)))