aboutsummaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorRichard M. Stallman1995-06-14 22:30:16 +0000
committerRichard M. Stallman1995-06-14 22:30:16 +0000
commit3b8c40f5ba6f568e399a374186fe15cdc121fba5 (patch)
treef1c0b5672eee7932f7dc4d446a2e01068a2df15b
parent3399a477eacf69b8c401b4ee54a309e15765211e (diff)
downloademacs-3b8c40f5ba6f568e399a374186fe15cdc121fba5.tar.gz
emacs-3b8c40f5ba6f568e399a374186fe15cdc121fba5.zip
Various optimizations. The main one is to optimize for
simple output at the end of the buffer, with no paging, and in that case to defer scrolling while we can. (term-emulate-terminal): Don't call term-handle-scroll in simple cases unless we are either paging or term-scroll-with-delete. (term-down): Likewise. (term-handle-scroll): Modify accordingly. (term-emulate-terminal): Avoid deleting old text in common case. Optimize the simple case of CRLF when we're at buffer end. Handle deferred scroll when done processing output. (term-handle-deferred-scroll): New function. (term-down): Simplify - no longer take RIGHT argument. Tune. (term-goto): Use term-move-columns to compensate for the above. (term-escape-char, term-set-escape-char): Add doc-string. (term-mouse-paste): Add xemacs support. Various speed enhencements: (term-handle-scroll): Don't clear term-current-row; maybe adjust it. (term-down): Don't call term-adjust-current-row-cache if we've done term-handle-scroll. (term-emulate-terminal): Don't call term-adjust-current-row-cache. (term-emulate-terminal): For TAB, don't nil term-start-line-column. (term-goto): Possible optimization.
-rw-r--r--lisp/term.el139
1 files changed, 99 insertions, 40 deletions
diff --git a/lisp/term.el b/lisp/term.el
index 3ab6c0711e2..1d340883841 100644
--- a/lisp/term.el
+++ b/lisp/term.el
@@ -283,7 +283,9 @@ executed once when the buffer is created.")
283(defvar term-mode-map nil) 283(defvar term-mode-map nil)
284(defvar term-raw-map nil 284(defvar term-raw-map nil
285 "Keyboard map for sending characters directly to the inferior process.") 285 "Keyboard map for sending characters directly to the inferior process.")
286(defvar term-escape-char nil) 286(defvar term-escape-char nil
287 "Escape character for char-sub-mode of term mode.
288Do not change it directly; use term-set-escape-char instead.")
287(defvar term-raw-escape-map nil) 289(defvar term-raw-escape-map nil)
288 290
289(defvar term-pager-break-map nil) 291(defvar term-pager-break-map nil)
@@ -690,6 +692,7 @@ without any interpretation."
690(defun term-send-left () (interactive) (term-send-raw-string "\e[D")) 692(defun term-send-left () (interactive) (term-send-raw-string "\e[D"))
691 693
692(defun term-set-escape-char (c) 694(defun term-set-escape-char (c)
695 "Change term-escape-char and keymaps that depend on it."
693 (if term-escape-char 696 (if term-escape-char
694 (define-key term-raw-map term-escape-char 'term-send-raw)) 697 (define-key term-raw-map term-escape-char 'term-send-raw))
695 (setq c (make-string 1 c)) 698 (setq c (make-string 1 c))
@@ -2126,24 +2129,31 @@ See `term-prompt-regexp'."
2126 ;; This iteration, handle only what fits. 2129 ;; This iteration, handle only what fits.
2127 (setq count (- count temp)) 2130 (setq count (- count temp))
2128 (setq funny (+ count i))) 2131 (setq funny (+ count i)))
2129 ((> (term-handle-scroll 1) 0) 2132 ((or (not (or term-pager-count
2133 term-scroll-with-delete))
2134 (> (term-handle-scroll 1) 0))
2135 (term-adjust-current-row-cache 1)
2130 (setq count (min count term-width)) 2136 (setq count (min count term-width))
2131 (setq funny (+ count i)) 2137 (setq funny (+ count i))
2132 (term-adjust-current-row-cache 1)
2133 (setq term-start-line-column 2138 (setq term-start-line-column
2134 term-current-column)) 2139 term-current-column))
2135 (t ;; Doing PAGER processing. 2140 (t ;; Doing PAGER processing.
2136 (setq count 0 funny i) 2141 (setq count 0 funny i)
2137 (setq term-current-column nil) 2142 (setq term-current-column nil)
2138 (setq term-start-line-column nil))) 2143 (setq term-start-line-column nil)))
2139 (if term-insert-mode
2140 ;; Inserting spaces, then deleting them, then
2141 ;; inserting the actual text seems clumsy, but
2142 ;; it is simple, and the overhead is miniscule.
2143 (term-insert-spaces count))
2144 (setq old-point (point)) 2144 (setq old-point (point))
2145 (term-move-columns count) 2145 ;; In the common case that we're at the end of
2146 (delete-region old-point (point)) 2146 ;; the buffer, we can save a little work.
2147 (cond ((/= (point) (point-max))
2148 (if term-insert-mode
2149 ;; Inserting spaces, then deleting them,
2150 ;; then inserting the actual text is
2151 ;; inefficient, but it is simple, and
2152 ;; the actual overhead is miniscule.
2153 (term-insert-spaces count))
2154 (term-move-columns count)
2155 (delete-region old-point (point)))
2156 (t (setq term-current-column (+ (term-current-column) count))))
2147 (insert (substring str i funny)) 2157 (insert (substring str i funny))
2148 (put-text-property old-point (point) 2158 (put-text-property old-point (point)
2149 'face term-current-face) 2159 'face term-current-face)
@@ -2161,17 +2171,29 @@ See `term-prompt-regexp'."
2161 (setq count (+ count 8 (- (mod count 8)))) 2171 (setq count (+ count 8 (- (mod count 8))))
2162 (if (< (move-to-column count nil) count) 2172 (if (< (move-to-column count nil) count)
2163 (term-insert-char char 1)) 2173 (term-insert-char char 1))
2164 (setq term-current-column count) 2174 (setq term-current-column count))
2165 (setq term-start-line-column nil))
2166 ((eq char ?\b)
2167 (term-move-columns -1))
2168 ((eq char ?\r) 2175 ((eq char ?\r)
2169 (term-vertical-motion 0) 2176 ;; Optimize CRLF at end of buffer:
2170 (setq term-current-column nil)) 2177 (cond ((and (< (setq temp (1+ i)) str-length)
2178 (eq (aref str temp) ?\n)
2179 (= (point) (point-max))
2180 (not (or term-pager-count
2181 term-kill-echo-list
2182 term-scroll-with-delete)))
2183 (insert ?\n)
2184 (term-adjust-current-row-cache 1)
2185 (setq term-start-line-column 0)
2186 (setq term-current-column 0)
2187 (setq i temp))
2188 (t ;; Not followed by LF or can't optimize:
2189 (term-vertical-motion 0)
2190 (setq term-current-column 0))))
2171 ((eq char ?\n) 2191 ((eq char ?\n)
2172 (if (not (and term-kill-echo-list 2192 (if (not (and term-kill-echo-list
2173 (term-check-kill-echo-list))) 2193 (term-check-kill-echo-list)))
2174 (term-down 1 0 t))) 2194 (term-down 1 t)))
2195 ((eq char ?\b)
2196 (term-move-columns -1))
2175 ((eq char ?\033) ; Escape 2197 ((eq char ?\033) ; Escape
2176 (setq term-terminal-state 2)) 2198 (setq term-terminal-state 2))
2177 ((eq char 0)) ; NUL: Do nothing 2199 ((eq char 0)) ; NUL: Do nothing
@@ -2201,12 +2223,14 @@ See `term-prompt-regexp'."
2201 (setq term-terminal-previous-parameter 0) 2223 (setq term-terminal-previous-parameter 0)
2202 (setq term-terminal-state 3)) 2224 (setq term-terminal-state 3))
2203 ((eq char ?D) ;; scroll forward 2225 ((eq char ?D) ;; scroll forward
2204 (term-down 1 0 t) 2226 (term-handle-deferred-scroll)
2227 (term-down 1 t)
2205 (setq term-terminal-state 0)) 2228 (setq term-terminal-state 0))
2206 ((eq char ?M) ;; scroll reversed 2229 ((eq char ?M) ;; scroll reversed
2207 (term-insert-lines 1) 2230 (term-insert-lines 1)
2208 (setq term-terminal-state 0)) 2231 (setq term-terminal-state 0))
2209 ((eq char ?7) ;; Save cursor 2232 ((eq char ?7) ;; Save cursor
2233 (term-handle-deferred-scroll)
2210 (setq term-saved-cursor 2234 (setq term-saved-cursor
2211 (cons (term-current-row) 2235 (cons (term-current-row)
2212 (term-horizontal-column))) 2236 (term-horizontal-column)))
@@ -2250,6 +2274,9 @@ See `term-prompt-regexp'."
2250 (setq i str-length))) 2274 (setq i str-length)))
2251 (setq i (1+ i)))) 2275 (setq i (1+ i))))
2252 2276
2277 (if (>= (term-current-row) term-height)
2278 (term-handle-deferred-scroll))
2279
2253 (set-marker (process-mark proc) (point)) 2280 (set-marker (process-mark proc) (point))
2254 (if save-point 2281 (if save-point
2255 (progn (goto-char save-point) 2282 (progn (goto-char save-point)
@@ -2300,6 +2327,15 @@ See `term-prompt-regexp'."
2300 (set-buffer previous-buffer) 2327 (set-buffer previous-buffer)
2301 (select-window selected)))) 2328 (select-window selected))))
2302 2329
2330(defun term-handle-deferred-scroll ()
2331 (let ((count (- (term-current-row) term-height)))
2332 (if (> count 0)
2333 (save-excursion
2334 (goto-char term-home-marker)
2335 (term-vertical-motion count)
2336 (set-marker term-home-marker (point))
2337 (setq term-current-row (1- term-height))))))
2338
2303;;; Handle a character assuming (eq terminal-state 2) - 2339;;; Handle a character assuming (eq terminal-state 2) -
2304;;; i.e. we have previousely seen Escape followed by ?[. 2340;;; i.e. we have previousely seen Escape followed by ?[.
2305 2341
@@ -2319,10 +2355,11 @@ See `term-prompt-regexp'."
2319 (1- term-terminal-parameter))) 2355 (1- term-terminal-parameter)))
2320 ;; \E[A - cursor up 2356 ;; \E[A - cursor up
2321 ((eq char ?A) 2357 ((eq char ?A)
2322 (term-down (- (max 1 term-terminal-parameter)) 0 t)) 2358 (term-handle-deferred-scroll)
2359 (term-down (- (max 1 term-terminal-parameter)) t))
2323 ;; \E[B - cursor down 2360 ;; \E[B - cursor down
2324 ((eq char ?B) 2361 ((eq char ?B)
2325 (term-down (max 1 term-terminal-parameter) 0 t)) 2362 (term-down (max 1 term-terminal-parameter) t))
2326 ;; \E[C - cursor right 2363 ;; \E[C - cursor right
2327 ((eq char ?C) 2364 ((eq char ?C)
2328 (term-move-columns (max 1 term-terminal-parameter))) 2365 (term-move-columns (max 1 term-terminal-parameter)))
@@ -2370,6 +2407,7 @@ See `term-prompt-regexp'."
2370 (t (setq term-current-face 'default)))) 2407 (t (setq term-current-face 'default))))
2371 ;; \E[6n - Report cursor position 2408 ;; \E[6n - Report cursor position
2372 ((eq char ?n) 2409 ((eq char ?n)
2410 (term-handle-deferred-scroll)
2373 (process-send-string proc 2411 (process-send-string proc
2374 (format "\e[%s;%sR" 2412 (format "\e[%s;%sR"
2375 (1+ (term-current-row)) 2413 (1+ (term-current-row))
@@ -2403,6 +2441,7 @@ The top-most line is line 0."
2403 ;; If asked to switch to (from) the alternate sub-buffer, and already (not) 2441 ;; If asked to switch to (from) the alternate sub-buffer, and already (not)
2404 ;; using it, do nothing. This test is needed for some programs (including 2442 ;; using it, do nothing. This test is needed for some programs (including
2405 ;; emacs) that emit the ti termcap string twice, for unknown reason. 2443 ;; emacs) that emit the ti termcap string twice, for unknown reason.
2444 (term-handle-deferred-scroll)
2406 (if (eq set (not (term-using-alternate-sub-buffer))) 2445 (if (eq set (not (term-using-alternate-sub-buffer)))
2407 (let ((row (term-current-row)) 2446 (let ((row (term-current-row))
2408 (col (term-horizontal-column))) 2447 (col (term-horizontal-column)))
@@ -2477,22 +2516,30 @@ The top-most line is line 0."
2477;;; "down" as needed so that is no more that a window-full above (point-max). 2516;;; "down" as needed so that is no more that a window-full above (point-max).
2478 2517
2479(defun term-goto-home () 2518(defun term-goto-home ()
2519 (term-handle-deferred-scroll)
2480 (goto-char term-home-marker) 2520 (goto-char term-home-marker)
2481 (setq term-current-row 0) 2521 (setq term-current-row 0)
2482 (setq term-current-column (current-column)) 2522 (setq term-current-column (current-column))
2483 (setq term-start-line-column term-current-column)) 2523 (setq term-start-line-column term-current-column))
2484 2524
2485;;; FIXME: This can be optimized some.
2486(defun term-goto (row col) 2525(defun term-goto (row col)
2487 (term-goto-home) 2526 (term-handle-deferred-scroll)
2488 (term-down row col)) 2527 (cond ((and term-current-row (>= row term-current-row))
2528 ;; I assume this is a worthwhile optimization.
2529 (term-vertical-motion 0)
2530 (setq term-current-column term-start-line-column)
2531 (setq row (- row term-current-row)))
2532 (t
2533 (term-goto-home)))
2534 (term-down row)
2535 (term-move-columns col))
2489 2536
2490; The page is full, so enter "pager" mode, and wait for input. 2537; The page is full, so enter "pager" mode, and wait for input.
2491 2538
2492(defun term-process-pager () 2539(defun term-process-pager ()
2493 (if (not term-pager-break-map) 2540 (if (not term-pager-break-map)
2494 (let* ((map (make-keymap)) 2541 (let* ((map (make-keymap))
2495 (i 0) tmp) 2542 (i 0) tmp)
2496; (while (< i 128) 2543; (while (< i 128)
2497; (define-key map (make-string 1 i) 'term-send-raw) 2544; (define-key map (make-string 1 i) 'term-send-raw)
2498; (setq i (1+ i))) 2545; (setq i (1+ i)))
@@ -2681,6 +2728,8 @@ all pending output has been dealt with."))
2681 (delete-region save-top (point)) 2728 (delete-region save-top (point))
2682 (goto-char save-point) 2729 (goto-char save-point)
2683 (term-vertical-motion down) 2730 (term-vertical-motion down)
2731 (term-adjust-current-row-cache (- scroll-needed))
2732 (setq term-current-column nil)
2684 (term-insert-char ?\n scroll-needed)) 2733 (term-insert-char ?\n scroll-needed))
2685 ((and (numberp term-pager-count) 2734 ((and (numberp term-pager-count)
2686 (< (setq term-pager-count (- term-pager-count down)) 2735 (< (setq term-pager-count (- term-pager-count down))
@@ -2688,26 +2737,31 @@ all pending output has been dealt with."))
2688 (setq down 0) 2737 (setq down 0)
2689 (term-process-pager)) 2738 (term-process-pager))
2690 (t 2739 (t
2740 (term-adjust-current-row-cache (- scroll-needed))
2691 (term-vertical-motion scroll-needed) 2741 (term-vertical-motion scroll-needed)
2692 (set-marker term-home-marker (point)))) 2742 (set-marker term-home-marker (point))))
2693 (goto-char save-point) 2743 (goto-char save-point)
2694 (set-marker save-point nil) 2744 (set-marker save-point nil))))
2695 (setq term-current-column nil)
2696 (setq term-current-row nil))))
2697 down) 2745 down)
2698 2746
2699(defun term-down (down right &optional check-for-scroll) 2747(defun term-down (down &optional check-for-scroll)
2700 "Move down DOWN screen lines vertically, and RIGHT columns horizontally." 2748 "Move down DOWN screen lines vertically."
2701 (let ((start-column (term-horizontal-column))) 2749 (let ((start-column (term-horizontal-column)))
2702 (if check-for-scroll 2750 (if (and check-for-scroll (or term-scroll-with-delete term-pager-count))
2703 (setq down (term-handle-scroll down))) 2751 (setq down (term-handle-scroll down)))
2704 (term-adjust-current-row-cache down) 2752 (term-adjust-current-row-cache down)
2705 (setq down (- down (term-vertical-motion down))) 2753 (if (/= (point) (point-max))
2706 ; Extend buffer with extra blank lines if needed. 2754 (setq down (- down (term-vertical-motion down))))
2707 (if (> down 0) (term-insert-char ?\n down)) 2755 ;; Extend buffer with extra blank lines if needed.
2708 (setq term-current-column nil) 2756 (cond ((> down 0)
2709 (setq term-start-line-column (current-column)) 2757 (term-insert-char ?\n down)
2710 (move-to-column (+ term-start-line-column start-column right) t))) 2758 (setq term-current-column 0)
2759 (setq term-start-line-column 0))
2760 (t
2761 (setq term-current-column nil)
2762 (setq term-start-line-column (current-column))))
2763 (if start-column
2764 (term-move-columns start-column))))
2711 2765
2712;; Assuming point is at the beginning of a screen line, 2766;; Assuming point is at the beginning of a screen line,
2713;; if the line above point wraps around, add a ?\n to undo the wrapping. 2767;; if the line above point wraps around, add a ?\n to undo the wrapping.
@@ -2747,6 +2801,7 @@ all pending output has been dealt with."))
2747If KIND is 0, erase from (point) to (point-max); 2801If KIND is 0, erase from (point) to (point-max);
2748if KIND is 1, erase from home to point; else erase from home to point-max. 2802if KIND is 1, erase from home to point; else erase from home to point-max.
2749Should only be called when point is at the start of a screen line." 2803Should only be called when point is at the start of a screen line."
2804 (term-handle-deferred-scroll)
2750 (cond ((eq term-terminal-parameter 0) 2805 (cond ((eq term-terminal-parameter 0)
2751 (delete-region (point) (point-max)) 2806 (delete-region (point) (point-max))
2752 (term-unwrap-line)) 2807 (term-unwrap-line))
@@ -2770,6 +2825,10 @@ Should only be called when point is at the start of a screen line."
2770 (move-to-column (+ (term-current-column) count) t) 2825 (move-to-column (+ (term-current-column) count) t)
2771 (delete-region save-point (point)))) 2826 (delete-region save-point (point))))
2772 2827
2828;;; Insert COUNT spaces after point, but do not change any of
2829;;; following screen lines. Hence we may have to delete characters
2830;;; at teh end of this screen line to make room.
2831
2773(defun term-insert-spaces (count) 2832(defun term-insert-spaces (count)
2774 (let ((save-point (point)) (save-eol)) 2833 (let ((save-point (point)) (save-eol))
2775 (term-vertical-motion 1) 2834 (term-vertical-motion 1)
@@ -2788,9 +2847,9 @@ Should only be called when point is at the start of a screen line."
2788 (save-current-column term-current-column) 2847 (save-current-column term-current-column)
2789 (save-start-line-column term-start-line-column) 2848 (save-start-line-column term-start-line-column)
2790 (save-current-row (term-current-row))) 2849 (save-current-row (term-current-row)))
2791 (term-down lines 0) 2850 (term-down lines)
2792 (delete-region start (point)) 2851 (delete-region start (point))
2793 (term-down (- term-scroll-end save-current-row lines) 0) 2852 (term-down (- term-scroll-end save-current-row lines))
2794 (term-insert-char ?\n lines) 2853 (term-insert-char ?\n lines)
2795 (setq term-current-column save-current-column) 2854 (setq term-current-column save-current-column)
2796 (setq term-start-line-column save-start-line-column) 2855 (setq term-start-line-column save-start-line-column)
@@ -2803,9 +2862,9 @@ Should only be called when point is at the start of a screen line."
2803 (save-current-column term-current-column) 2862 (save-current-column term-current-column)
2804 (save-start-line-column term-start-line-column) 2863 (save-start-line-column term-start-line-column)
2805 (save-current-row (term-current-row))) 2864 (save-current-row (term-current-row)))
2806 (term-down (- term-scroll-end save-current-row lines) 0) 2865 (term-down (- term-scroll-end save-current-row lines))
2807 (setq start-deleted (point)) 2866 (setq start-deleted (point))
2808 (term-down lines 0) 2867 (term-down lines)
2809 (delete-region start-deleted (point)) 2868 (delete-region start-deleted (point))
2810 (goto-char start) 2869 (goto-char start)
2811 (setq term-current-column save-current-column) 2870 (setq term-current-column save-current-column)