Mercurial > emacs

comparison lisp/term.el @ 90261:7beb78bc1f8e

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
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
comparison
equal deleted inserted replaced
90260:0ca0d9181b5e 90261:7beb78bc1f8e
1 ;;; term.el --- general command interpreter in a window stuff 1 ;;; term.el --- general command interpreter in a window stuff
2 2
3 ;; Copyright (C) 1988, 1990, 1992, 1994, 1995, 2002, 2003, 3 ;; Copyright (C) 1988, 1990, 1992, 1994, 1995, 2002, 2003,
4 ;; 2004, 2005 Free Software Foundation, Inc. 4 ;; 2004, 2005, 2006 Free Software Foundation, Inc.
5 5
6 ;; Author: Per Bothner <per@bothner.com> 6 ;; Author: Per Bothner <per@bothner.com>
7 ;; Maintainer: Dan Nicolaescu <dann@ics.uci.edu>, Per Bothner <per@bothner.com> 7 ;; Maintainer: Dan Nicolaescu <dann@ics.uci.edu>, Per Bothner <per@bothner.com>
8 ;; Based on comint mode written by: Olin Shivers <shivers@cs.cmu.edu> 8 ;; Based on comint mode written by: Olin Shivers <shivers@cs.cmu.edu>
9 ;; Keywords: processes 9 ;; Keywords: processes
913 (define-key term-raw-map [delete] 'term-send-del) 913 (define-key term-raw-map [delete] 'term-send-del)
914 (define-key term-raw-map [deletechar] 'term-send-del) 914 (define-key term-raw-map [deletechar] 'term-send-del)
915 (define-key term-raw-map [backspace] 'term-send-backspace) 915 (define-key term-raw-map [backspace] 'term-send-backspace)
916 (define-key term-raw-map [home] 'term-send-home) 916 (define-key term-raw-map [home] 'term-send-home)
917 (define-key term-raw-map [end] 'term-send-end) 917 (define-key term-raw-map [end] 'term-send-end)
918 (define-key term-raw-map [insert] 'term-send-insert)
918 (define-key term-raw-map [S-prior] 'scroll-down) 919 (define-key term-raw-map [S-prior] 'scroll-down)
919 (define-key term-raw-map [S-next] 'scroll-up) 920 (define-key term-raw-map [S-next] 'scroll-up)
920 (define-key term-raw-map [S-insert] 'term-paste) 921 (define-key term-raw-map [S-insert] 'term-paste)
921 (define-key term-raw-map [prior] 'term-send-prior) 922 (define-key term-raw-map [prior] 'term-send-prior)
922 (define-key term-raw-map [next] 'term-send-next))) 923 (define-key term-raw-map [next] 'term-send-next)))
1063 (make-local-variable 'term-ansi-face-already-done) 1064 (make-local-variable 'term-ansi-face-already-done)
1064 (make-local-variable 'term-ansi-current-bg-color) 1065 (make-local-variable 'term-ansi-current-bg-color)
1065 (make-local-variable 'term-ansi-current-underline) 1066 (make-local-variable 'term-ansi-current-underline)
1066 (make-local-variable 'term-ansi-current-reverse) 1067 (make-local-variable 'term-ansi-current-reverse)
1067 (make-local-variable 'term-ansi-current-invisible) 1068 (make-local-variable 'term-ansi-current-invisible)
1069
1070 (make-local-variable 'term-terminal-parameter)
1071 (make-local-variable 'term-terminal-previous-parameter)
1072 (make-local-variable 'term-terminal-previous-parameter-2)
1073 (make-local-variable 'term-terminal-previous-parameter-3)
1074 (make-local-variable 'term-terminal-previous-parameter-4)
1075 (make-local-variable 'term-terminal-more-parameters)
1068 1076
1069 (make-local-variable 'term-terminal-state) 1077 (make-local-variable 'term-terminal-state)
1070 (make-local-variable 'term-kill-echo-list) 1078 (make-local-variable 'term-kill-echo-list)
1071 (make-local-variable 'term-start-line-column) 1079 (make-local-variable 'term-start-line-column)
1072 (make-local-variable 'term-current-column) 1080 (make-local-variable 'term-current-column)
1115 (setq term-height height) 1123 (setq term-height height)
1116 (setq term-width width) 1124 (setq term-width width)
1117 (setq term-start-line-column nil) 1125 (setq term-start-line-column nil)
1118 (setq term-current-row nil) 1126 (setq term-current-row nil)
1119 (setq term-current-column nil) 1127 (setq term-current-column nil)
1120 (term-scroll-region 0 height)) 1128 (term-set-scroll-region 0 height))
1121 1129
1122 ;; Recursive routine used to check if any string in term-kill-echo-list 1130 ;; Recursive routine used to check if any string in term-kill-echo-list
1123 ;; matches part of the buffer before point. 1131 ;; matches part of the buffer before point.
1124 ;; If so, delete that matched part of the buffer - this suppresses echo. 1132 ;; If so, delete that matched part of the buffer - this suppresses echo.
1125 ;; Also, remove that string from the term-kill-echo-list. 1133 ;; Also, remove that string from the term-kill-echo-list.
1217 (term-send-raw-string (current-kill 0))) 1225 (term-send-raw-string (current-kill 0)))
1218 1226
1219 ;; Which would be better: "\e[A" or "\eOA"? readline accepts either. 1227 ;; Which would be better: "\e[A" or "\eOA"? readline accepts either.
1220 ;; For my configuration it's definitely better \eOA but YMMV. -mm 1228 ;; For my configuration it's definitely better \eOA but YMMV. -mm
1221 ;; For example: vi works with \eOA while elm wants \e[A ... 1229 ;; For example: vi works with \eOA while elm wants \e[A ...
1230 ;;; (terminfo: kcuu1, kcud1, kcuf1, kcub1, khome, kend, kpp, knp, kdch1, kbs)
1222 (defun term-send-up () (interactive) (term-send-raw-string "\eOA")) 1231 (defun term-send-up () (interactive) (term-send-raw-string "\eOA"))
1223 (defun term-send-down () (interactive) (term-send-raw-string "\eOB")) 1232 (defun term-send-down () (interactive) (term-send-raw-string "\eOB"))
1224 (defun term-send-right () (interactive) (term-send-raw-string "\eOC")) 1233 (defun term-send-right () (interactive) (term-send-raw-string "\eOC"))
1225 (defun term-send-left () (interactive) (term-send-raw-string "\eOD")) 1234 (defun term-send-left () (interactive) (term-send-raw-string "\eOD"))
1226 (defun term-send-home () (interactive) (term-send-raw-string "\e[1~")) 1235 (defun term-send-home () (interactive) (term-send-raw-string "\e[1~"))
1236 (defun term-send-insert() (interactive) (term-send-raw-string "\e[2~"))
1227 (defun term-send-end () (interactive) (term-send-raw-string "\e[4~")) 1237 (defun term-send-end () (interactive) (term-send-raw-string "\e[4~"))
1228 (defun term-send-prior () (interactive) (term-send-raw-string "\e[5~")) 1238 (defun term-send-prior () (interactive) (term-send-raw-string "\e[5~"))
1229 (defun term-send-next () (interactive) (term-send-raw-string "\e[6~")) 1239 (defun term-send-next () (interactive) (term-send-raw-string "\e[6~"))
1230 (defun term-send-del () (interactive) (term-send-raw-string "\e[3~")) 1240 (defun term-send-del () (interactive) (term-send-raw-string "\e[3~"))
1231 (defun term-send-backspace () (interactive) (term-send-raw-string "\C-?")) 1241 (defun term-send-backspace () (interactive) (term-send-raw-string "\C-?"))
1401 :dc=\\E[P:DC=\\E[%%dP:IC=\\E[%%d@:im=\\E[4h:ei=\\E[4l:mi:\ 1411 :dc=\\E[P:DC=\\E[%%dP:IC=\\E[%%d@:im=\\E[4h:ei=\\E[4l:mi:\
1402 :so=\\E[7m:se=\\E[m:us=\\E[4m:ue=\\E[m:md=\\E[1m:mr=\\E[7m:me=\\E[m\ 1412 :so=\\E[7m:se=\\E[m:us=\\E[4m:ue=\\E[m:md=\\E[1m:mr=\\E[7m:me=\\E[m\
1403 :UP=\\E[%%dA:DO=\\E[%%dB:LE=\\E[%%dD:RI=\\E[%%dC\ 1413 :UP=\\E[%%dA:DO=\\E[%%dB:LE=\\E[%%dD:RI=\\E[%%dC\
1404 :kl=\\EOD:kd=\\EOB:kr=\\EOC:ku=\\EOA:kN=\\E[6~:kP=\\E[5~:@7=\\E[4~:kh=\\E[1~\ 1414 :kl=\\EOD:kd=\\EOB:kr=\\EOC:ku=\\EOA:kN=\\E[6~:kP=\\E[5~:@7=\\E[4~:kh=\\E[1~\
1405 :mk=\\E[8m:cb=\\E[1K:op=\\E[39;49m:Co#8:pa#64:AB=\\E[4%%dm:AF=\\E[3%%dm:cr=^M\ 1415 :mk=\\E[8m:cb=\\E[1K:op=\\E[39;49m:Co#8:pa#64:AB=\\E[4%%dm:AF=\\E[3%%dm:cr=^M\
1406 :bl=^G:do=^J:le=^H:ta=^I:se=\E[27m:ue=\E24m\ 1416 :bl=^G:do=^J:le=^H:ta=^I:se=\\E[27m:ue=\\E24m\
1407 :kb=^?:kD=^[[3~:sc=\E7:rc=\E8:r1=\Ec:" 1417 :kb=^?:kD=^[[3~:sc=\\E7:rc=\\E8:r1=\\Ec:"
1408 ;;; : -undefine ic 1418 ;;; : -undefine ic
1409 ;;; don't define :te=\\E[2J\\E[?47l\\E8:ti=\\E7\\E[?47h\ 1419 ;;; don't define :te=\\E[2J\\E[?47l\\E8:ti=\\E7\\E[?47h\
1410 "termcap capabilities supported") 1420 "termcap capabilities supported")
1411 1421
1412 ;;; This auxiliary function cranks up the process for term-exec in 1422 ;;; This auxiliary function cranks up the process for term-exec in
2682 (with-current-buffer (process-buffer proc) 2692 (with-current-buffer (process-buffer proc)
2683 (let* ((i 0) char funny count save-point save-marker old-point temp win 2693 (let* ((i 0) char funny count save-point save-marker old-point temp win
2684 (buffer-undo-list t) 2694 (buffer-undo-list t)
2685 (selected (selected-window)) 2695 (selected (selected-window))
2686 last-win 2696 last-win
2697 handled-ansi-message
2687 (str-length (length str))) 2698 (str-length (length str)))
2688 (save-selected-window 2699 (save-selected-window
2689 2700
2690 ;; Let's handle the messages. -mm 2701 ;; Let's handle the messages. -mm
2691 2702
2692 (setq str (term-handle-ansi-terminal-messages str)) 2703 (let* ((newstr (term-handle-ansi-terminal-messages str)))
2693 (setq str-length (length str)) 2704 (if (not (eq str newstr))
2705 (setq handled-ansi-message t
2706 str newstr)))
2707 (setq str-length (length str))
2694 2708
2695 (if (marker-buffer term-pending-delete-marker) 2709 (if (marker-buffer term-pending-delete-marker)
2696 (progn 2710 (progn
2697 ;; Delete text following term-pending-delete-marker. 2711 ;; Delete text following term-pending-delete-marker.
2698 (delete-region term-pending-delete-marker (process-mark proc)) 2712 (delete-region term-pending-delete-marker (process-mark proc))
2739 (cond ((eq term-terminal-state 1) 2753 (cond ((eq term-terminal-state 1)
2740 ;; We are in state 1, we need to wrap 2754 ;; We are in state 1, we need to wrap
2741 ;; around. Go to the beginning of 2755 ;; around. Go to the beginning of
2742 ;; the next line and switch to state 2756 ;; the next line and switch to state
2743 ;; 0. 2757 ;; 0.
2744 (term-down 1) 2758 (term-down 1 t)
2745 (term-move-columns (- (term-current-column))) 2759 (term-move-columns (- (term-current-column)))
2746 (setq term-terminal-state 0))) 2760 (setq term-terminal-state 0)))
2747 (setq count (- funny i)) 2761 (setq count (- funny i))
2748 (setq temp (- (+ (term-horizontal-column) count) 2762 (setq temp (- (+ (term-horizontal-column) count)
2749 term-width)) 2763 term-width))
2777 columns (- term-current-column old-column)) 2791 columns (- term-current-column old-column))
2778 (when (not (or (eobp) term-insert-mode)) 2792 (when (not (or (eobp) term-insert-mode))
2779 (setq pos (point)) 2793 (setq pos (point))
2780 (term-move-columns columns) 2794 (term-move-columns columns)
2781 (delete-region pos (point))) 2795 (delete-region pos (point)))
2782 ;; In insert if the if the current line 2796 ;; In insert mode if the current line
2783 ;; has become too long it needs to be 2797 ;; has become too long it needs to be
2784 ;; chopped off. 2798 ;; chopped off.
2785 (when term-insert-mode 2799 (when term-insert-mode
2786 (setq pos (point)) 2800 (setq pos (point))
2787 (end-of-line) 2801 (end-of-line)
2815 (when (> term-width (term-current-column)) 2829 (when (> term-width (term-current-column))
2816 (term-move-columns 2830 (term-move-columns
2817 (1- (- term-width (term-current-column))))) 2831 (1- (- term-width (term-current-column)))))
2818 (when (= term-width (term-current-column)) 2832 (when (= term-width (term-current-column))
2819 (term-move-columns -1)))) 2833 (term-move-columns -1))))
2820 ((eq char ?\r) 2834 ((eq char ?\r) ;; (terminfo: cr)
2821 ;; Optimize CRLF at end of buffer: 2835 (term-vertical-motion 0)
2822 (cond ((and (< (setq temp (1+ i)) str-length) 2836 (setq term-current-column term-start-line-column))
2823 (eq (aref str temp) ?\n) 2837 ((eq char ?\n) ;; (terminfo: cud1, ind)
2824 (= (point) (point-max)) 2838 (unless (and term-kill-echo-list
2825 (not (or term-pager-count 2839 (term-check-kill-echo-list))
2826 term-kill-echo-list 2840 (term-down 1 t)))
2827 term-scroll-with-delete)))
2828 (insert ?\n)
2829 (term-adjust-current-row-cache 1)
2830 (setq term-start-line-column 0)
2831 (setq term-current-column 0)
2832 (setq i temp))
2833 (t ;; Not followed by LF or can't optimize:
2834 (term-vertical-motion 0)
2835 (setq term-current-column term-start-line-column))))
2836 ((eq char ?\n)
2837 (if (not (and term-kill-echo-list
2838 (term-check-kill-echo-list)))
2839 (term-down 1 t)))
2840 ((eq char ?\b) ;; (terminfo: cub1) 2841 ((eq char ?\b) ;; (terminfo: cub1)
2841 (term-move-columns -1)) 2842 (term-move-columns -1))
2842 ((eq char ?\033) ; Escape 2843 ((eq char ?\033) ; Escape
2843 (setq term-terminal-state 2)) 2844 (setq term-terminal-state 2))
2844 ((eq char 0)) ; NUL: Do nothing 2845 ((eq char 0)) ; NUL: Do nothing
2845 ((eq char ?\016)) ; Shift Out - ignored 2846 ((eq char ?\016)) ; Shift Out - ignored
2846 ((eq char ?\017)) ; Shift In - ignored 2847 ((eq char ?\017)) ; Shift In - ignored
2847 ((eq char ?\^G) 2848 ((eq char ?\^G) ;; (terminfo: bel)
2848 (beep t)) ; Bell 2849 (beep t))
2849 ((eq char ?\032) 2850 ((and (eq char ?\032)
2851 (not handled-ansi-message))
2850 (let ((end (string-match "\r?$" str i))) 2852 (let ((end (string-match "\r?$" str i)))
2851 (if end 2853 (if end
2852 (funcall term-command-hook 2854 (funcall term-command-hook
2853 (prog1 (substring str (1+ i) end) 2855 (prog1 (substring str (1+ i) end)
2854 (setq i (match-end 0)))) 2856 (setq i (match-end 0))))
2855 (setq term-terminal-parameter 2857 (setq term-terminal-parameter (substring str i))
2856 (substring str i))
2857 (setq term-terminal-state 4) 2858 (setq term-terminal-state 4)
2858 (setq i str-length)))) 2859 (setq i str-length))))
2859 (t ; insert char FIXME: Should never happen 2860 (t ; insert char FIXME: Should never happen
2860 (term-move-columns 1) 2861 (term-move-columns 1)
2861 (backward-delete-char 1) 2862 (backward-delete-char 1)
2865 2866
2866 ;;; Some modifications to cope with multiple settings like ^[[01;32;43m -mm 2867 ;;; Some modifications to cope with multiple settings like ^[[01;32;43m -mm
2867 ;;; Note that now the init value of term-terminal-previous-parameter has 2868 ;;; Note that now the init value of term-terminal-previous-parameter has
2868 ;;; been changed to -1 2869 ;;; been changed to -1
2869 2870
2870 (make-local-variable 'term-terminal-parameter)
2871 (make-local-variable 'term-terminal-previous-parameter)
2872 (make-local-variable 'term-terminal-previous-parameter-2)
2873 (make-local-variable 'term-terminal-previous-parameter-3)
2874 (make-local-variable 'term-terminal-previous-parameter-4)
2875 (make-local-variable 'term-terminal-more-parameters)
2876 (setq term-terminal-parameter 0) 2871 (setq term-terminal-parameter 0)
2877 (setq term-terminal-previous-parameter -1) 2872 (setq term-terminal-previous-parameter -1)
2878 (setq term-terminal-previous-parameter-2 -1) 2873 (setq term-terminal-previous-parameter-2 -1)
2879 (setq term-terminal-previous-parameter-3 -1) 2874 (setq term-terminal-previous-parameter-3 -1)
2880 (setq term-terminal-previous-parameter-4 -1) 2875 (setq term-terminal-previous-parameter-4 -1)
2889 ;; ;; implementation 2884 ;; ;; implementation
2890 ;; (term-down 1) 2885 ;; (term-down 1)
2891 ;; (term-goto term-current-row 0) 2886 ;; (term-goto term-current-row 0)
2892 ;; (setq term-terminal-state 0)) 2887 ;; (setq term-terminal-state 0))
2893 ((eq char ?M) ;; scroll reversed (terminfo: ri) 2888 ((eq char ?M) ;; scroll reversed (terminfo: ri)
2894 (term-down -1) 2889 (if (or (< (term-current-row) term-scroll-start)
2890 (>= (1- (term-current-row))
2891 term-scroll-start))
2892 ;; Scrolling up will not move outside
2893 ;; the scroll region.
2894 (term-down -1)
2895 ;; Scrolling the scroll region is needed.
2896 (term-down -1 t))
2895 (setq term-terminal-state 0)) 2897 (setq term-terminal-state 0))
2896 ((eq char ?7) ;; Save cursor (terminfo: sc) 2898 ((eq char ?7) ;; Save cursor (terminfo: sc)
2897 (term-handle-deferred-scroll) 2899 (term-handle-deferred-scroll)
2898 (setq term-saved-cursor 2900 (setq term-saved-cursor
2899 (cons (term-current-row) 2901 (list (term-current-row)
2900 (term-horizontal-column))) 2902 (term-horizontal-column)
2903 term-ansi-current-bg-color
2904 term-ansi-current-bold
2905 term-ansi-current-color
2906 term-ansi-current-invisible
2907 term-ansi-current-reverse
2908 term-ansi-current-underline
2909 term-current-face)
2910 )
2901 (setq term-terminal-state 0)) 2911 (setq term-terminal-state 0))
2902 ((eq char ?8) ;; Restore cursor (terminfo: rc) 2912 ((eq char ?8) ;; Restore cursor (terminfo: rc)
2903 (if term-saved-cursor 2913 (when term-saved-cursor
2904 (term-goto (car term-saved-cursor) 2914 (term-goto (nth 0 term-saved-cursor)
2905 (cdr term-saved-cursor))) 2915 (nth 1 term-saved-cursor))
2916 (setq term-ansi-current-bg-color
2917 (nth 2 term-saved-cursor)
2918 term-ansi-current-bold
2919 (nth 3 term-saved-cursor)
2920 term-ansi-current-color
2921 (nth 4 term-saved-cursor)
2922 term-ansi-current-invisible
2923 (nth 5 term-saved-cursor)
2924 term-ansi-current-reverse
2925 (nth 6 term-saved-cursor)
2926 term-ansi-current-underline
2927 (nth 7 term-saved-cursor)
2928 term-current-face
2929 (nth 8 term-saved-cursor)))
2906 (setq term-terminal-state 0)) 2930 (setq term-terminal-state 0))
2907 ((eq char ?c) ;; \Ec - Reset (terminfo: rs1) 2931 ((eq char ?c) ;; \Ec - Reset (terminfo: rs1)
2908 ;; This is used by the "clear" program. 2932 ;; This is used by the "clear" program.
2909 (setq term-terminal-state 0) 2933 (setq term-terminal-state 0)
2910 (term-reset-terminal)) 2934 (term-reset-terminal))
2912 ;; probably don't need to handle it, but this 2936 ;; probably don't need to handle it, but this
2913 ;; is the code to parse it. 2937 ;; is the code to parse it.
2914 ;; ((eq char ?#) 2938 ;; ((eq char ?#)
2915 ;; (when (eq (aref str (1+ i)) ?8) 2939 ;; (when (eq (aref str (1+ i)) ?8)
2916 ;; (setq i (1+ i)) 2940 ;; (setq i (1+ i))
2941 ;; (setq term-scroll-start 0)
2942 ;; (setq term-scroll-end term-height)
2917 ;; (setq term-terminal-state 0))) 2943 ;; (setq term-terminal-state 0)))
2918 ((setq term-terminal-state 0)))) 2944 ((setq term-terminal-state 0))))
2919 ((eq term-terminal-state 3) ; Seen Esc [ 2945 ((eq term-terminal-state 3) ; Seen Esc [
2920 (cond ((and (>= char ?0) (<= char ?9)) 2946 (cond ((and (>= char ?0) (<= char ?9))
2921 (setq term-terminal-parameter 2947 (setq term-terminal-parameter
3039 ;;; default one. 3065 ;;; default one.
3040 (defun term-reset-terminal () 3066 (defun term-reset-terminal ()
3041 (erase-buffer) 3067 (erase-buffer)
3042 (setq term-current-row 0) 3068 (setq term-current-row 0)
3043 (setq term-current-column 1) 3069 (setq term-current-column 1)
3070 (setq term-scroll-start 0)
3071 (setq term-scroll-end term-height)
3044 (setq term-insert-mode nil) 3072 (setq term-insert-mode nil)
3045 (setq term-current-face nil) 3073 (setq term-current-face nil)
3046 (setq term-ansi-current-underline nil) 3074 (setq term-ansi-current-underline nil)
3047 (setq term-ansi-current-bold nil) 3075 (setq term-ansi-current-bold nil)
3048 (setq term-ansi-current-reverse nil) 3076 (setq term-ansi-current-reverse nil)
3068 ;;; Blink (unsupported by Emacs), will be translated to bold. 3096 ;;; Blink (unsupported by Emacs), will be translated to bold.
3069 ;;; This may change in the future though. 3097 ;;; This may change in the future though.
3070 ((eq parameter 5) 3098 ((eq parameter 5)
3071 (setq term-ansi-current-bold t)) 3099 (setq term-ansi-current-bold t))
3072 3100
3073 ;;; Reverse 3101 ;;; Reverse (terminfo: smso)
3074 ((eq parameter 7) 3102 ((eq parameter 7)
3075 (setq term-ansi-current-reverse t)) 3103 (setq term-ansi-current-reverse t))
3076 3104
3077 ;;; Invisible 3105 ;;; Invisible
3078 ((eq parameter 8) 3106 ((eq parameter 8)
3079 (setq term-ansi-current-invisible t)) 3107 (setq term-ansi-current-invisible t))
3080 3108
3081 ;;; Reset underline (i.e. terminfo rmul) 3109 ;;; Reset underline (terminfo: rmul)
3082 ((eq parameter 24) 3110 ((eq parameter 24)
3083 (setq term-ansi-current-underline nil)) 3111 (setq term-ansi-current-underline nil))
3084 3112
3085 ;;; Reset reverse (i.e. terminfo rmso) 3113 ;;; Reset reverse (terminfo: rmso)
3086 ((eq parameter 27) 3114 ((eq parameter 27)
3087 (setq term-ansi-current-reverse nil)) 3115 (setq term-ansi-current-reverse nil))
3088 3116
3089 ;;; Foreground 3117 ;;; Foreground
3090 ((and (>= parameter 30) (<= parameter 37)) 3118 ((and (>= parameter 30) (<= parameter 37))
3185 ;;; Handle a character assuming (eq terminal-state 2) - 3213 ;;; Handle a character assuming (eq terminal-state 2) -
3186 ;;; i.e. we have previously seen Escape followed by ?[. 3214 ;;; i.e. we have previously seen Escape followed by ?[.
3187 3215
3188 (defun term-handle-ansi-escape (proc char) 3216 (defun term-handle-ansi-escape (proc char)
3189 (cond 3217 (cond
3190 ((or (eq char ?H) ; cursor motion (terminfo: cup) 3218 ((or (eq char ?H) ;; cursor motion (terminfo: cup,home)
3191 ;; (eq char ?f) ; xterm seems to handle this sequence too, not 3219 ;; (eq char ?f) ;; xterm seems to handle this sequence too, not
3192 ;; needed for now 3220 ;; needed for now
3193 ) 3221 )
3194 (if (<= term-terminal-parameter 0) 3222 (if (<= term-terminal-parameter 0)
3195 (setq term-terminal-parameter 1)) 3223 (setq term-terminal-parameter 1))
3196 (if (<= term-terminal-previous-parameter 0) 3224 (if (<= term-terminal-previous-parameter 0)
3203 (1- term-terminal-previous-parameter) 3231 (1- term-terminal-previous-parameter)
3204 (1- term-terminal-parameter))) 3232 (1- term-terminal-parameter)))
3205 ;; \E[A - cursor up (terminfo: cuu, cuu1) 3233 ;; \E[A - cursor up (terminfo: cuu, cuu1)
3206 ((eq char ?A) 3234 ((eq char ?A)
3207 (term-handle-deferred-scroll) 3235 (term-handle-deferred-scroll)
3208 (term-down (- (max 1 term-terminal-parameter)) t)) 3236 (let ((tcr (term-current-row)))
3237 (term-down
3238 (if (< (- tcr term-terminal-parameter) term-scroll-start)
3239 ;; If the amount to move is before scroll start, move
3240 ;; to scroll start.
3241 (- term-scroll-start tcr)
3242 (if (>= term-terminal-parameter tcr)
3243 (- tcr)
3244 (- (max 1 term-terminal-parameter)))) t)))
3209 ;; \E[B - cursor down (terminfo: cud) 3245 ;; \E[B - cursor down (terminfo: cud)
3210 ((eq char ?B) 3246 ((eq char ?B)
3211 (term-down (max 1 term-terminal-parameter) t)) 3247 (let ((tcr (term-current-row)))
3212 ;; \E[C - cursor right (terminfo: cuf) 3248 (unless (= tcr (1- term-scroll-end))
3249 (term-down
3250 (if (> (+ tcr term-terminal-parameter) term-scroll-end)
3251 (- term-scroll-end 1 tcr)
3252 (max 1 term-terminal-parameter)) t))))
3253 ;; \E[C - cursor right (terminfo: cuf, cuf1)
3213 ((eq char ?C) 3254 ((eq char ?C)
3214 (term-move-columns 3255 (term-move-columns
3215 (max 1 3256 (max 1
3216 (if (>= (+ term-terminal-parameter (term-current-column)) term-width) 3257 (if (>= (+ term-terminal-parameter (term-current-column)) term-width)
3217 (- term-width (term-current-column) 1) 3258 (- term-width (term-current-column) 1)
3226 ((eq char ?K) 3267 ((eq char ?K)
3227 (term-erase-in-line term-terminal-parameter)) 3268 (term-erase-in-line term-terminal-parameter))
3228 ;; \E[L - insert lines (terminfo: il, il1) 3269 ;; \E[L - insert lines (terminfo: il, il1)
3229 ((eq char ?L) 3270 ((eq char ?L)
3230 (term-insert-lines (max 1 term-terminal-parameter))) 3271 (term-insert-lines (max 1 term-terminal-parameter)))
3231 ;; \E[M - delete lines 3272 ;; \E[M - delete lines (terminfo: dl, dl1)
3232 ((eq char ?M) 3273 ((eq char ?M)
3233 (term-delete-lines (max 1 term-terminal-parameter))) 3274 (term-delete-lines (max 1 term-terminal-parameter)))
3234 ;; \E[P - delete chars 3275 ;; \E[P - delete chars (terminfo: dch, dch1)
3235 ((eq char ?P) 3276 ((eq char ?P)
3236 (term-delete-chars (max 1 term-terminal-parameter))) 3277 (term-delete-chars (max 1 term-terminal-parameter)))
3237 ;; \E[@ - insert spaces 3278 ;; \E[@ - insert spaces (terminfo: ich)
3238 ((eq char ?@) ;; (terminfo: ich) 3279 ((eq char ?@)
3239 (term-insert-spaces (max 1 term-terminal-parameter))) 3280 (term-insert-spaces (max 1 term-terminal-parameter)))
3240 ;; \E[?h - DEC Private Mode Set 3281 ;; \E[?h - DEC Private Mode Set
3241 ((eq char ?h) 3282 ((eq char ?h)
3242 (cond ((eq term-terminal-parameter 4) ;; (terminfo: smir) 3283 (cond ((eq term-terminal-parameter 4) ;; (terminfo: smir)
3243 (setq term-insert-mode t)) 3284 (setq term-insert-mode t))
3255 ;;; Modified to allow ansi coloring -mm 3296 ;;; Modified to allow ansi coloring -mm
3256 ;; \E[m - Set/reset modes, set bg/fg 3297 ;; \E[m - Set/reset modes, set bg/fg
3257 ;;(terminfo: smso,rmso,smul,rmul,rev,bold,sgr0,invis,op,setab,setaf) 3298 ;;(terminfo: smso,rmso,smul,rmul,rev,bold,sgr0,invis,op,setab,setaf)
3258 ((eq char ?m) 3299 ((eq char ?m)
3259 (when (= term-terminal-more-parameters 1) 3300 (when (= term-terminal-more-parameters 1)
3260 (if (>= term-terminal-previous-parameter-4 0) 3301 (when (>= term-terminal-previous-parameter-4 0)
3261 (term-handle-colors-array term-terminal-previous-parameter-4)) 3302 (term-handle-colors-array term-terminal-previous-parameter-4))
3262 (if (>= term-terminal-previous-parameter-3 0) 3303 (when (>= term-terminal-previous-parameter-3 0)
3263 (term-handle-colors-array term-terminal-previous-parameter-3)) 3304 (term-handle-colors-array term-terminal-previous-parameter-3))
3264 (if (>= term-terminal-previous-parameter-2 0) 3305 (when (>= term-terminal-previous-parameter-2 0)
3265 (term-handle-colors-array term-terminal-previous-parameter-2)) 3306 (term-handle-colors-array term-terminal-previous-parameter-2))
3266 (term-handle-colors-array term-terminal-previous-parameter)) 3307 (term-handle-colors-array term-terminal-previous-parameter))
3267 (term-handle-colors-array term-terminal-parameter)) 3308 (term-handle-colors-array term-terminal-parameter))
3268 3309
3269 ;; \E[6n - Report cursor position 3310 ;; \E[6n - Report cursor position
3270 ((eq char ?n) 3311 ((eq char ?n)
3271 (term-handle-deferred-scroll) 3312 (term-handle-deferred-scroll)
3272 (process-send-string proc 3313 (process-send-string proc
3273 (format "\e[%s;%sR" 3314 (format "\e[%s;%sR"
3274 (1+ (term-current-row)) 3315 (1+ (term-current-row))
3275 (1+ (term-horizontal-column))))) 3316 (1+ (term-horizontal-column)))))
3276 ;; \E[r - Set scrolling region 3317 ;; \E[r - Set scrolling region (terminfo: csr)
3277 ((eq char ?r) ;; (terminfo: csr) 3318 ((eq char ?r)
3278 (term-scroll-region 3319 (term-set-scroll-region
3279 (1- term-terminal-previous-parameter) 3320 (1- term-terminal-previous-parameter)
3280 term-terminal-parameter)) 3321 term-terminal-parameter))
3281 (t))) 3322 (t)))
3282 3323
3283 (defun term-scroll-region (top bottom) 3324 (defun term-set-scroll-region (top bottom)
3284 "Set scrolling region. 3325 "Set scrolling region.
3285 TOP is the top-most line (inclusive) of the new scrolling region, 3326 TOP is the top-most line (inclusive) of the new scrolling region,
3286 while BOTTOM is the line following the new scrolling region (e.g. exclusive). 3327 while BOTTOM is the line following the new scrolling region (e.g. exclusive).
3287 The top-most line is line 0." 3328 The top-most line is line 0."
3288 (setq term-scroll-start 3329 (setq term-scroll-start
3296 (setq term-scroll-with-delete 3337 (setq term-scroll-with-delete
3297 (or (term-using-alternate-sub-buffer) 3338 (or (term-using-alternate-sub-buffer)
3298 (not (and (= term-scroll-start 0) 3339 (not (and (= term-scroll-start 0)
3299 (= term-scroll-end term-height))))) 3340 (= term-scroll-end term-height)))))
3300 (term-move-columns (- (term-current-column))) 3341 (term-move-columns (- (term-current-column)))
3301 (term-goto 3342 (term-goto 0 0))
3302 term-scroll-start (term-current-column)))
3303 3343
3304 ;; (defun term-switch-to-alternate-sub-buffer (set) 3344 ;; (defun term-switch-to-alternate-sub-buffer (set)
3305 ;; ;; If asked to switch to (from) the alternate sub-buffer, and already (not) 3345 ;; ;; If asked to switch to (from) the alternate sub-buffer, and already (not)
3306 ;; ;; using it, do nothing. This test is needed for some programs (including 3346 ;; ;; using it, do nothing. This test is needed for some programs (including
3307 ;; ;; Emacs) that emit the ti termcap string twice, for unknown reason. 3347 ;; ;; Emacs) that emit the ti termcap string twice, for unknown reason.
3580 ;; Make sure there are DOWN blank lines below the current one. 3620 ;; Make sure there are DOWN blank lines below the current one.
3581 ;; Return 0 if we're unable (because of PAGER handling), else return DOWN. 3621 ;; Return 0 if we're unable (because of PAGER handling), else return DOWN.
3582 3622
3583 (defun term-handle-scroll (down) 3623 (defun term-handle-scroll (down)
3584 (let ((scroll-needed 3624 (let ((scroll-needed
3585 (- (+ (term-current-row) down 1) term-scroll-end))) 3625 (- (+ (term-current-row) down)
3586 (if (> scroll-needed 0) 3626 (if (< down 0) term-scroll-start term-scroll-end))))
3627 (if (or (and (< down 0) (< scroll-needed 0))
3628 (and (> down 0) (> scroll-needed 0)))
3587 (let ((save-point (copy-marker (point))) (save-top)) 3629 (let ((save-point (copy-marker (point))) (save-top))
3588 (goto-char term-home-marker) 3630 (goto-char term-home-marker)
3589 (cond (term-scroll-with-delete 3631 (cond (term-scroll-with-delete
3590 ;; delete scroll-needed lines at term-scroll-start 3632 (if (< down 0)
3591 (term-vertical-motion term-scroll-start) 3633 (progn
3592 (setq save-top (point)) 3634 ;; Delete scroll-needed lines at term-scroll-end,
3593 (term-vertical-motion scroll-needed) 3635 ;; then insert scroll-needed lines.
3594 (delete-region save-top (point)) 3636 (term-vertical-motion (1- term-scroll-end))
3595 (goto-char save-point) 3637 (end-of-line)
3596 (term-vertical-motion down) 3638 (setq save-top (point))
3597 (term-adjust-current-row-cache (- scroll-needed)) 3639 (term-vertical-motion scroll-needed)
3640 (end-of-line)
3641 (delete-region save-top (point))
3642 (goto-char save-point)
3643 (setq down (- scroll-needed down))
3644 (term-vertical-motion down))
3645 ;; Delete scroll-needed lines at term-scroll-start.
3646 (term-vertical-motion term-scroll-start)
3647 (setq save-top (point))
3648 (term-vertical-motion scroll-needed)
3649 (delete-region save-top (point))
3650 (goto-char save-point)
3651 (term-vertical-motion down)
3652 (term-adjust-current-row-cache (- scroll-needed)))
3598 (setq term-current-column nil) 3653 (setq term-current-column nil)
3599 (term-insert-char ?\n scroll-needed)) 3654 (term-insert-char ?\n (abs scroll-needed)))
3600 ((and (numberp term-pager-count) 3655 ((and (numberp term-pager-count)
3601 (< (setq term-pager-count (- term-pager-count down)) 3656 (< (setq term-pager-count (- term-pager-count down))
3602 0)) 3657 0))
3603 (setq down 0) 3658 (setq down 0)
3604 (term-process-pager)) 3659 (term-process-pager))
3611 down) 3666 down)
3612 3667
3613 (defun term-down (down &optional check-for-scroll) 3668 (defun term-down (down &optional check-for-scroll)
3614 "Move down DOWN screen lines vertically." 3669 "Move down DOWN screen lines vertically."
3615 (let ((start-column (term-horizontal-column))) 3670 (let ((start-column (term-horizontal-column)))
3616 (if (and check-for-scroll (or term-scroll-with-delete term-pager-count)) 3671 (when (and check-for-scroll (or term-scroll-with-delete term-pager-count))
3617 (setq down (term-handle-scroll down))) 3672 (setq down (term-handle-scroll down)))
3618 (term-adjust-current-row-cache down) 3673 (unless (and (= term-current-row 0) (< down 0))
3619 (if (or (/= (point) (point-max)) (< down 0)) 3674 (term-adjust-current-row-cache down)
3620 (setq down (- down (term-vertical-motion down)))) 3675 (when (or (/= (point) (point-max)) (< down 0))
3621 ;; Extend buffer with extra blank lines if needed. 3676 (setq down (- down (term-vertical-motion down)))))
3622 (cond ((> down 0) 3677 (cond ((>= down 0)
3678 ;; Extend buffer with extra blank lines if needed.
3623 (term-insert-char ?\n down) 3679 (term-insert-char ?\n down)
3624 (setq term-current-column 0) 3680 (setq term-current-column 0)
3625 (setq term-start-line-column 0)) 3681 (setq term-start-line-column 0))
3626 (t 3682 (t
3627 (setq term-current-column nil) 3683 (when (= term-current-row 0)
3684 ;; Insert lines if at the beginning.
3685 (save-excursion (term-insert-char ?\n (- down)))
3686 (save-excursion
3687 (let (p)
3688 ;; Delete lines from the end.
3689 (forward-line term-height)
3690 (setq p (point))
3691 (forward-line (- down))
3692 (delete-region p (point)))))
3693 (setq term-current-column 0)
3628 (setq term-start-line-column (current-column)))) 3694 (setq term-start-line-column (current-column))))
3629 (if start-column 3695 (when start-column
3630 (term-move-columns start-column)))) 3696 (term-move-columns start-column))))
3631 3697
3632 ;; Assuming point is at the beginning of a screen line, 3698 ;; Assuming point is at the beginning of a screen line,
3633 ;; if the line above point wraps around, add a ?\n to undo the wrapping. 3699 ;; if the line above point wraps around, add a ?\n to undo the wrapping.
3634 ;; FIXME: Probably should be called more than it is. 3700 ;; FIXME: Probably should be called more than it is.
3635 (defun term-unwrap-line () 3701 (defun term-unwrap-line ()
3691 (move-to-column (+ (term-current-column) count) t) 3757 (move-to-column (+ (term-current-column) count) t)
3692 (delete-region save-point (point)))) 3758 (delete-region save-point (point))))
3693 3759
3694 ;;; Insert COUNT spaces after point, but do not change any of 3760 ;;; Insert COUNT spaces after point, but do not change any of
3695 ;;; following screen lines. Hence we may have to delete characters 3761 ;;; following screen lines. Hence we may have to delete characters
3696 ;;; at teh end of this screen line to make room. 3762 ;;; at the end of this screen line to make room.
3697 3763
3698 (defun term-insert-spaces (count) 3764 (defun term-insert-spaces (count)
3699 (let ((save-point (point)) (save-eol) (point-at-eol)) 3765 (let ((save-point (point)) (save-eol) (pnt-at-eol))
3700 (term-vertical-motion 1) 3766 (term-vertical-motion 1)
3701 (if (bolp) 3767 (when (bolp)
3702 (backward-char)) 3768 (backward-char))
3703 (setq save-eol (point)) 3769 (setq save-eol (point))
3704 (save-excursion 3770 (save-excursion
3705 (end-of-line) 3771 (end-of-line)
3706 (setq point-at-eol (point))) 3772 (setq pnt-at-eol (point)))
3707 (move-to-column (+ (term-start-line-column) (- term-width count)) t) 3773 (move-to-column (+ (term-start-line-column) (- term-width count)) t)
3708 ;; If move-to-column extends the current line it will use the face 3774 ;; If move-to-column extends the current line it will use the face
3709 ;; from the last character on the line, set the face for the chars 3775 ;; from the last character on the line, set the face for the chars
3710 ;; to default. 3776 ;; to default.
3711 (when (> (point) (point-at-eol)) 3777 (when (>= (point) pnt-at-eol)
3712 (put-text-property point-at-eol (point) 'face 'default)) 3778 (put-text-property pnt-at-eol (point) 'face 'default))
3713 (if (> save-eol (point)) 3779 (when (> save-eol (point))
3714 (delete-region (point) save-eol)) 3780 (delete-region (point) save-eol))
3715 (goto-char save-point) 3781 (goto-char save-point)
3716 (term-insert-char ? count) 3782 (term-insert-char ? count)
3717 (goto-char save-point))) 3783 (goto-char save-point)))
3718 3784
3719 (defun term-delete-lines (lines) 3785 (defun term-delete-lines (lines)
3720 (let ((start (point)) 3786 (let ((start (point))
3721 (save-current-column term-current-column) 3787 (save-current-column term-current-column)
3722 (save-start-line-column term-start-line-column) 3788 (save-start-line-column term-start-line-column)
3723 (save-current-row (term-current-row))) 3789 (save-current-row (term-current-row)))
3790 (when (>= (+ save-current-row lines) term-scroll-end)
3791 (setq lines (- lines (- (+ save-current-row lines) term-scroll-end))))
3724 (term-down lines) 3792 (term-down lines)
3725 (delete-region start (point)) 3793 (delete-region start (point))
3726 (term-down (- term-scroll-end save-current-row lines)) 3794 (term-down (- term-scroll-end save-current-row lines))
3727 (term-insert-char ?\n lines) 3795 (term-insert-char ?\n lines)
3728 (setq term-current-column save-current-column) 3796 (setq term-current-column save-current-column)
3734 (let ((start (point)) 3802 (let ((start (point))
3735 (start-deleted) 3803 (start-deleted)
3736 (save-current-column term-current-column) 3804 (save-current-column term-current-column)
3737 (save-start-line-column term-start-line-column) 3805 (save-start-line-column term-start-line-column)
3738 (save-current-row (term-current-row))) 3806 (save-current-row (term-current-row)))
3739 (term-down (- term-scroll-end save-current-row lines)) 3807 ;; Inserting lines should take into account the scroll region.
3808 (if (< save-current-row term-scroll-start)
3809 ;; If point is before scroll start,
3810 (progn
3811 (setq lines (- lines (- term-scroll-start save-current-row)))
3812 (term-down (- term-scroll-start save-current-row))
3813 (setq start (point)))
3814 ;; The number of inserted lines shouldn't exceed the scroll region end.
3815 (when (>= (+ save-current-row lines) term-scroll-end)
3816 (setq lines (- lines (- (+ save-current-row lines) term-scroll-end))))
3817 (term-down (- term-scroll-end save-current-row lines)))
3740 (setq start-deleted (point)) 3818 (setq start-deleted (point))
3741 (term-down lines) 3819 (term-down lines)
3742 (delete-region start-deleted (point)) 3820 (delete-region start-deleted (point))
3743 (goto-char start) 3821 (goto-char start)
3744 (setq term-current-column save-current-column) 3822 (setq term-current-column save-current-column)