/[emacs]/emacs/lisp/term.el
ViewVC logotype

Diff of /emacs/lisp/term.el

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1.49.6.4 by miles, Thu Sep 9 09:36:32 2004 UTC revision 1.49.6.5 by miles, Tue Sep 21 09:34:09 2004 UTC
# Line 396  Line 396 
396    
397  ;; This is passed to the inferior in the EMACS environment variable,  ;; This is passed to the inferior in the EMACS environment variable,
398  ;; so it is important to increase it if there are protocol-relevant changes.  ;; so it is important to increase it if there are protocol-relevant changes.
399  (defconst term-protocol-version "0.95")  (defconst term-protocol-version "0.96")
400    
401  (eval-when-compile  (eval-when-compile
402    (require 'ange-ftp))    (require 'ange-ftp))
# Line 457  Line 457 
457  ;;              we want suppressed.  ;;              we want suppressed.
458  (defvar term-terminal-parameter)  (defvar term-terminal-parameter)
459  (defvar term-terminal-previous-parameter)  (defvar term-terminal-previous-parameter)
460  (defvar term-current-face 'term-default)  (defvar term-current-face 'default)
461  (defvar term-scroll-start 0) ;; Top-most line (inclusive) of scrolling region.  (defvar term-scroll-start 0) ;; Top-most line (inclusive) of scrolling region.
462  (defvar term-scroll-end) ;; Number of line (zero-based) after scrolling region.  (defvar term-scroll-end) ;; Number of line (zero-based) after scrolling region.
463  (defvar term-pager-count nil) ;; If nil, paging is disabled.  (defvar term-pager-count nil) ;; If nil, paging is disabled.
# Line 1363  The main purpose is to get rid of the lo Line 1363  The main purpose is to get rid of the lo
1363  (defvar term-termcap-format  (defvar term-termcap-format
1364    "%s%s:li#%d:co#%d:cl=\\E[H\\E[J:cd=\\E[J:bs:am:xn:cm=\\E[%%i%%d;%%dH\    "%s%s:li#%d:co#%d:cl=\\E[H\\E[J:cd=\\E[J:bs:am:xn:cm=\\E[%%i%%d;%%dH\
1365  :nd=\\E[C:up=\\E[A:ce=\\E[K:ho=\\E[H:pt\  :nd=\\E[C:up=\\E[A:ce=\\E[K:ho=\\E[H:pt\
1366  :al=\\E[L:dl=\\E[M:DL=\\E[%%dM:AL=\\E[%%dL:cs=\\E[%%i%%d;%%dr:sf=\\n\  :al=\\E[L:dl=\\E[M:DL=\\E[%%dM:AL=\\E[%%dL:cs=\\E[%%i%%d;%%dr:sf=^J\
1367  :te=\\E[2J\\E[?47l\\E8:ti=\\E7\\E[?47h\  :te=\\E[2J\\E[?47l\\E8:ti=\\E7\\E[?47h\
1368  :dc=\\E[P:DC=\\E[%%dP:IC=\\E[%%d@:im=\\E[4h:ei=\\E[4l:mi:\  :dc=\\E[P:DC=\\E[%%dP:IC=\\E[%%d@:im=\\E[4h:ei=\\E[4l:mi:\
1369  :so=\\E[7m:se=\\E[m:us=\\E[4m:ue=\\E[m:md=\\E[1m:mr=\\E[7m:me=\\E[m\  :so=\\E[7m:se=\\E[m:us=\\E[4m:ue=\\E[m:md=\\E[1m:mr=\\E[7m:me=\\E[m\
1370  :UP=\\E[%%dA:DO=\\E[%%dB:LE=\\E[%%dD:RI=\\E[%%dC"  :UP=\\E[%%dA:DO=\\E[%%dB:LE=\\E[%%dD:RI=\\E[%%dC\
1371    :kl=\\EOD:kd=\\EOB:kr=\\EOC:ku=\\EOA:kN=\\E[6~:kP=\\E[5~:@7=\\E[4~:kh=\\E[1~\
1372    :mk=\\E[8m:cb=\\E[1K:op=\\E[39;49m:Co#8:pa#64:AB=\\E[4%%dm:AF=\\E[3%%dm:cr=^M\
1373    :bl=^G:do=^J:le=^H:ta=^I:se=\E[27m:ue=\E24m:"
1374  ;;; : -undefine ic  ;;; : -undefine ic
1375    "termcap capabilities supported")    "termcap capabilities supported")
1376    
# Line 1384  The main purpose is to get rid of the lo Line 1387  The main purpose is to get rid of the lo
1387           (nconc           (nconc
1388            (list            (list
1389             (format "TERM=%s" term-term-name)             (format "TERM=%s" term-term-name)
1390             (if (and (boundp 'system-uses-terminfo) system-uses-terminfo)             (format "TERMINFO=%s" data-directory)
1391                 (format "TERMINFO=%s" data-directory)             (format term-termcap-format "TERMCAP="
1392              (format term-termcap-format "TERMCAP="                     term-term-name term-height term-width)
                     term-term-name term-height term-width))  
1393             ;; Breaks `./configure' of w3 and url which try to run $EMACS.             ;; Breaks `./configure' of w3 and url which try to run $EMACS.
1394             (format "EMACS=%s (term:%s)" emacs-version term-protocol-version)             (format "EMACS=%s (term:%s)" emacs-version term-protocol-version)
1395             (format "LINES=%d" term-height)             (format "LINES=%d" term-height)
# Line 1407  if [ $1 = .. ]; then shift; fi; exec \"$ Line 1409  if [ $1 = .. ]; then shift; fi; exec \"$
1409             ".."             ".."
1410             command switches)))             command switches)))
1411    
 ;;; This should be in Emacs, but it isn't.  
 (defun term-mem (item list &optional elt=)  
   "Test to see if ITEM is equal to an item in LIST.  
 Option comparison function ELT= defaults to equal."  
   (let ((elt= (or elt= (function equal)))  
         (done nil))  
     (while (and list (not done))  
       (if (funcall elt= item (car list))  
           (setq done list)  
           (setq list (cdr list))))  
     done))  
   
1412    
1413  ;;; Input history processing in a buffer  ;;; Input history processing in a buffer
1414  ;;; ===========================================================================  ;;; ===========================================================================
# Line 2643  See `term-prompt-regexp'." Line 2633  See `term-prompt-regexp'."
2633  ;;; It emulates (most of the features of) a VT100/ANSI-style terminal.  ;;; It emulates (most of the features of) a VT100/ANSI-style terminal.
2634    
2635  (defun term-emulate-terminal (proc str)  (defun term-emulate-terminal (proc str)
2636    (let* ((previous-buffer (current-buffer))    (with-current-buffer (process-buffer proc)
2637           (i 0) char funny count save-point save-marker old-point temp win      (let* ((i 0) char funny count save-point save-marker old-point temp win
2638           (selected (selected-window))             (buffer-undo-list t)
2639           last-win             (selected (selected-window))
2640           (str-length (length str)))             last-win
2641      (unwind-protect             (str-length (length str)))
2642          (progn        (save-selected-window
           (set-buffer (process-buffer proc))  
2643    
2644  ;;; Let's handle the messages. -mm          ;; Let's handle the messages. -mm
2645    
2646            (setq str (term-handle-ansi-terminal-messages str))          (setq str (term-handle-ansi-terminal-messages str))
2647            (setq str-length (length str))          (setq str-length (length str))
2648    
2649            (if (marker-buffer term-pending-delete-marker)          (if (marker-buffer term-pending-delete-marker)
2650                (progn              (progn
2651                  ;; Delete text following term-pending-delete-marker.                ;; Delete text following term-pending-delete-marker.
2652                  (delete-region term-pending-delete-marker (process-mark proc))                (delete-region term-pending-delete-marker (process-mark proc))
2653                  (set-marker term-pending-delete-marker nil)))                (set-marker term-pending-delete-marker nil)))
2654    
2655            (if (eq (window-buffer) (current-buffer))          (if (eq (window-buffer) (current-buffer))
2656                (progn              (progn
2657                  (setq term-vertical-motion (symbol-function 'vertical-motion))                (setq term-vertical-motion (symbol-function 'vertical-motion))
2658                  (term-check-size proc))                (term-check-size proc))
2659              (setq term-vertical-motion            (setq term-vertical-motion
2660                    (symbol-function 'buffer-vertical-motion)))                  (symbol-function 'buffer-vertical-motion)))
2661    
2662            (setq save-marker (copy-marker (process-mark proc)))          (setq save-marker (copy-marker (process-mark proc)))
2663    
2664            (if (/= (point) (process-mark proc))          (if (/= (point) (process-mark proc))
2665                (progn (setq save-point (point-marker))              (progn (setq save-point (point-marker))
2666                       (goto-char (process-mark proc))))                     (goto-char (process-mark proc))))
2667    
2668            (save-restriction          (save-restriction
2669              ;; If the buffer is in line mode, and there is a partial            ;; If the buffer is in line mode, and there is a partial
2670              ;; input line, save the line (by narrowing to leave it            ;; input line, save the line (by narrowing to leave it
2671              ;; outside the restriction ) until we're done with output.            ;; outside the restriction ) until we're done with output.
2672              (if (and (> (point-max) (process-mark proc))            (if (and (> (point-max) (process-mark proc))
2673                       (term-in-line-mode))                     (term-in-line-mode))
2674                  (narrow-to-region (point-min) (process-mark proc)))                (narrow-to-region (point-min) (process-mark proc)))
2675    
2676              (if term-log-buffer            (if term-log-buffer
2677                  (princ str term-log-buffer))                (princ str term-log-buffer))
2678              (cond ((eq term-terminal-state 4) ;; Have saved pending output.            (cond ((eq term-terminal-state 4) ;; Have saved pending output.
2679                     (setq str (concat term-terminal-parameter str))                   (setq str (concat term-terminal-parameter str))
2680                     (setq term-terminal-parameter nil)                   (setq term-terminal-parameter nil)
2681                     (setq str-length (length str))                   (setq str-length (length str))
2682                     (setq term-terminal-state 0)))                   (setq term-terminal-state 0)))
2683    
2684              (while (< i str-length)            (while (< i str-length)
2685                (setq char (aref str i))              (setq char (aref str i))
2686                (cond ((< term-terminal-state 2)              (cond ((< term-terminal-state 2)
2687                       ;; Look for prefix of regular chars                     ;; Look for prefix of regular chars
2688                       (setq funny                     (setq funny
2689                             (string-match "[\r\n\000\007\033\t\b\032\016\017]"                           (string-match "[\r\n\000\007\033\t\b\032\016\017]"
2690                                           str i))                                         str i))
2691                       (if (not funny) (setq funny str-length))                     (if (not funny) (setq funny str-length))
2692                       (cond ((> funny i)                     (cond ((> funny i)
2693                              (cond ((eq term-terminal-state 1)                            (cond ((eq term-terminal-state 1)
2694                                     (term-move-columns 1)                                   (term-move-columns 1)
2695                                     (setq term-terminal-state 0)))                                   (setq term-terminal-state 0)))
2696                              (setq count (- funny i))                            (setq count (- funny i))
2697                              (setq temp (- (+ (term-horizontal-column) count)                            (setq temp (- (+ (term-horizontal-column) count)
2698                                            term-width))                                          term-width))
2699                              (cond ((<= temp 0)) ;; All count chars fit in line.                            (cond ((<= temp 0)) ;; All count chars fit in line.
2700                                    ((> count temp) ;; Some chars fit.                                  ((> count temp) ;; Some chars fit.
2701                                     ;; This iteration, handle only what fits.                                   ;; This iteration, handle only what fits.
2702                                     (setq count (- count temp))                                   (setq count (- count temp))
2703                                     (setq funny (+ count i)))                                   (setq funny (+ count i)))
2704                                    ((or (not (or term-pager-count                                  ((or (not (or term-pager-count
2705                                                  term-scroll-with-delete))                                                term-scroll-with-delete))
2706                                         (>  (term-handle-scroll 1) 0))                                       (>  (term-handle-scroll 1) 0))
2707                                     (term-adjust-current-row-cache 1)                                   (term-adjust-current-row-cache 1)
2708                                     (setq count (min count term-width))                                   (setq count (min count term-width))
2709                                     (setq funny (+ count i))                                   (setq funny (+ count i))
2710                                     (setq term-start-line-column                                   (setq term-start-line-column
2711                                           term-current-column))                                         term-current-column))
2712                                    (t ;; Doing PAGER processing.                                  (t ;; Doing PAGER processing.
2713                                     (setq count 0 funny i)                                   (setq count 0 funny i)
2714                                     (setq term-current-column nil)                                   (setq term-current-column nil)
2715                                     (setq term-start-line-column nil)))                                   (setq term-start-line-column nil)))
2716                              (setq old-point (point))                            (setq old-point (point))
2717    
2718                              ;; Insert a string, check how many columns                            ;; Insert a string, check how many columns
2719                              ;; we moved, then delete that many columns                            ;; we moved, then delete that many columns
2720                              ;; following point if not eob nor insert-mode.                            ;; following point if not eob nor insert-mode.
2721                              (let ((old-column (current-column))                            (let ((old-column (current-column))
2722                                    columns pos)                                  columns pos)
2723                                (insert (substring str i funny))                              (insert (substring str i funny))
2724                                (setq term-current-column (current-column)                              (setq term-current-column (current-column)
2725                                      columns (- term-current-column old-column))                                    columns (- term-current-column old-column))
2726                                (when (not (or (eobp) term-insert-mode))                              (when (not (or (eobp) term-insert-mode))
2727                                  (setq pos (point))                                (setq pos (point))
2728                                  (term-move-columns columns)                                (term-move-columns columns)
2729                                  (delete-region pos (point))))                                (delete-region pos (point))))
2730                              (setq term-current-column nil)                            (setq term-current-column nil)
2731    
2732                              (put-text-property old-point (point)                            (put-text-property old-point (point)
2733                                                 'face term-current-face)                                               'face term-current-face)
2734                              ;; If the last char was written in last column,                            ;; If the last char was written in last column,
2735                              ;; back up one column, but remember we did so.                            ;; back up one column, but remember we did so.
2736                              ;; Thus we emulate xterm/vt100-style line-wrapping.                            ;; Thus we emulate xterm/vt100-style line-wrapping.
2737                              (cond ((eq temp 0)                            (cond ((eq temp 0)
2738                                     (term-move-columns -1)                                   (term-move-columns -1)
2739                                     (setq term-terminal-state 1)))                                   (setq term-terminal-state 1)))
2740                              (setq i (1- funny)))                            (setq i (1- funny)))
2741                             ((and (setq term-terminal-state 0)                           ((and (setq term-terminal-state 0)
2742                              (eq char ?\^I)) ; TAB                                 (eq char ?\^I)) ; TAB
2743                              ;; FIXME:  Does not handle line wrap!                            ;; FIXME:  Does not handle line wrap!
2744                              (setq count (term-current-column))                            (setq count (term-current-column))
2745                              (setq count (+ count 8 (- (mod count 8))))                            (setq count (+ count 8 (- (mod count 8))))
2746                              (if (< (move-to-column count nil) count)                            (if (< (move-to-column count nil) count)
2747                                  (term-insert-char char 1))                                (term-insert-char char 1))
2748                              (setq term-current-column count))                            (setq term-current-column count))
2749                             ((eq char ?\r)                           ((eq char ?\r)
2750                              ;; Optimize CRLF at end of buffer:                            ;; Optimize CRLF at end of buffer:
2751                              (cond ((and (< (setq temp (1+ i)) str-length)                            (cond ((and (< (setq temp (1+ i)) str-length)
2752                                          (eq (aref str temp) ?\n)                                        (eq (aref str temp) ?\n)
2753                                          (= (point) (point-max))                                        (= (point) (point-max))
2754                                          (not (or term-pager-count                                        (not (or term-pager-count
2755                                                   term-kill-echo-list                                                 term-kill-echo-list
2756                                                   term-scroll-with-delete)))                                                 term-scroll-with-delete)))
2757                                     (insert ?\n)                                   (insert ?\n)
2758                                     (term-adjust-current-row-cache 1)                                   (term-adjust-current-row-cache 1)
2759                                     (setq term-start-line-column 0)                                   (setq term-start-line-column 0)
2760                                     (setq term-current-column 0)                                   (setq term-current-column 0)
2761                                     (setq i temp))                                   (setq i temp))
2762                                    (t ;; Not followed by LF or can't optimize:                                  (t ;; Not followed by LF or can't optimize:
2763                                     (term-vertical-motion 0)                                   (term-vertical-motion 0)
2764                                     (setq term-current-column term-start-line-column))))                                   (setq term-current-column term-start-line-column))))
2765                             ((eq char ?\n)                           ((eq char ?\n)
2766                              (if (not (and term-kill-echo-list                            (if (not (and term-kill-echo-list
2767                                            (term-check-kill-echo-list)))                                          (term-check-kill-echo-list)))
2768                                  (term-down 1 t)))                                (term-down 1 t)))
2769                             ((eq char ?\b)                           ((eq char ?\b)
2770                              (term-move-columns -1))                            (term-move-columns -1))
2771                             ((eq char ?\033) ; Escape                           ((eq char ?\033) ; Escape
2772                              (setq term-terminal-state 2))                            (setq term-terminal-state 2))
2773                             ((eq char 0)) ; NUL: Do nothing                           ((eq char 0))         ; NUL: Do nothing
2774                             ((eq char ?\016)) ; Shift Out - ignored                           ((eq char ?\016))     ; Shift Out - ignored
2775                             ((eq char ?\017)) ; Shift In - ignored                           ((eq char ?\017))     ; Shift In - ignored
2776                             ((eq char ?\^G)                           ((eq char ?\^G)
2777                              (beep t)) ; Bell                            (beep t))     ; Bell
2778                             ((eq char ?\032)                           ((eq char ?\032)
2779                              (let ((end (string-match "\r?$" str i)))                            (let ((end (string-match "\r?$" str i)))
2780                                (if end                              (if end
2781                                    (funcall term-command-hook                                  (funcall term-command-hook
2782                                             (prog1 (substring str (1+ i) end)                                           (prog1 (substring str (1+ i) end)
2783                                               (setq i (match-end 0))))                                             (setq i (match-end 0))))
2784                                  (setq term-terminal-parameter                                (setq term-terminal-parameter
2785                                        (substring str i))                                      (substring str i))
2786                                  (setq term-terminal-state 4)                                (setq term-terminal-state 4)
2787                                  (setq i str-length))))                                (setq i str-length))))
2788                             (t ; insert char FIXME: Should never happen                           (t   ; insert char FIXME: Should never happen
2789                              (term-move-columns 1)                            (term-move-columns 1)
2790                              (backward-delete-char 1)                            (backward-delete-char 1)
2791                              (insert char))))                            (insert char))))
2792                      ((eq term-terminal-state 2) ; Seen Esc                    ((eq term-terminal-state 2)     ; Seen Esc
2793                       (cond ((eq char ?\133) ;; ?\133 = ?[                     (cond ((eq char ?\133)         ;; ?\133 = ?[
2794    
2795  ;;; Some modifications to cope with multiple settings like ^[[01;32;43m -mm  ;;; Some modifications to cope with multiple settings like ^[[01;32;43m -mm
2796  ;;; Note that now the init value of term-terminal-previous-parameter has  ;;; Note that now the init value of term-terminal-previous-parameter has
2797  ;;; been changed to -1  ;;; been changed to -1
2798    
2799                              (make-local-variable 'term-terminal-parameter)                            (make-local-variable 'term-terminal-parameter)
2800                              (make-local-variable 'term-terminal-previous-parameter)                            (make-local-variable 'term-terminal-previous-parameter)
2801                              (make-local-variable 'term-terminal-previous-parameter-2)                            (make-local-variable 'term-terminal-previous-parameter-2)
2802                              (make-local-variable 'term-terminal-previous-parameter-3)                            (make-local-variable 'term-terminal-previous-parameter-3)
2803                              (make-local-variable 'term-terminal-previous-parameter-4)                            (make-local-variable 'term-terminal-previous-parameter-4)
2804                              (make-local-variable 'term-terminal-more-parameters)                            (make-local-variable 'term-terminal-more-parameters)
2805                              (setq term-terminal-parameter 0)                            (setq term-terminal-parameter 0)
2806                              (setq term-terminal-previous-parameter -1)                            (setq term-terminal-previous-parameter -1)
2807                              (setq term-terminal-previous-parameter-2 -1)                            (setq term-terminal-previous-parameter-2 -1)
2808                              (setq term-terminal-previous-parameter-3 -1)                            (setq term-terminal-previous-parameter-3 -1)
2809                              (setq term-terminal-previous-parameter-4 -1)                            (setq term-terminal-previous-parameter-4 -1)
2810                              (setq term-terminal-more-parameters 0)                            (setq term-terminal-more-parameters 0)
2811                              (setq term-terminal-state 3))                            (setq term-terminal-state 3))
2812                             ((eq char ?D) ;; scroll forward                           ((eq char ?D) ;; scroll forward
2813                              (term-handle-deferred-scroll)                            (term-handle-deferred-scroll)
2814                              (term-down 1 t)                            (term-down 1 t)
2815                              (setq term-terminal-state 0))                            (setq term-terminal-state 0))
2816                             ((eq char ?M) ;; scroll reversed                           ((eq char ?M) ;; scroll reversed
2817                              (term-insert-lines 1)                            (term-insert-lines 1)
2818                              (setq term-terminal-state 0))                            (setq term-terminal-state 0))
2819                             ((eq char ?7) ;; Save cursor                           ((eq char ?7) ;; Save cursor
2820                              (term-handle-deferred-scroll)                            (term-handle-deferred-scroll)
2821                              (setq term-saved-cursor                            (setq term-saved-cursor
2822                                    (cons (term-current-row)                                  (cons (term-current-row)
2823                                          (term-horizontal-column)))                                        (term-horizontal-column)))
2824                              (setq term-terminal-state 0))                            (setq term-terminal-state 0))
2825                             ((eq char ?8) ;; Restore cursor                           ((eq char ?8) ;; Restore cursor
2826                              (if term-saved-cursor                            (if term-saved-cursor
2827                                  (term-goto (car term-saved-cursor)                                (term-goto (car term-saved-cursor)
2828                                             (cdr term-saved-cursor)))                                           (cdr term-saved-cursor)))
2829                              (setq term-terminal-state 0))                            (setq term-terminal-state 0))
2830                             ((setq term-terminal-state 0))))                           ((setq term-terminal-state 0))))
2831                      ((eq term-terminal-state 3) ; Seen Esc [                    ((eq term-terminal-state 3) ; Seen Esc [
2832                       (cond ((and (>= char ?0) (<= char ?9))                     (cond ((and (>= char ?0) (<= char ?9))
2833                              (setq term-terminal-parameter                            (setq term-terminal-parameter
2834                                    (+ (* 10 term-terminal-parameter) (- char ?0))))                                  (+ (* 10 term-terminal-parameter) (- char ?0))))
2835                             ((eq char ?\;)                           ((eq char ?\;)
2836  ;;; Some modifications to cope with multiple settings like ^[[01;32;43m -mm  ;;; Some modifications to cope with multiple settings like ^[[01;32;43m -mm
2837                              (setq term-terminal-more-parameters 1)                            (setq term-terminal-more-parameters 1)
2838                              (setq term-terminal-previous-parameter-4                            (setq term-terminal-previous-parameter-4
2839                                            term-terminal-previous-parameter-3)                                  term-terminal-previous-parameter-3)
2840                              (setq term-terminal-previous-parameter-3                            (setq term-terminal-previous-parameter-3
2841                                            term-terminal-previous-parameter-2)                                  term-terminal-previous-parameter-2)
2842                              (setq term-terminal-previous-parameter-2                            (setq term-terminal-previous-parameter-2
2843                                            term-terminal-previous-parameter)                                  term-terminal-previous-parameter)
2844                              (setq term-terminal-previous-parameter                            (setq term-terminal-previous-parameter
2845                                            term-terminal-parameter)                                  term-terminal-parameter)
2846                              (setq term-terminal-parameter 0))                            (setq term-terminal-parameter 0))
2847                             ((eq char ??)) ; Ignore ?                           ((eq char ??)) ; Ignore ?
2848                             (t                           (t
2849                              (term-handle-ansi-escape proc char)                            (term-handle-ansi-escape proc char)
2850                              (setq term-terminal-more-parameters 0)                            (setq term-terminal-more-parameters 0)
2851                              (setq term-terminal-previous-parameter-4 -1)                            (setq term-terminal-previous-parameter-4 -1)
2852                              (setq term-terminal-previous-parameter-3 -1)                            (setq term-terminal-previous-parameter-3 -1)
2853                              (setq term-terminal-previous-parameter-2 -1)                            (setq term-terminal-previous-parameter-2 -1)
2854                              (setq term-terminal-previous-parameter -1)                            (setq term-terminal-previous-parameter -1)
2855                              (setq term-terminal-state 0)))))                            (setq term-terminal-state 0)))))
2856                (if (term-handling-pager)              (if (term-handling-pager)
2857                    ;; Finish stuff to get ready to handle PAGER.                  ;; Finish stuff to get ready to handle PAGER.
2858                    (progn                  (progn
2859                      (if (> (% (current-column) term-width) 0)                    (if (> (% (current-column) term-width) 0)
2860                          (setq term-terminal-parameter
2861                                (substring str i))
2862                        ;; We're at column 0.  Goto end of buffer; to compensate,
2863                        ;; prepend a ?\r for later.  This looks more consistent.
2864                        (if (zerop i)
2865                          (setq term-terminal-parameter                          (setq term-terminal-parameter
2866                                (substring str i))                                (concat "\r" (substring str i)))
2867                        ;; We're at column 0.  Goto end of buffer; to compensate,                        (setq term-terminal-parameter (substring str (1- i)))
2868                        ;; prepend a ?\r for later.  This looks more consistent.                        (aset term-terminal-parameter 0 ?\r))
2869                        (if (zerop i)                      (goto-char (point-max)))
2870                            (setq term-terminal-parameter                    (setq term-terminal-state 4)
2871                                  (concat "\r" (substring str i)))                    (make-local-variable 'term-pager-old-filter)
2872                          (setq term-terminal-parameter (substring str (1- i)))                    (setq term-pager-old-filter (process-filter proc))
2873                          (aset term-terminal-parameter 0 ?\r))                    (set-process-filter proc term-pager-filter)
2874                        (goto-char (point-max)))                    (setq i str-length)))
2875                      (setq term-terminal-state 4)              (setq i (1+ i))))
2876                      (make-local-variable 'term-pager-old-filter)  
2877                      (setq term-pager-old-filter (process-filter proc))          (if (>= (term-current-row) term-height)
2878                      (set-process-filter proc term-pager-filter)              (term-handle-deferred-scroll))
2879                      (setq i str-length)))  
2880                (setq i (1+ i))))          (set-marker (process-mark proc) (point))
2881            (if save-point
2882            (if (>= (term-current-row) term-height)              (progn (goto-char save-point)
2883                (term-handle-deferred-scroll))                     (set-marker save-point nil)))
2884    
2885            (set-marker (process-mark proc) (point))          ;; Check for a pending filename-and-line number to display.
2886            (if save-point          ;; We do this before scrolling, because we might create a new window.
2887                (progn (goto-char save-point)          (if (and term-pending-frame
2888                       (set-marker save-point nil)))                   (eq (window-buffer selected) (current-buffer)))
2889                (progn (term-display-line (car term-pending-frame)
2890            ;; Check for a pending filename-and-line number to display.                                        (cdr term-pending-frame))
2891            ;; We do this before scrolling, because we might create a new window.                     (setq term-pending-frame nil)
2892            (if (and term-pending-frame                     ;; We have created a new window, so check the window size.
2893                     (eq (window-buffer selected) (current-buffer)))                     (term-check-size proc)))
2894                (progn (term-display-line (car term-pending-frame)  
2895                                          (cdr term-pending-frame))          ;; Scroll each window displaying the buffer but (by default)
2896                       (setq term-pending-frame nil)          ;; only if the point matches the process-mark we started with.
2897                   ;; We have created a new window, so check the window size.          (setq win selected)
2898                       (term-check-size proc)))          ;; Avoid infinite loop in strange case where minibuffer window
2899            ;; is selected but not active.
2900            ;; Scroll each window displaying the buffer but (by default)          (while (window-minibuffer-p win)
2901            ;; only if the point matches the process-mark we started with.            (setq win (next-window win nil t)))
2902            (setq win selected)          (setq last-win win)
2903            ;; Avoid infinite loop in strange case where minibuffer window          (while (progn
2904            ;; is selected but not active.                   (setq win (next-window win nil t))
2905            (while (window-minibuffer-p win)                   (if (eq (window-buffer win) (process-buffer proc))
2906              (setq win (next-window win nil t)))                       (let ((scroll term-scroll-to-bottom-on-output))
2907            (setq last-win win)                         (select-window win)
2908            (while (progn                         (if (or (= (point) save-marker)
2909                     (setq win (next-window win nil t))                                 (eq scroll t) (eq scroll 'all)
2910                     (if (eq (window-buffer win) (process-buffer proc))                                 ;; Maybe user wants point to jump to the end.
2911                         (let ((scroll term-scroll-to-bottom-on-output))                                 (and (eq selected win)
2912                           (select-window win)                                      (or (eq scroll 'this) (not save-point)))
2913                           (if (or (= (point) save-marker)                                 (and (eq scroll 'others)
2914                                   (eq scroll t) (eq scroll 'all)                                      (not (eq selected win))))
2915                                   ;; Maybe user wants point to jump to the end.                             (progn
2916                                   (and (eq selected win)                               (goto-char term-home-marker)
2917                                        (or (eq scroll 'this) (not save-point)))                               (recenter 0)
2918                                   (and (eq scroll 'others)                               (goto-char (process-mark proc))
2919                                        (not (eq selected win))))                               (if (not (pos-visible-in-window-p (point) win))
2920                               (progn                                   (recenter -1))))
2921                                 (goto-char term-home-marker)                         ;; Optionally scroll so that the text
2922                                 (recenter 0)                         ;; ends at the bottom of the window.
2923                                 (goto-char (process-mark proc))                         (if (and term-scroll-show-maximum-output
2924                                 (if (not (pos-visible-in-window-p (point) win))                                  (>= (point) (process-mark proc)))
2925                                     (recenter -1))))                             (save-excursion
2926                           ;; Optionally scroll so that the text                               (goto-char (point-max))
2927                           ;; ends at the bottom of the window.                               (recenter -1)))))
2928                           (if (and term-scroll-show-maximum-output                   (not (eq win last-win))))
                                   (>= (point) (process-mark proc)))  
                              (save-excursion  
                                (goto-char (point-max))  
                                (recenter -1)))))  
                    (not (eq win last-win))))  
2929    
2930  ;;; Stolen from comint.el and adapted -mm  ;;; Stolen from comint.el and adapted -mm
2931            (if (> term-buffer-maximum-size 0)          (if (> term-buffer-maximum-size 0)
2932                    (save-excursion              (save-excursion
2933                          (goto-char (process-mark (get-buffer-process (current-buffer))))                (goto-char (process-mark (get-buffer-process (current-buffer))))
2934                          (forward-line (- term-buffer-maximum-size))                (forward-line (- term-buffer-maximum-size))
2935                          (beginning-of-line)                (beginning-of-line)
2936                          (delete-region (point-min) (point))))                (delete-region (point-min) (point))))
2937  ;;;  ;;;
2938    
2939            (set-marker save-marker nil))          (set-marker save-marker nil)))))
       ;; unwind-protect cleanup-forms follow:  
       (set-buffer previous-buffer)  
       (select-window selected))))  
2940    
2941  (defun term-handle-deferred-scroll ()  (defun term-handle-deferred-scroll ()
2942    (let ((count (- (term-current-row) term-height)))    (let ((count (- (term-current-row) term-height)))
# Line 2988  See `term-prompt-regexp'." Line 2974  See `term-prompt-regexp'."
2974     ((eq parameter 8)     ((eq parameter 8)
2975      (setq term-ansi-current-invisible 1))      (setq term-ansi-current-invisible 1))
2976    
2977    ;;; Reset reverse (i.e. terminfo rmso)
2978       ((eq parameter 24)
2979        (setq term-ansi-current-reverse 0))
2980    
2981    ;;; Reset underline (i.e. terminfo rmul)
2982       ((eq parameter 27)
2983        (setq term-ansi-current-underline 0))
2984    
2985  ;;; Foreground  ;;; Foreground
2986     ((and (>= parameter 30) (<= parameter 37))     ((and (>= parameter 30) (<= parameter 37))
2987      (setq term-ansi-current-color (- parameter 29)))      (setq term-ansi-current-color (- parameter 29)))
# Line 3042  See `term-prompt-regexp'." Line 3036  See `term-prompt-regexp'."
3036                      )                      )
3037              (setq term-current-face              (setq term-current-face
3038                    (list :background                    (list :background
3039                          (elt ansi-term-color-vector term-ansi-current-color)                          (if (= term-ansi-current-color 0)
3040                                (face-foreground 'default)
3041                                (elt ansi-term-color-vector term-ansi-current-color))
3042                          :foreground                          :foreground
3043                          (elt ansi-term-color-vector term-ansi-current-bg-color)))                          (if (= term-ansi-current-bg-color 0)
3044                                (face-background 'default)
3045                            (elt ansi-term-color-vector term-ansi-current-bg-color))))
3046              (if (= term-ansi-current-bold 1)              (if (= term-ansi-current-bold 1)
3047                  (setq term-current-face                  (setq term-current-face
3048                        (append '(:weight bold) term-current-face)))                        (append '(:weight bold) term-current-face)))
# Line 3501  all pending output has been dealt with." Line 3499  all pending output has been dealt with."
3499      (if (and check-for-scroll (or term-scroll-with-delete term-pager-count))      (if (and check-for-scroll (or term-scroll-with-delete term-pager-count))
3500          (setq down (term-handle-scroll down)))          (setq down (term-handle-scroll down)))
3501      (term-adjust-current-row-cache down)      (term-adjust-current-row-cache down)
3502      (if (/= (point) (point-max))      (if (or (/= (point) (point-max)) (< down 0))
3503          (setq down (- down (term-vertical-motion down))))          (setq down (- down (term-vertical-motion down))))
3504      ;; Extend buffer with extra blank lines if needed.      ;; Extend buffer with extra blank lines if needed.
3505      (cond ((> down 0)      (cond ((> down 0)

Legend:
Removed from v.1.49.6.4  
changed lines
  Added in v.1.49.6.5

savannah-hackers-public@gnu.org
ViewVC Help
Powered by ViewVC 1.1.26