Mercurial > emacs
diff lisp/term.el @ 90261:7beb78bc1f8e
Revision: miles@gnu.org--gnu-2005/emacs--unicode--0--patch-97
Merge from emacs--cvs-trunk--0
Patches applied:
* emacs--cvs-trunk--0 (patch 616-696)
- Add lisp/mh-e/.arch-inventory
- Update from CVS
- Merge from gnus--rel--5.10
- Update from CVS: lisp/smerge-mode.el: Add 'tools' to file keywords.
- lisp/gnus/ChangeLog: Remove duplicate entry
* gnus--rel--5.10 (patch 147-181)
- Update from CVS
- Merge from emacs--cvs-trunk--0
- Update from CVS: lisp/mml.el (mml-preview): Doc fix.
- Update from CVS: texi/message.texi: Fix default values.
- Update from CVS: texi/gnus.texi (RSS): Addition.
author | Miles Bader <miles@gnu.org> |
---|---|
date | Mon, 16 Jan 2006 08:37:27 +0000 |
parents | 0ca0d9181b5e 78ee72a03306 |
children | 146cd8369025 |
line wrap: on
line diff
--- a/lisp/term.el Mon Jan 16 06:59:21 2006 +0000 +++ b/lisp/term.el Mon Jan 16 08:37:27 2006 +0000 @@ -1,7 +1,7 @@ ;;; term.el --- general command interpreter in a window stuff ;; Copyright (C) 1988, 1990, 1992, 1994, 1995, 2002, 2003, -;; 2004, 2005 Free Software Foundation, Inc. +;; 2004, 2005, 2006 Free Software Foundation, Inc. ;; Author: Per Bothner <per@bothner.com> ;; Maintainer: Dan Nicolaescu <dann@ics.uci.edu>, Per Bothner <per@bothner.com> @@ -915,6 +915,7 @@ (define-key term-raw-map [backspace] 'term-send-backspace) (define-key term-raw-map [home] 'term-send-home) (define-key term-raw-map [end] 'term-send-end) + (define-key term-raw-map [insert] 'term-send-insert) (define-key term-raw-map [S-prior] 'scroll-down) (define-key term-raw-map [S-next] 'scroll-up) (define-key term-raw-map [S-insert] 'term-paste) @@ -1066,6 +1067,13 @@ (make-local-variable 'term-ansi-current-reverse) (make-local-variable 'term-ansi-current-invisible) + (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) + (make-local-variable 'term-terminal-state) (make-local-variable 'term-kill-echo-list) (make-local-variable 'term-start-line-column) @@ -1117,7 +1125,7 @@ (setq term-start-line-column nil) (setq term-current-row nil) (setq term-current-column nil) - (term-scroll-region 0 height)) + (term-set-scroll-region 0 height)) ;; Recursive routine used to check if any string in term-kill-echo-list ;; matches part of the buffer before point. @@ -1219,11 +1227,13 @@ ;; Which would be better: "\e[A" or "\eOA"? readline accepts either. ;; For my configuration it's definitely better \eOA but YMMV. -mm ;; For example: vi works with \eOA while elm wants \e[A ... +;;; (terminfo: kcuu1, kcud1, kcuf1, kcub1, khome, kend, kpp, knp, kdch1, kbs) (defun term-send-up () (interactive) (term-send-raw-string "\eOA")) (defun term-send-down () (interactive) (term-send-raw-string "\eOB")) (defun term-send-right () (interactive) (term-send-raw-string "\eOC")) (defun term-send-left () (interactive) (term-send-raw-string "\eOD")) (defun term-send-home () (interactive) (term-send-raw-string "\e[1~")) +(defun term-send-insert() (interactive) (term-send-raw-string "\e[2~")) (defun term-send-end () (interactive) (term-send-raw-string "\e[4~")) (defun term-send-prior () (interactive) (term-send-raw-string "\e[5~")) (defun term-send-next () (interactive) (term-send-raw-string "\e[6~")) @@ -1403,8 +1413,8 @@ :UP=\\E[%%dA:DO=\\E[%%dB:LE=\\E[%%dD:RI=\\E[%%dC\ :kl=\\EOD:kd=\\EOB:kr=\\EOC:ku=\\EOA:kN=\\E[6~:kP=\\E[5~:@7=\\E[4~:kh=\\E[1~\ :mk=\\E[8m:cb=\\E[1K:op=\\E[39;49m:Co#8:pa#64:AB=\\E[4%%dm:AF=\\E[3%%dm:cr=^M\ -:bl=^G:do=^J:le=^H:ta=^I:se=\E[27m:ue=\E24m\ -:kb=^?:kD=^[[3~:sc=\E7:rc=\E8:r1=\Ec:" +:bl=^G:do=^J:le=^H:ta=^I:se=\\E[27m:ue=\\E24m\ +:kb=^?:kD=^[[3~:sc=\\E7:rc=\\E8:r1=\\Ec:" ;;; : -undefine ic ;;; don't define :te=\\E[2J\\E[?47l\\E8:ti=\\E7\\E[?47h\ "termcap capabilities supported") @@ -2684,13 +2694,17 @@ (buffer-undo-list t) (selected (selected-window)) last-win + handled-ansi-message (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)) + (let* ((newstr (term-handle-ansi-terminal-messages str))) + (if (not (eq str newstr)) + (setq handled-ansi-message t + str newstr))) + (setq str-length (length str)) (if (marker-buffer term-pending-delete-marker) (progn @@ -2741,7 +2755,7 @@ ;; around. Go to the beginning of ;; the next line and switch to state ;; 0. - (term-down 1) + (term-down 1 t) (term-move-columns (- (term-current-column))) (setq term-terminal-state 0))) (setq count (- funny i)) @@ -2779,7 +2793,7 @@ (setq pos (point)) (term-move-columns columns) (delete-region pos (point))) - ;; In insert if the if the current line + ;; In insert mode if the current line ;; has become too long it needs to be ;; chopped off. (when term-insert-mode @@ -2817,26 +2831,13 @@ (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 ?\r) ;; (terminfo: cr) + (term-vertical-motion 0) + (setq term-current-column term-start-line-column)) + ((eq char ?\n) ;; (terminfo: cud1, ind) + (unless (and term-kill-echo-list + (term-check-kill-echo-list)) + (term-down 1 t))) ((eq char ?\b) ;; (terminfo: cub1) (term-move-columns -1)) ((eq char ?\033) ; Escape @@ -2844,16 +2845,16 @@ ((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) + ((eq char ?\^G) ;; (terminfo: bel) + (beep t)) + ((and (eq char ?\032) + (not handled-ansi-message)) (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-parameter (substring str i)) (setq term-terminal-state 4) (setq i str-length)))) (t ; insert char FIXME: Should never happen @@ -2867,12 +2868,6 @@ ;;; 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) @@ -2891,18 +2886,47 @@ ;; (term-goto term-current-row 0) ;; (setq term-terminal-state 0)) ((eq char ?M) ;; scroll reversed (terminfo: ri) - (term-down -1) + (if (or (< (term-current-row) term-scroll-start) + (>= (1- (term-current-row)) + term-scroll-start)) + ;; Scrolling up will not move outside + ;; the scroll region. + (term-down -1) + ;; Scrolling the scroll region is needed. + (term-down -1 t)) (setq term-terminal-state 0)) ((eq char ?7) ;; Save cursor (terminfo: sc) (term-handle-deferred-scroll) (setq term-saved-cursor - (cons (term-current-row) - (term-horizontal-column))) + (list (term-current-row) + (term-horizontal-column) + term-ansi-current-bg-color + term-ansi-current-bold + term-ansi-current-color + term-ansi-current-invisible + term-ansi-current-reverse + term-ansi-current-underline + term-current-face) + ) (setq term-terminal-state 0)) ((eq char ?8) ;; Restore cursor (terminfo: rc) - (if term-saved-cursor - (term-goto (car term-saved-cursor) - (cdr term-saved-cursor))) + (when term-saved-cursor + (term-goto (nth 0 term-saved-cursor) + (nth 1 term-saved-cursor)) + (setq term-ansi-current-bg-color + (nth 2 term-saved-cursor) + term-ansi-current-bold + (nth 3 term-saved-cursor) + term-ansi-current-color + (nth 4 term-saved-cursor) + term-ansi-current-invisible + (nth 5 term-saved-cursor) + term-ansi-current-reverse + (nth 6 term-saved-cursor) + term-ansi-current-underline + (nth 7 term-saved-cursor) + term-current-face + (nth 8 term-saved-cursor))) (setq term-terminal-state 0)) ((eq char ?c) ;; \Ec - Reset (terminfo: rs1) ;; This is used by the "clear" program. @@ -2914,6 +2938,8 @@ ;; ((eq char ?#) ;; (when (eq (aref str (1+ i)) ?8) ;; (setq i (1+ i)) + ;; (setq term-scroll-start 0) + ;; (setq term-scroll-end term-height) ;; (setq term-terminal-state 0))) ((setq term-terminal-state 0)))) ((eq term-terminal-state 3) ; Seen Esc [ @@ -3041,6 +3067,8 @@ (erase-buffer) (setq term-current-row 0) (setq term-current-column 1) + (setq term-scroll-start 0) + (setq term-scroll-end term-height) (setq term-insert-mode nil) (setq term-current-face nil) (setq term-ansi-current-underline nil) @@ -3070,7 +3098,7 @@ ((eq parameter 5) (setq term-ansi-current-bold t)) -;;; Reverse +;;; Reverse (terminfo: smso) ((eq parameter 7) (setq term-ansi-current-reverse t)) @@ -3078,11 +3106,11 @@ ((eq parameter 8) (setq term-ansi-current-invisible t)) -;;; Reset underline (i.e. terminfo rmul) +;;; Reset underline (terminfo: rmul) ((eq parameter 24) (setq term-ansi-current-underline nil)) -;;; Reset reverse (i.e. terminfo rmso) +;;; Reset reverse (terminfo: rmso) ((eq parameter 27) (setq term-ansi-current-reverse nil)) @@ -3187,8 +3215,8 @@ (defun term-handle-ansi-escape (proc char) (cond - ((or (eq char ?H) ; cursor motion (terminfo: cup) - ;; (eq char ?f) ; xterm seems to handle this sequence too, not + ((or (eq char ?H) ;; cursor motion (terminfo: cup,home) + ;; (eq char ?f) ;; xterm seems to handle this sequence too, not ;; needed for now ) (if (<= term-terminal-parameter 0) @@ -3205,11 +3233,24 @@ ;; \E[A - cursor up (terminfo: cuu, cuu1) ((eq char ?A) (term-handle-deferred-scroll) - (term-down (- (max 1 term-terminal-parameter)) t)) + (let ((tcr (term-current-row))) + (term-down + (if (< (- tcr term-terminal-parameter) term-scroll-start) + ;; If the amount to move is before scroll start, move + ;; to scroll start. + (- term-scroll-start tcr) + (if (>= term-terminal-parameter tcr) + (- tcr) + (- (max 1 term-terminal-parameter)))) t))) ;; \E[B - cursor down (terminfo: cud) ((eq char ?B) - (term-down (max 1 term-terminal-parameter) t)) - ;; \E[C - cursor right (terminfo: cuf) + (let ((tcr (term-current-row))) + (unless (= tcr (1- term-scroll-end)) + (term-down + (if (> (+ tcr term-terminal-parameter) term-scroll-end) + (- term-scroll-end 1 tcr) + (max 1 term-terminal-parameter)) t)))) + ;; \E[C - cursor right (terminfo: cuf, cuf1) ((eq char ?C) (term-move-columns (max 1 @@ -3228,14 +3269,14 @@ ;; \E[L - insert lines (terminfo: il, il1) ((eq char ?L) (term-insert-lines (max 1 term-terminal-parameter))) - ;; \E[M - delete lines + ;; \E[M - delete lines (terminfo: dl, dl1) ((eq char ?M) (term-delete-lines (max 1 term-terminal-parameter))) - ;; \E[P - delete chars + ;; \E[P - delete chars (terminfo: dch, dch1) ((eq char ?P) (term-delete-chars (max 1 term-terminal-parameter))) - ;; \E[@ - insert spaces - ((eq char ?@) ;; (terminfo: ich) + ;; \E[@ - insert spaces (terminfo: ich) + ((eq char ?@) (term-insert-spaces (max 1 term-terminal-parameter))) ;; \E[?h - DEC Private Mode Set ((eq char ?h) @@ -3257,12 +3298,12 @@ ;;(terminfo: smso,rmso,smul,rmul,rev,bold,sgr0,invis,op,setab,setaf) ((eq char ?m) (when (= term-terminal-more-parameters 1) - (if (>= term-terminal-previous-parameter-4 0) - (term-handle-colors-array term-terminal-previous-parameter-4)) - (if (>= term-terminal-previous-parameter-3 0) - (term-handle-colors-array term-terminal-previous-parameter-3)) - (if (>= term-terminal-previous-parameter-2 0) - (term-handle-colors-array term-terminal-previous-parameter-2)) + (when (>= term-terminal-previous-parameter-4 0) + (term-handle-colors-array term-terminal-previous-parameter-4)) + (when (>= term-terminal-previous-parameter-3 0) + (term-handle-colors-array term-terminal-previous-parameter-3)) + (when (>= term-terminal-previous-parameter-2 0) + (term-handle-colors-array term-terminal-previous-parameter-2)) (term-handle-colors-array term-terminal-previous-parameter)) (term-handle-colors-array term-terminal-parameter)) @@ -3273,14 +3314,14 @@ (format "\e[%s;%sR" (1+ (term-current-row)) (1+ (term-horizontal-column))))) - ;; \E[r - Set scrolling region - ((eq char ?r) ;; (terminfo: csr) - (term-scroll-region + ;; \E[r - Set scrolling region (terminfo: csr) + ((eq char ?r) + (term-set-scroll-region (1- term-terminal-previous-parameter) term-terminal-parameter)) (t))) -(defun term-scroll-region (top bottom) +(defun term-set-scroll-region (top bottom) "Set scrolling region. TOP is the top-most line (inclusive) of the new scrolling region, while BOTTOM is the line following the new scrolling region (e.g. exclusive). @@ -3298,8 +3339,7 @@ (not (and (= term-scroll-start 0) (= term-scroll-end term-height))))) (term-move-columns (- (term-current-column))) - (term-goto - term-scroll-start (term-current-column))) + (term-goto 0 0)) ;; (defun term-switch-to-alternate-sub-buffer (set) ;; ;; If asked to switch to (from) the alternate sub-buffer, and already (not) @@ -3582,21 +3622,36 @@ (defun term-handle-scroll (down) (let ((scroll-needed - (- (+ (term-current-row) down 1) term-scroll-end))) - (if (> scroll-needed 0) + (- (+ (term-current-row) down) + (if (< down 0) term-scroll-start term-scroll-end)))) + (if (or (and (< down 0) (< scroll-needed 0)) + (and (> down 0) (> scroll-needed 0))) (let ((save-point (copy-marker (point))) (save-top)) (goto-char term-home-marker) (cond (term-scroll-with-delete - ;; delete scroll-needed lines at term-scroll-start - (term-vertical-motion term-scroll-start) - (setq save-top (point)) - (term-vertical-motion scroll-needed) - (delete-region save-top (point)) - (goto-char save-point) - (term-vertical-motion down) - (term-adjust-current-row-cache (- scroll-needed)) + (if (< down 0) + (progn + ;; Delete scroll-needed lines at term-scroll-end, + ;; then insert scroll-needed lines. + (term-vertical-motion (1- term-scroll-end)) + (end-of-line) + (setq save-top (point)) + (term-vertical-motion scroll-needed) + (end-of-line) + (delete-region save-top (point)) + (goto-char save-point) + (setq down (- scroll-needed down)) + (term-vertical-motion down)) + ;; Delete scroll-needed lines at term-scroll-start. + (term-vertical-motion term-scroll-start) + (setq save-top (point)) + (term-vertical-motion scroll-needed) + (delete-region save-top (point)) + (goto-char save-point) + (term-vertical-motion down) + (term-adjust-current-row-cache (- scroll-needed))) (setq term-current-column nil) - (term-insert-char ?\n scroll-needed)) + (term-insert-char ?\n (abs scroll-needed))) ((and (numberp term-pager-count) (< (setq term-pager-count (- term-pager-count down)) 0)) @@ -3613,21 +3668,32 @@ (defun term-down (down &optional check-for-scroll) "Move down DOWN screen lines vertically." (let ((start-column (term-horizontal-column))) - (if (and check-for-scroll (or term-scroll-with-delete term-pager-count)) - (setq down (term-handle-scroll down))) - (term-adjust-current-row-cache down) - (if (or (/= (point) (point-max)) (< down 0)) - (setq down (- down (term-vertical-motion down)))) - ;; Extend buffer with extra blank lines if needed. - (cond ((> down 0) + (when (and check-for-scroll (or term-scroll-with-delete term-pager-count)) + (setq down (term-handle-scroll down))) + (unless (and (= term-current-row 0) (< down 0)) + (term-adjust-current-row-cache down) + (when (or (/= (point) (point-max)) (< down 0)) + (setq down (- down (term-vertical-motion down))))) + (cond ((>= down 0) + ;; Extend buffer with extra blank lines if needed. (term-insert-char ?\n down) (setq term-current-column 0) (setq term-start-line-column 0)) (t - (setq term-current-column nil) + (when (= term-current-row 0) + ;; Insert lines if at the beginning. + (save-excursion (term-insert-char ?\n (- down))) + (save-excursion + (let (p) + ;; Delete lines from the end. + (forward-line term-height) + (setq p (point)) + (forward-line (- down)) + (delete-region p (point))))) + (setq term-current-column 0) (setq term-start-line-column (current-column)))) - (if start-column - (term-move-columns start-column)))) + (when start-column + (term-move-columns start-column)))) ;; Assuming point is at the beginning of a screen line, ;; if the line above point wraps around, add a ?\n to undo the wrapping. @@ -3693,25 +3759,25 @@ ;;; Insert COUNT spaces after point, but do not change any of ;;; following screen lines. Hence we may have to delete characters -;;; at teh end of this screen line to make room. +;;; at the end of this screen line to make room. (defun term-insert-spaces (count) - (let ((save-point (point)) (save-eol) (point-at-eol)) + (let ((save-point (point)) (save-eol) (pnt-at-eol)) (term-vertical-motion 1) - (if (bolp) - (backward-char)) + (when (bolp) + (backward-char)) (setq save-eol (point)) (save-excursion (end-of-line) - (setq point-at-eol (point))) + (setq pnt-at-eol (point))) (move-to-column (+ (term-start-line-column) (- term-width count)) t) ;; If move-to-column extends the current line it will use the face ;; from the last character on the line, set the face for the chars ;; to default. - (when (> (point) (point-at-eol)) - (put-text-property point-at-eol (point) 'face 'default)) - (if (> save-eol (point)) - (delete-region (point) save-eol)) + (when (>= (point) pnt-at-eol) + (put-text-property pnt-at-eol (point) 'face 'default)) + (when (> save-eol (point)) + (delete-region (point) save-eol)) (goto-char save-point) (term-insert-char ? count) (goto-char save-point))) @@ -3721,6 +3787,8 @@ (save-current-column term-current-column) (save-start-line-column term-start-line-column) (save-current-row (term-current-row))) + (when (>= (+ save-current-row lines) term-scroll-end) + (setq lines (- lines (- (+ save-current-row lines) term-scroll-end)))) (term-down lines) (delete-region start (point)) (term-down (- term-scroll-end save-current-row lines)) @@ -3736,7 +3804,17 @@ (save-current-column term-current-column) (save-start-line-column term-start-line-column) (save-current-row (term-current-row))) - (term-down (- term-scroll-end save-current-row lines)) + ;; Inserting lines should take into account the scroll region. + (if (< save-current-row term-scroll-start) + ;; If point is before scroll start, + (progn + (setq lines (- lines (- term-scroll-start save-current-row))) + (term-down (- term-scroll-start save-current-row)) + (setq start (point))) + ;; The number of inserted lines shouldn't exceed the scroll region end. + (when (>= (+ save-current-row lines) term-scroll-end) + (setq lines (- lines (- (+ save-current-row lines) term-scroll-end)))) + (term-down (- term-scroll-end save-current-row lines))) (setq start-deleted (point)) (term-down lines) (delete-region start-deleted (point))