Mercurial > emacs
comparison 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 |
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) |