diff options
| author | Dan Nicolaescu | 2006-05-29 06:11:33 +0000 |
|---|---|---|
| committer | Dan Nicolaescu | 2006-05-29 06:11:33 +0000 |
| commit | c57597ddb27edbe264f374fa53272a179fbbc129 (patch) | |
| tree | fe51abfebc528e33710785a87f1e69920656e2f9 | |
| parent | b486a098cb1969341daf73eb96b106cd52fa2b32 (diff) | |
| download | emacs-c57597ddb27edbe264f374fa53272a179fbbc129.tar.gz emacs-c57597ddb27edbe264f374fa53272a179fbbc129.zip | |
(term-if-xemacs, term-ifnot-xemacs): Delete, replace
uses with a simple test.
(term-set-escape-char, term-mode, term-check-kill-echo-list)
(term-send-raw-string, term-send-raw, term-mouse-paste)
(term-char-mode, term-line-mode, term-exec, term-sentinel)
(term-handle-exit, term-read-input-ring)
(term-previous-matching-input-string)
(term-previous-matching-input-string-position)
(term-previous-matching-input-from-input)
(term-replace-by-expanded-history, term-send-input)
(term-skip-prompt, term-bol, term-send-invisible)
(term-kill-input, term-delchar-or-maybe-eof)
(term-backward-matching-input, term-check-source)
(term-proc-query, term-emulate-terminal)
(term-handle-colors-array, term-process-pager, term-pager-line)
(term-pager-bob, term-unwrap-line, term-word)
(term-dynamic-complete-filename)
(term-dynamic-complete-as-filename)
(term-dynamic-simple-complete): Replace one arm ifs with whens or
unlesses.
| -rw-r--r-- | lisp/ChangeLog | 23 | ||||
| -rw-r--r-- | lisp/term.el | 798 |
2 files changed, 411 insertions, 410 deletions
diff --git a/lisp/ChangeLog b/lisp/ChangeLog index c1221136a54..08304facfaf 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog | |||
| @@ -1,3 +1,26 @@ | |||
| 1 | 2006-05-28 Dan Nicolaescu <dann@ics.uci.edu> | ||
| 2 | |||
| 3 | * term.el (term-if-xemacs, term-ifnot-xemacs): Delete, replace | ||
| 4 | uses with a simple test. | ||
| 5 | (term-set-escape-char, term-mode, term-check-kill-echo-list) | ||
| 6 | (term-send-raw-string, term-send-raw, term-mouse-paste) | ||
| 7 | (term-char-mode, term-line-mode, term-exec, term-sentinel) | ||
| 8 | (term-handle-exit, term-read-input-ring) | ||
| 9 | (term-previous-matching-input-string) | ||
| 10 | (term-previous-matching-input-string-position) | ||
| 11 | (term-previous-matching-input-from-input) | ||
| 12 | (term-replace-by-expanded-history, term-send-input) | ||
| 13 | (term-skip-prompt, term-bol, term-send-invisible) | ||
| 14 | (term-kill-input, term-delchar-or-maybe-eof) | ||
| 15 | (term-backward-matching-input, term-check-source) | ||
| 16 | (term-proc-query, term-emulate-terminal) | ||
| 17 | (term-handle-colors-array, term-process-pager, term-pager-line) | ||
| 18 | (term-pager-bob, term-unwrap-line, term-word) | ||
| 19 | (term-dynamic-complete-filename) | ||
| 20 | (term-dynamic-complete-as-filename) | ||
| 21 | (term-dynamic-simple-complete): Replace one arm ifs with whens or | ||
| 22 | unlesses. | ||
| 23 | |||
| 1 | 2006-05-29 Stefan Monnier <monnier@iro.umontreal.ca> | 24 | 2006-05-29 Stefan Monnier <monnier@iro.umontreal.ca> |
| 2 | 25 | ||
| 3 | * files.el (hack-one-local-variable-eval-safep): Don't burp if used | 26 | * files.el (hack-one-local-variable-eval-safep): Don't burp if used |
diff --git a/lisp/term.el b/lisp/term.el index a03970a368b..8e2e0773121 100644 --- a/lisp/term.el +++ b/lisp/term.el | |||
| @@ -660,13 +660,6 @@ Buffer local variable.") | |||
| 660 | (put 'term-scroll-show-maximum-output 'permanent-local t) | 660 | (put 'term-scroll-show-maximum-output 'permanent-local t) |
| 661 | (put 'term-ptyp 'permanent-local t) | 661 | (put 'term-ptyp 'permanent-local t) |
| 662 | 662 | ||
| 663 | ;; Do FORM if running under XEmacs (previously Lucid Emacs). | ||
| 664 | (defmacro term-if-xemacs (&rest forms) | ||
| 665 | (if (featurep 'xemacs) (cons 'progn forms))) | ||
| 666 | ;; Do FORM if NOT running under XEmacs (previously Lucid Emacs). | ||
| 667 | (defmacro term-ifnot-xemacs (&rest forms) | ||
| 668 | (if (not (featurep 'xemacs)) (cons 'progn forms))) | ||
| 669 | |||
| 670 | (defmacro term-in-char-mode () '(eq (current-local-map) term-raw-map)) | 663 | (defmacro term-in-char-mode () '(eq (current-local-map) term-raw-map)) |
| 671 | (defmacro term-in-line-mode () '(not (term-in-char-mode))) | 664 | (defmacro term-in-line-mode () '(not (term-in-char-mode))) |
| 672 | ;; True if currently doing PAGER handling. | 665 | ;; True if currently doing PAGER handling. |
| @@ -725,13 +718,13 @@ Notice that a setting of 0 means 'don't truncate anything'. This variable | |||
| 725 | is buffer-local.") | 718 | is buffer-local.") |
| 726 | ;;; | 719 | ;;; |
| 727 | 720 | ||
| 728 | (term-if-xemacs | 721 | (when (featurep 'xemacs) |
| 729 | (defvar term-terminal-menu | 722 | (defvar term-terminal-menu |
| 730 | '("Terminal" | 723 | '("Terminal" |
| 731 | [ "Character mode" term-char-mode (term-in-line-mode)] | 724 | [ "Character mode" term-char-mode (term-in-line-mode)] |
| 732 | [ "Line mode" term-line-mode (term-in-char-mode)] | 725 | [ "Line mode" term-line-mode (term-in-char-mode)] |
| 733 | [ "Enable paging" term-pager-toggle (not term-pager-count)] | 726 | [ "Enable paging" term-pager-toggle (not term-pager-count)] |
| 734 | [ "Disable paging" term-pager-toggle term-pager-count]))) | 727 | [ "Disable paging" term-pager-toggle term-pager-count]))) |
| 735 | 728 | ||
| 736 | (unless term-mode-map | 729 | (unless term-mode-map |
| 737 | (setq term-mode-map (make-sparse-keymap)) | 730 | (setq term-mode-map (make-sparse-keymap)) |
| @@ -739,10 +732,10 @@ is buffer-local.") | |||
| 739 | (define-key term-mode-map "\en" 'term-next-input) | 732 | (define-key term-mode-map "\en" 'term-next-input) |
| 740 | (define-key term-mode-map "\er" 'term-previous-matching-input) | 733 | (define-key term-mode-map "\er" 'term-previous-matching-input) |
| 741 | (define-key term-mode-map "\es" 'term-next-matching-input) | 734 | (define-key term-mode-map "\es" 'term-next-matching-input) |
| 742 | (term-ifnot-xemacs | 735 | (unless (featurep 'xemacs) |
| 743 | (define-key term-mode-map [?\A-\M-r] | 736 | (define-key term-mode-map [?\A-\M-r] |
| 744 | 'term-previous-matching-input-from-input) | 737 | 'term-previous-matching-input-from-input) |
| 745 | (define-key term-mode-map [?\A-\M-s] 'term-next-matching-input-from-input)) | 738 | (define-key term-mode-map [?\A-\M-s] 'term-next-matching-input-from-input)) |
| 746 | (define-key term-mode-map "\e\C-l" 'term-show-output) | 739 | (define-key term-mode-map "\e\C-l" 'term-show-output) |
| 747 | (define-key term-mode-map "\C-m" 'term-send-input) | 740 | (define-key term-mode-map "\C-m" 'term-send-input) |
| 748 | (define-key term-mode-map "\C-d" 'term-delchar-or-maybe-eof) | 741 | (define-key term-mode-map "\C-d" 'term-delchar-or-maybe-eof) |
| @@ -781,9 +774,7 @@ is buffer-local.") | |||
| 781 | ) | 774 | ) |
| 782 | 775 | ||
| 783 | ;; Menu bars: | 776 | ;; Menu bars: |
| 784 | (term-ifnot-xemacs | 777 | (unless (featurep 'xemacs) |
| 785 | (progn | ||
| 786 | |||
| 787 | ;; terminal: | 778 | ;; terminal: |
| 788 | (let (newmap) | 779 | (let (newmap) |
| 789 | (setq newmap (make-sparse-keymap "Terminal")) | 780 | (setq newmap (make-sparse-keymap "Terminal")) |
| @@ -860,14 +851,14 @@ is buffer-local.") | |||
| 860 | (define-key newmap [] '("BREAK" . term-interrupt-subjob)) | 851 | (define-key newmap [] '("BREAK" . term-interrupt-subjob)) |
| 861 | (define-key term-mode-map [menu-bar signals] | 852 | (define-key term-mode-map [menu-bar signals] |
| 862 | (setq term-signals-menu (cons "Signals" newmap))) | 853 | (setq term-signals-menu (cons "Signals" newmap))) |
| 863 | ))) | 854 | )) |
| 864 | 855 | ||
| 865 | ;; Set up term-raw-map, etc. | 856 | ;; Set up term-raw-map, etc. |
| 866 | 857 | ||
| 867 | (defun term-set-escape-char (c) | 858 | (defun term-set-escape-char (c) |
| 868 | "Change term-escape-char and keymaps that depend on it." | 859 | "Change term-escape-char and keymaps that depend on it." |
| 869 | (if term-escape-char | 860 | (when term-escape-char |
| 870 | (define-key term-raw-map term-escape-char 'term-send-raw)) | 861 | (define-key term-raw-map term-escape-char 'term-send-raw)) |
| 871 | (setq c (make-string 1 c)) | 862 | (setq c (make-string 1 c)) |
| 872 | (define-key term-raw-map c term-raw-escape-map) | 863 | (define-key term-raw-map c term-raw-escape-map) |
| 873 | ;; Define standard bindings in term-raw-escape-map | 864 | ;; Define standard bindings in term-raw-escape-map |
| @@ -901,28 +892,26 @@ is buffer-local.") | |||
| 901 | 892 | ||
| 902 | ;;; Added nearly all the 'grey keys' -mm | 893 | ;;; Added nearly all the 'grey keys' -mm |
| 903 | 894 | ||
| 904 | (progn | 895 | (if (featurep 'xemacs) |
| 905 | (term-if-xemacs | 896 | (define-key term-raw-map [button2] 'term-mouse-paste) |
| 906 | (define-key term-raw-map [button2] 'term-mouse-paste)) | 897 | (define-key term-raw-map [mouse-2] 'term-mouse-paste) |
| 907 | (term-ifnot-xemacs | 898 | (define-key term-raw-map [menu-bar terminal] term-terminal-menu) |
| 908 | (define-key term-raw-map [mouse-2] 'term-mouse-paste) | 899 | (define-key term-raw-map [menu-bar signals] term-signals-menu)) |
| 909 | (define-key term-raw-map [menu-bar terminal] term-terminal-menu) | 900 | (define-key term-raw-map [up] 'term-send-up) |
| 910 | (define-key term-raw-map [menu-bar signals] term-signals-menu)) | 901 | (define-key term-raw-map [down] 'term-send-down) |
| 911 | (define-key term-raw-map [up] 'term-send-up) | 902 | (define-key term-raw-map [right] 'term-send-right) |
| 912 | (define-key term-raw-map [down] 'term-send-down) | 903 | (define-key term-raw-map [left] 'term-send-left) |
| 913 | (define-key term-raw-map [right] 'term-send-right) | 904 | (define-key term-raw-map [delete] 'term-send-del) |
| 914 | (define-key term-raw-map [left] 'term-send-left) | 905 | (define-key term-raw-map [deletechar] 'term-send-del) |
| 915 | (define-key term-raw-map [delete] 'term-send-del) | 906 | (define-key term-raw-map [backspace] 'term-send-backspace) |
| 916 | (define-key term-raw-map [deletechar] 'term-send-del) | 907 | (define-key term-raw-map [home] 'term-send-home) |
| 917 | (define-key term-raw-map [backspace] 'term-send-backspace) | 908 | (define-key term-raw-map [end] 'term-send-end) |
| 918 | (define-key term-raw-map [home] 'term-send-home) | 909 | (define-key term-raw-map [insert] 'term-send-insert) |
| 919 | (define-key term-raw-map [end] 'term-send-end) | 910 | (define-key term-raw-map [S-prior] 'scroll-down) |
| 920 | (define-key term-raw-map [insert] 'term-send-insert) | 911 | (define-key term-raw-map [S-next] 'scroll-up) |
| 921 | (define-key term-raw-map [S-prior] 'scroll-down) | 912 | (define-key term-raw-map [S-insert] 'term-paste) |
| 922 | (define-key term-raw-map [S-next] 'scroll-up) | 913 | (define-key term-raw-map [prior] 'term-send-prior) |
| 923 | (define-key term-raw-map [S-insert] 'term-paste) | 914 | (define-key term-raw-map [next] 'term-send-next)) |
| 924 | (define-key term-raw-map [prior] 'term-send-prior) | ||
| 925 | (define-key term-raw-map [next] 'term-send-next))) | ||
| 926 | 915 | ||
| 927 | (term-set-escape-char ?\C-c) | 916 | (term-set-escape-char ?\C-c) |
| 928 | 917 | ||
| @@ -1114,9 +1103,9 @@ Entry to this mode runs the hooks on `term-mode-hook'." | |||
| 1114 | ;; Cua-mode's keybindings interfere with the term keybindings, disable it. | 1103 | ;; Cua-mode's keybindings interfere with the term keybindings, disable it. |
| 1115 | (set (make-local-variable 'cua-mode) nil) | 1104 | (set (make-local-variable 'cua-mode) nil) |
| 1116 | (run-mode-hooks 'term-mode-hook) | 1105 | (run-mode-hooks 'term-mode-hook) |
| 1117 | (term-if-xemacs | 1106 | (when (featurep 'xemacs) |
| 1118 | (set-buffer-menubar | 1107 | (set-buffer-menubar |
| 1119 | (append current-menubar (list term-terminal-menu)))) | 1108 | (append current-menubar (list term-terminal-menu)))) |
| 1120 | (or term-input-ring | 1109 | (or term-input-ring |
| 1121 | (setq term-input-ring (make-ring term-input-ring-size))) | 1110 | (setq term-input-ring (make-ring term-input-ring-size))) |
| 1122 | (term-update-mode-line)) | 1111 | (term-update-mode-line)) |
| @@ -1153,16 +1142,15 @@ Entry to this mode runs the hooks on `term-mode-hook'." | |||
| 1153 | (setq term-start-line-column nil) | 1142 | (setq term-start-line-column nil) |
| 1154 | (setq cur nil found t)) | 1143 | (setq cur nil found t)) |
| 1155 | (setq cur (cdr cur)))))) | 1144 | (setq cur (cdr cur)))))) |
| 1156 | (if (not found) | 1145 | (when (not found) |
| 1157 | (goto-char save-point))) | 1146 | (goto-char save-point))) |
| 1158 | found)) | 1147 | found)) |
| 1159 | 1148 | ||
| 1160 | (defun term-check-size (process) | 1149 | (defun term-check-size (process) |
| 1161 | (if (or (/= term-height (1- (window-height))) | 1150 | (when (or (/= term-height (1- (window-height))) |
| 1162 | (/= term-width (term-window-width))) | 1151 | (/= term-width (term-window-width))) |
| 1163 | (progn | 1152 | (term-reset-size (1- (window-height)) (term-window-width)) |
| 1164 | (term-reset-size (1- (window-height)) (term-window-width)) | 1153 | (set-process-window-size process term-height term-width))) |
| 1165 | (set-process-window-size process term-height term-width)))) | ||
| 1166 | 1154 | ||
| 1167 | (defun term-send-raw-string (chars) | 1155 | (defun term-send-raw-string (chars) |
| 1168 | (let ((proc (get-buffer-process (current-buffer)))) | 1156 | (let ((proc (get-buffer-process (current-buffer)))) |
| @@ -1171,8 +1159,8 @@ Entry to this mode runs the hooks on `term-mode-hook'." | |||
| 1171 | ;; Note that (term-current-row) must be called *after* | 1159 | ;; Note that (term-current-row) must be called *after* |
| 1172 | ;; (point) has been updated to (process-mark proc). | 1160 | ;; (point) has been updated to (process-mark proc). |
| 1173 | (goto-char (process-mark proc)) | 1161 | (goto-char (process-mark proc)) |
| 1174 | (if (term-pager-enabled) | 1162 | (when (term-pager-enabled) |
| 1175 | (setq term-pager-count (term-current-row))) | 1163 | (setq term-pager-count (term-current-row))) |
| 1176 | (process-send-string proc chars)))) | 1164 | (process-send-string proc chars)))) |
| 1177 | 1165 | ||
| 1178 | (defun term-send-raw () | 1166 | (defun term-send-raw () |
| @@ -1180,9 +1168,9 @@ Entry to this mode runs the hooks on `term-mode-hook'." | |||
| 1180 | without any interpretation." | 1168 | without any interpretation." |
| 1181 | (interactive) | 1169 | (interactive) |
| 1182 | ;; Convert `return' to C-m, etc. | 1170 | ;; Convert `return' to C-m, etc. |
| 1183 | (if (and (symbolp last-input-char) | 1171 | (when (and (symbolp last-input-char) |
| 1184 | (get last-input-char 'ascii-character)) | 1172 | (get last-input-char 'ascii-character)) |
| 1185 | (setq last-input-char (get last-input-char 'ascii-character))) | 1173 | (setq last-input-char (get last-input-char 'ascii-character))) |
| 1186 | (term-send-raw-string (make-string 1 last-input-char))) | 1174 | (term-send-raw-string (make-string 1 last-input-char))) |
| 1187 | 1175 | ||
| 1188 | (defun term-send-raw-meta () | 1176 | (defun term-send-raw-meta () |
| @@ -1207,19 +1195,19 @@ without any interpretation." | |||
| 1207 | (defun term-mouse-paste (click arg) | 1195 | (defun term-mouse-paste (click arg) |
| 1208 | "Insert the last stretch of killed text at the position clicked on." | 1196 | "Insert the last stretch of killed text at the position clicked on." |
| 1209 | (interactive "e\nP") | 1197 | (interactive "e\nP") |
| 1210 | (term-if-xemacs | 1198 | (if (featurep 'xemacs) |
| 1211 | (term-send-raw-string (or (condition-case () (x-get-selection) (error ())) | 1199 | (term-send-raw-string |
| 1212 | (x-get-cutbuffer) | 1200 | (or (condition-case () (x-get-selection) (error ())) |
| 1213 | (error "No selection or cut buffer available")))) | 1201 | (x-get-cutbuffer) |
| 1214 | (term-ifnot-xemacs | 1202 | (error "No selection or cut buffer available"))) |
| 1215 | ;; Give temporary modes such as isearch a chance to turn off. | 1203 | ;; Give temporary modes such as isearch a chance to turn off. |
| 1216 | (run-hooks 'mouse-leave-buffer-hook) | 1204 | (run-hooks 'mouse-leave-buffer-hook) |
| 1217 | (setq this-command 'yank) | 1205 | (setq this-command 'yank) |
| 1218 | (mouse-set-point click) | 1206 | (mouse-set-point click) |
| 1219 | (term-send-raw-string (current-kill (cond | 1207 | (term-send-raw-string (current-kill (cond |
| 1220 | ((listp arg) 0) | 1208 | ((listp arg) 0) |
| 1221 | ((eq arg '-) -1) | 1209 | ((eq arg '-) -1) |
| 1222 | (t (1- arg))))))) | 1210 | (t (1- arg))))))) |
| 1223 | 1211 | ||
| 1224 | (defun term-paste () | 1212 | (defun term-paste () |
| 1225 | "Insert the last stretch of killed text at point." | 1213 | "Insert the last stretch of killed text at point." |
| @@ -1248,33 +1236,31 @@ Each character you type is sent directly to the inferior without | |||
| 1248 | intervention from Emacs, except for the escape character (usually C-c)." | 1236 | intervention from Emacs, except for the escape character (usually C-c)." |
| 1249 | (interactive) | 1237 | (interactive) |
| 1250 | ;; FIXME: Emit message? Cfr ilisp-raw-message | 1238 | ;; FIXME: Emit message? Cfr ilisp-raw-message |
| 1251 | (if (term-in-line-mode) | 1239 | (when (term-in-line-mode) |
| 1252 | (progn | 1240 | (setq term-old-mode-map (current-local-map)) |
| 1253 | (setq term-old-mode-map (current-local-map)) | 1241 | (use-local-map term-raw-map) |
| 1254 | (use-local-map term-raw-map) | 1242 | |
| 1255 | 1243 | ;; Send existing partial line to inferior (without newline). | |
| 1256 | ;; Send existing partial line to inferior (without newline). | 1244 | (let ((pmark (process-mark (get-buffer-process (current-buffer)))) |
| 1257 | (let ((pmark (process-mark (get-buffer-process (current-buffer)))) | 1245 | (save-input-sender term-input-sender)) |
| 1258 | (save-input-sender term-input-sender)) | 1246 | (when (> (point) pmark) |
| 1259 | (if (> (point) pmark) | 1247 | (unwind-protect |
| 1260 | (unwind-protect | 1248 | (progn |
| 1261 | (progn | 1249 | (setq term-input-sender |
| 1262 | (setq term-input-sender | 1250 | (symbol-function 'term-send-string)) |
| 1263 | (symbol-function 'term-send-string)) | 1251 | (end-of-line) |
| 1264 | (end-of-line) | 1252 | (term-send-input)) |
| 1265 | (term-send-input)) | 1253 | (setq term-input-sender save-input-sender)))) |
| 1266 | (setq term-input-sender save-input-sender)))) | 1254 | (term-update-mode-line))) |
| 1267 | (term-update-mode-line)))) | ||
| 1268 | 1255 | ||
| 1269 | (defun term-line-mode () | 1256 | (defun term-line-mode () |
| 1270 | "Switch to line (\"cooked\") sub-mode of term mode. | 1257 | "Switch to line (\"cooked\") sub-mode of term mode. |
| 1271 | This means that Emacs editing commands work as normally, until | 1258 | This means that Emacs editing commands work as normally, until |
| 1272 | you type \\[term-send-input] which sends the current line to the inferior." | 1259 | you type \\[term-send-input] which sends the current line to the inferior." |
| 1273 | (interactive) | 1260 | (interactive) |
| 1274 | (if (term-in-char-mode) | 1261 | (when (term-in-char-mode) |
| 1275 | (progn | 1262 | (use-local-map term-old-mode-map) |
| 1276 | (use-local-map term-old-mode-map) | 1263 | (term-update-mode-line))) |
| 1277 | (term-update-mode-line)))) | ||
| 1278 | 1264 | ||
| 1279 | (defun term-update-mode-line () | 1265 | (defun term-update-mode-line () |
| 1280 | (setq mode-line-process | 1266 | (setq mode-line-process |
| @@ -1332,7 +1318,7 @@ buffer. The hook term-exec-hook is run after each exec." | |||
| 1332 | (save-excursion | 1318 | (save-excursion |
| 1333 | (set-buffer buffer) | 1319 | (set-buffer buffer) |
| 1334 | (let ((proc (get-buffer-process buffer))) ; Blast any old process. | 1320 | (let ((proc (get-buffer-process buffer))) ; Blast any old process. |
| 1335 | (if proc (delete-process proc))) | 1321 | (when proc (delete-process proc))) |
| 1336 | ;; Crank up a new process | 1322 | ;; Crank up a new process |
| 1337 | (let ((proc (term-exec-1 name buffer command switches))) | 1323 | (let ((proc (term-exec-1 name buffer command switches))) |
| 1338 | (make-local-variable 'term-ptyp) | 1324 | (make-local-variable 'term-ptyp) |
| @@ -1362,29 +1348,28 @@ buffer. The hook term-exec-hook is run after each exec." | |||
| 1362 | "Sentinel for term buffers. | 1348 | "Sentinel for term buffers. |
| 1363 | The main purpose is to get rid of the local keymap." | 1349 | The main purpose is to get rid of the local keymap." |
| 1364 | (let ((buffer (process-buffer proc))) | 1350 | (let ((buffer (process-buffer proc))) |
| 1365 | (if (memq (process-status proc) '(signal exit)) | 1351 | (when (memq (process-status proc) '(signal exit)) |
| 1366 | (progn | 1352 | (if (null (buffer-name buffer)) |
| 1367 | (if (null (buffer-name buffer)) | 1353 | ;; buffer killed |
| 1368 | ;; buffer killed | 1354 | (set-process-buffer proc nil) |
| 1369 | (set-process-buffer proc nil) | 1355 | (let ((obuf (current-buffer))) |
| 1370 | (let ((obuf (current-buffer))) | 1356 | ;; save-excursion isn't the right thing if |
| 1371 | ;; save-excursion isn't the right thing if | 1357 | ;; process-buffer is current-buffer |
| 1372 | ;; process-buffer is current-buffer | 1358 | (unwind-protect |
| 1373 | (unwind-protect | 1359 | (progn |
| 1374 | (progn | 1360 | ;; Write something in the compilation buffer |
| 1375 | ;; Write something in the compilation buffer | 1361 | ;; and hack its mode line. |
| 1376 | ;; and hack its mode line. | 1362 | (set-buffer buffer) |
| 1377 | (set-buffer buffer) | 1363 | ;; Get rid of local keymap. |
| 1378 | ;; Get rid of local keymap. | 1364 | (use-local-map nil) |
| 1379 | (use-local-map nil) | 1365 | (term-handle-exit (process-name proc) |
| 1380 | (term-handle-exit (process-name proc) | 1366 | msg) |
| 1381 | msg) | 1367 | ;; Since the buffer and mode line will show that the |
| 1382 | ;; Since the buffer and mode line will show that the | 1368 | ;; process is dead, we can delete it now. Otherwise it |
| 1383 | ;; process is dead, we can delete it now. Otherwise it | 1369 | ;; will stay around until M-x list-processes. |
| 1384 | ;; will stay around until M-x list-processes. | 1370 | (delete-process proc)) |
| 1385 | (delete-process proc)) | 1371 | (set-buffer obuf))) |
| 1386 | (set-buffer obuf)))) | 1372 | )))) |
| 1387 | )))) | ||
| 1388 | 1373 | ||
| 1389 | (defun term-handle-exit (process-name msg) | 1374 | (defun term-handle-exit (process-name msg) |
| 1390 | "Write process exit (or other change) message MSG in the current buffer." | 1375 | "Write process exit (or other change) message MSG in the current buffer." |
| @@ -1397,8 +1382,8 @@ The main purpose is to get rid of the local keymap." | |||
| 1397 | (insert ?\n "Process " process-name " " msg) | 1382 | (insert ?\n "Process " process-name " " msg) |
| 1398 | ;; Force mode line redisplay soon. | 1383 | ;; Force mode line redisplay soon. |
| 1399 | (force-mode-line-update) | 1384 | (force-mode-line-update) |
| 1400 | (if (and opoint (< opoint omax)) | 1385 | (when (and opoint (< opoint omax)) |
| 1401 | (goto-char opoint)))) | 1386 | (goto-char opoint)))) |
| 1402 | 1387 | ||
| 1403 | 1388 | ||
| 1404 | ;;; Name to use for TERM. | 1389 | ;;; Name to use for TERM. |
| @@ -1521,9 +1506,9 @@ See also `term-input-ignoredups' and `term-write-input-ring'." | |||
| 1521 | nil t)) | 1506 | nil t)) |
| 1522 | (let ((history (buffer-substring (match-beginning 1) | 1507 | (let ((history (buffer-substring (match-beginning 1) |
| 1523 | (match-end 1)))) | 1508 | (match-end 1)))) |
| 1524 | (if (or (null term-input-ignoredups) | 1509 | (when (or (null term-input-ignoredups) |
| 1525 | (ring-empty-p ring) | 1510 | (ring-empty-p ring) |
| 1526 | (not (string-equal (ring-ref ring 0) history))) | 1511 | (not (string-equal (ring-ref ring 0) history))) |
| 1527 | (ring-insert-at-beginning ring history))) | 1512 | (ring-insert-at-beginning ring history))) |
| 1528 | (setq count (1+ count)))) | 1513 | (setq count (1+ count)))) |
| 1529 | (kill-buffer history-buf)) | 1514 | (kill-buffer history-buf)) |
| @@ -1651,15 +1636,15 @@ Moves relative to `term-input-ring-index'." | |||
| 1651 | "Return the string matching REGEXP ARG places along the input ring. | 1636 | "Return the string matching REGEXP ARG places along the input ring. |
| 1652 | Moves relative to `term-input-ring-index'." | 1637 | Moves relative to `term-input-ring-index'." |
| 1653 | (let* ((pos (term-previous-matching-input-string-position regexp arg))) | 1638 | (let* ((pos (term-previous-matching-input-string-position regexp arg))) |
| 1654 | (if pos (ring-ref term-input-ring pos)))) | 1639 | (when pos (ring-ref term-input-ring pos)))) |
| 1655 | 1640 | ||
| 1656 | (defun term-previous-matching-input-string-position | 1641 | (defun term-previous-matching-input-string-position |
| 1657 | (regexp arg &optional start) | 1642 | (regexp arg &optional start) |
| 1658 | "Return the index matching REGEXP ARG places along the input ring. | 1643 | "Return the index matching REGEXP ARG places along the input ring. |
| 1659 | Moves relative to START, or `term-input-ring-index'." | 1644 | Moves relative to START, or `term-input-ring-index'." |
| 1660 | (if (or (not (ring-p term-input-ring)) | 1645 | (when (or (not (ring-p term-input-ring)) |
| 1661 | (ring-empty-p term-input-ring)) | 1646 | (ring-empty-p term-input-ring)) |
| 1662 | (error "No history")) | 1647 | (error "No history")) |
| 1663 | (let* ((len (ring-length term-input-ring)) | 1648 | (let* ((len (ring-length term-input-ring)) |
| 1664 | (motion (if (> arg 0) 1 -1)) | 1649 | (motion (if (> arg 0) 1 -1)) |
| 1665 | (n (mod (- (or start (term-search-start arg)) motion) len)) | 1650 | (n (mod (- (or start (term-search-start arg)) motion) len)) |
| @@ -1678,8 +1663,8 @@ Moves relative to START, or `term-input-ring-index'." | |||
| 1678 | tried-each-ring-item (= n prev))) | 1663 | tried-each-ring-item (= n prev))) |
| 1679 | (setq arg (if (> arg 0) (1- arg) (1+ arg)))) | 1664 | (setq arg (if (> arg 0) (1- arg) (1+ arg)))) |
| 1680 | ;; Now that we know which ring element to use, if we found it, return that. | 1665 | ;; Now that we know which ring element to use, if we found it, return that. |
| 1681 | (if (string-match regexp (ring-ref term-input-ring n)) | 1666 | (when (string-match regexp (ring-ref term-input-ring n)) |
| 1682 | n))) | 1667 | n))) |
| 1683 | 1668 | ||
| 1684 | (defun term-previous-matching-input (regexp arg) | 1669 | (defun term-previous-matching-input (regexp arg) |
| 1685 | "Search backwards through input history for match for REGEXP. | 1670 | "Search backwards through input history for match for REGEXP. |
| @@ -1713,14 +1698,14 @@ If N is negative, find the previous or Nth previous match." | |||
| 1713 | With prefix argument N, search for Nth previous match. | 1698 | With prefix argument N, search for Nth previous match. |
| 1714 | If N is negative, search forwards for the -Nth following match." | 1699 | If N is negative, search forwards for the -Nth following match." |
| 1715 | (interactive "p") | 1700 | (interactive "p") |
| 1716 | (if (not (memq last-command '(term-previous-matching-input-from-input | 1701 | (when (not (memq last-command '(term-previous-matching-input-from-input |
| 1717 | term-next-matching-input-from-input))) | 1702 | term-next-matching-input-from-input))) |
| 1718 | ;; Starting a new search | 1703 | ;; Starting a new search |
| 1719 | (setq term-matching-input-from-input-string | 1704 | (setq term-matching-input-from-input-string |
| 1720 | (buffer-substring | 1705 | (buffer-substring |
| 1721 | (process-mark (get-buffer-process (current-buffer))) | 1706 | (process-mark (get-buffer-process (current-buffer))) |
| 1722 | (point)) | 1707 | (point)) |
| 1723 | term-input-ring-index nil)) | 1708 | term-input-ring-index nil)) |
| 1724 | (term-previous-matching-input | 1709 | (term-previous-matching-input |
| 1725 | (concat "^" (regexp-quote term-matching-input-from-input-string)) | 1710 | (concat "^" (regexp-quote term-matching-input-from-input-string)) |
| 1726 | arg)) | 1711 | arg)) |
| @@ -1752,15 +1737,15 @@ See `term-magic-space' and `term-replace-by-expanded-history-before-point'. | |||
| 1752 | 1737 | ||
| 1753 | Returns t if successful." | 1738 | Returns t if successful." |
| 1754 | (interactive) | 1739 | (interactive) |
| 1755 | (if (and term-input-autoexpand | 1740 | (when (and term-input-autoexpand |
| 1756 | (string-match "[!^]" (funcall term-get-old-input)) | 1741 | (string-match "[!^]" (funcall term-get-old-input)) |
| 1757 | (save-excursion (beginning-of-line) | 1742 | (save-excursion (beginning-of-line) |
| 1758 | (looking-at term-prompt-regexp))) | 1743 | (looking-at term-prompt-regexp))) |
| 1759 | ;; Looks like there might be history references in the command. | 1744 | ;; Looks like there might be history references in the command. |
| 1760 | (let ((previous-modified-tick (buffer-modified-tick))) | 1745 | (let ((previous-modified-tick (buffer-modified-tick))) |
| 1761 | (message "Expanding history references...") | 1746 | (message "Expanding history references...") |
| 1762 | (term-replace-by-expanded-history-before-point silent) | 1747 | (term-replace-by-expanded-history-before-point silent) |
| 1763 | (/= previous-modified-tick (buffer-modified-tick))))) | 1748 | (/= previous-modified-tick (buffer-modified-tick))))) |
| 1764 | 1749 | ||
| 1765 | 1750 | ||
| 1766 | (defun term-replace-by-expanded-history-before-point (silent) | 1751 | (defun term-replace-by-expanded-history-before-point (silent) |
| @@ -2026,17 +2011,17 @@ Similarly for Soar, Scheme, etc." | |||
| 2026 | (delete-region pmark (point)) | 2011 | (delete-region pmark (point)) |
| 2027 | (insert input) | 2012 | (insert input) |
| 2028 | copy)))) | 2013 | copy)))) |
| 2029 | (if (term-pager-enabled) | 2014 | (when (term-pager-enabled) |
| 2030 | (save-excursion | 2015 | (save-excursion |
| 2031 | (goto-char (process-mark proc)) | 2016 | (goto-char (process-mark proc)) |
| 2032 | (setq term-pager-count (term-current-row)))) | 2017 | (setq term-pager-count (term-current-row)))) |
| 2033 | (if (and (funcall term-input-filter history) | 2018 | (when (and (funcall term-input-filter history) |
| 2034 | (or (null term-input-ignoredups) | 2019 | (or (null term-input-ignoredups) |
| 2035 | (not (ring-p term-input-ring)) | 2020 | (not (ring-p term-input-ring)) |
| 2036 | (ring-empty-p term-input-ring) | 2021 | (ring-empty-p term-input-ring) |
| 2037 | (not (string-equal (ring-ref term-input-ring 0) | 2022 | (not (string-equal (ring-ref term-input-ring 0) |
| 2038 | history)))) | 2023 | history)))) |
| 2039 | (ring-insert term-input-ring history)) | 2024 | (ring-insert term-input-ring history)) |
| 2040 | (let ((functions term-input-filter-functions)) | 2025 | (let ((functions term-input-filter-functions)) |
| 2041 | (while functions | 2026 | (while functions |
| 2042 | (funcall (car functions) (concat input "\n")) | 2027 | (funcall (car functions) (concat input "\n")) |
| @@ -2047,13 +2032,12 @@ Similarly for Soar, Scheme, etc." | |||
| 2047 | ;; in case we get output amidst sending the input. | 2032 | ;; in case we get output amidst sending the input. |
| 2048 | (set-marker term-last-input-start pmark) | 2033 | (set-marker term-last-input-start pmark) |
| 2049 | (set-marker term-last-input-end (point)) | 2034 | (set-marker term-last-input-end (point)) |
| 2050 | (if input-is-new | 2035 | (when input-is-new |
| 2051 | (progn | 2036 | ;; Set up to delete, because inferior should echo. |
| 2052 | ;; Set up to delete, because inferior should echo. | 2037 | (when (marker-buffer term-pending-delete-marker) |
| 2053 | (if (marker-buffer term-pending-delete-marker) | 2038 | (delete-region term-pending-delete-marker pmark)) |
| 2054 | (delete-region term-pending-delete-marker pmark)) | 2039 | (set-marker term-pending-delete-marker pmark-val) |
| 2055 | (set-marker term-pending-delete-marker pmark-val) | 2040 | (set-marker (process-mark proc) (point))) |
| 2056 | (set-marker (process-mark proc) (point)))) | ||
| 2057 | (goto-char pmark) | 2041 | (goto-char pmark) |
| 2058 | (funcall term-input-sender proc input))))) | 2042 | (funcall term-input-sender proc input))))) |
| 2059 | 2043 | ||
| @@ -2083,9 +2067,9 @@ Calls `term-get-old-input' to get old input." | |||
| 2083 | "Skip past the text matching regexp term-prompt-regexp. | 2067 | "Skip past the text matching regexp term-prompt-regexp. |
| 2084 | If this takes us past the end of the current line, don't skip at all." | 2068 | If this takes us past the end of the current line, don't skip at all." |
| 2085 | (let ((eol (save-excursion (end-of-line) (point)))) | 2069 | (let ((eol (save-excursion (end-of-line) (point)))) |
| 2086 | (if (and (looking-at term-prompt-regexp) | 2070 | (when (and (looking-at term-prompt-regexp) |
| 2087 | (<= (match-end 0) eol)) | 2071 | (<= (match-end 0) eol)) |
| 2088 | (goto-char (match-end 0))))) | 2072 | (goto-char (match-end 0))))) |
| 2089 | 2073 | ||
| 2090 | 2074 | ||
| 2091 | (defun term-after-pmark-p () | 2075 | (defun term-after-pmark-p () |
| @@ -2114,7 +2098,7 @@ The prompt skip is done by skipping text matching the regular expression | |||
| 2114 | term-prompt-regexp, a buffer local variable." | 2098 | term-prompt-regexp, a buffer local variable." |
| 2115 | (interactive "P") | 2099 | (interactive "P") |
| 2116 | (beginning-of-line) | 2100 | (beginning-of-line) |
| 2117 | (if (null arg) (term-skip-prompt))) | 2101 | (when (null arg) (term-skip-prompt))) |
| 2118 | 2102 | ||
| 2119 | ;;; These two functions are for entering text you don't want echoed or | 2103 | ;;; These two functions are for entering text you don't want echoed or |
| 2120 | ;;; saved -- typically passwords to ftp, telnet, or somesuch. | 2104 | ;;; saved -- typically passwords to ftp, telnet, or somesuch. |
| @@ -2175,10 +2159,10 @@ is additionally sent. String is not saved on term input history list. | |||
| 2175 | Security bug: your string can still be temporarily recovered with | 2159 | Security bug: your string can still be temporarily recovered with |
| 2176 | \\[view-lossage]." | 2160 | \\[view-lossage]." |
| 2177 | (interactive "P") ; Defeat snooping via C-x esc | 2161 | (interactive "P") ; Defeat snooping via C-x esc |
| 2178 | (if (not (stringp str)) | 2162 | (when (not (stringp str)) |
| 2179 | (setq str (term-read-noecho "Non-echoed text: " t))) | 2163 | (setq str (term-read-noecho "Non-echoed text: " t))) |
| 2180 | (if (not proc) | 2164 | (when (not proc) |
| 2181 | (setq proc (get-buffer-process (current-buffer)))) | 2165 | (setq proc (get-buffer-process (current-buffer)))) |
| 2182 | (if (not proc) (error "Current buffer has no process") | 2166 | (if (not proc) (error "Current buffer has no process") |
| 2183 | (setq term-kill-echo-list (nconc term-kill-echo-list | 2167 | (setq term-kill-echo-list (nconc term-kill-echo-list |
| 2184 | (cons str nil))) | 2168 | (cons str nil))) |
| @@ -2270,8 +2254,8 @@ Useful if you accidentally suspend the top-level process." | |||
| 2270 | (interactive) | 2254 | (interactive) |
| 2271 | (let* ((pmark (process-mark (get-buffer-process (current-buffer)))) | 2255 | (let* ((pmark (process-mark (get-buffer-process (current-buffer)))) |
| 2272 | (p-pos (marker-position pmark))) | 2256 | (p-pos (marker-position pmark))) |
| 2273 | (if (> (point) p-pos) | 2257 | (when (> (point) p-pos) |
| 2274 | (kill-region pmark (point))))) | 2258 | (kill-region pmark (point))))) |
| 2275 | 2259 | ||
| 2276 | (defun term-delchar-or-maybe-eof (arg) | 2260 | (defun term-delchar-or-maybe-eof (arg) |
| 2277 | "Delete ARG characters forward, or send an EOF to process if at end of | 2261 | "Delete ARG characters forward, or send an EOF to process if at end of |
| @@ -2279,7 +2263,7 @@ buffer." | |||
| 2279 | (interactive "p") | 2263 | (interactive "p") |
| 2280 | (if (eobp) | 2264 | (if (eobp) |
| 2281 | (process-send-eof) | 2265 | (process-send-eof) |
| 2282 | (delete-char arg))) | 2266 | (delete-char arg))) |
| 2283 | 2267 | ||
| 2284 | (defun term-send-eof () | 2268 | (defun term-send-eof () |
| 2285 | "Send an EOF to the current buffer's process." | 2269 | "Send an EOF to the current buffer's process." |
| @@ -2294,8 +2278,8 @@ If N is negative, find the next or Nth next match." | |||
| 2294 | (interactive (term-regexp-arg "Backward input matching (regexp): ")) | 2278 | (interactive (term-regexp-arg "Backward input matching (regexp): ")) |
| 2295 | (let* ((re (concat term-prompt-regexp ".*" regexp)) | 2279 | (let* ((re (concat term-prompt-regexp ".*" regexp)) |
| 2296 | (pos (save-excursion (end-of-line (if (> arg 0) 0 1)) | 2280 | (pos (save-excursion (end-of-line (if (> arg 0) 0 1)) |
| 2297 | (if (re-search-backward re nil t arg) | 2281 | (when (re-search-backward re nil t arg) |
| 2298 | (point))))) | 2282 | (point))))) |
| 2299 | (if (null pos) | 2283 | (if (null pos) |
| 2300 | (progn (message "Not found") | 2284 | (progn (message "Not found") |
| 2301 | (ding)) | 2285 | (ding)) |
| @@ -2407,15 +2391,15 @@ See `term-prompt-regexp'." | |||
| 2407 | 2391 | ||
| 2408 | (defun term-check-source (fname) | 2392 | (defun term-check-source (fname) |
| 2409 | (let ((buff (get-file-buffer fname))) | 2393 | (let ((buff (get-file-buffer fname))) |
| 2410 | (if (and buff | 2394 | (when (and buff |
| 2411 | (buffer-modified-p buff) | 2395 | (buffer-modified-p buff) |
| 2412 | (y-or-n-p (format "Save buffer %s first? " | 2396 | (y-or-n-p (format "Save buffer %s first? " |
| 2413 | (buffer-name buff)))) | 2397 | (buffer-name buff)))) |
| 2414 | ;; save BUFF. | 2398 | ;; save BUFF. |
| 2415 | (let ((old-buffer (current-buffer))) | 2399 | (let ((old-buffer (current-buffer))) |
| 2416 | (set-buffer buff) | 2400 | (set-buffer buff) |
| 2417 | (save-buffer) | 2401 | (save-buffer) |
| 2418 | (set-buffer old-buffer))))) | 2402 | (set-buffer old-buffer))))) |
| 2419 | 2403 | ||
| 2420 | 2404 | ||
| 2421 | ;;; (TERM-GET-SOURCE prompt prev-dir/file source-modes mustmatch-p) | 2405 | ;;; (TERM-GET-SOURCE prompt prev-dir/file source-modes mustmatch-p) |
| @@ -2510,12 +2494,12 @@ See `term-prompt-regexp'." | |||
| 2510 | ;; Try to position the proc window so you can see the answer. | 2494 | ;; Try to position the proc window so you can see the answer. |
| 2511 | ;; This is bogus code. If you delete the (sit-for 0), it breaks. | 2495 | ;; This is bogus code. If you delete the (sit-for 0), it breaks. |
| 2512 | ;; I don't know why. Wizards invited to improve it. | 2496 | ;; I don't know why. Wizards invited to improve it. |
| 2513 | (if (not (pos-visible-in-window-p proc-pt proc-win)) | 2497 | (when (not (pos-visible-in-window-p proc-pt proc-win)) |
| 2514 | (let ((opoint (window-point proc-win))) | 2498 | (let ((opoint (window-point proc-win))) |
| 2515 | (set-window-point proc-win proc-mark) (sit-for 0) | 2499 | (set-window-point proc-win proc-mark) (sit-for 0) |
| 2516 | (if (not (pos-visible-in-window-p opoint proc-win)) | 2500 | (if (not (pos-visible-in-window-p opoint proc-win)) |
| 2517 | (push-mark opoint) | 2501 | (push-mark opoint) |
| 2518 | (set-window-point proc-win opoint))))))) | 2502 | (set-window-point proc-win opoint))))))) |
| 2519 | 2503 | ||
| 2520 | ;;; Returns the current column in the current screen line. | 2504 | ;;; Returns the current column in the current screen line. |
| 2521 | ;;; Note: (current-column) yields column in buffer line. | 2505 | ;;; Note: (current-column) yields column in buffer line. |
| @@ -2703,16 +2687,15 @@ See `term-prompt-regexp'." | |||
| 2703 | ;; Let's handle the messages. -mm | 2687 | ;; Let's handle the messages. -mm |
| 2704 | 2688 | ||
| 2705 | (let* ((newstr (term-handle-ansi-terminal-messages str))) | 2689 | (let* ((newstr (term-handle-ansi-terminal-messages str))) |
| 2706 | (if (not (eq str newstr)) | 2690 | (when (not (eq str newstr)) |
| 2707 | (setq handled-ansi-message t | 2691 | (setq handled-ansi-message t |
| 2708 | str newstr))) | 2692 | str newstr))) |
| 2709 | (setq str-length (length str)) | 2693 | (setq str-length (length str)) |
| 2710 | 2694 | ||
| 2711 | (if (marker-buffer term-pending-delete-marker) | 2695 | (when (marker-buffer term-pending-delete-marker) |
| 2712 | (progn | 2696 | ;; Delete text following term-pending-delete-marker. |
| 2713 | ;; Delete text following term-pending-delete-marker. | 2697 | (delete-region term-pending-delete-marker (process-mark proc)) |
| 2714 | (delete-region term-pending-delete-marker (process-mark proc)) | 2698 | (set-marker term-pending-delete-marker nil)) |
| 2715 | (set-marker term-pending-delete-marker nil))) | ||
| 2716 | 2699 | ||
| 2717 | (if (eq (window-buffer) (current-buffer)) | 2700 | (if (eq (window-buffer) (current-buffer)) |
| 2718 | (progn | 2701 | (progn |
| @@ -2723,20 +2706,20 @@ See `term-prompt-regexp'." | |||
| 2723 | 2706 | ||
| 2724 | (setq save-marker (copy-marker (process-mark proc))) | 2707 | (setq save-marker (copy-marker (process-mark proc))) |
| 2725 | 2708 | ||
| 2726 | (if (/= (point) (process-mark proc)) | 2709 | (when (/= (point) (process-mark proc)) |
| 2727 | (progn (setq save-point (point-marker)) | 2710 | (setq save-point (point-marker)) |
| 2728 | (goto-char (process-mark proc)))) | 2711 | (goto-char (process-mark proc))) |
| 2729 | 2712 | ||
| 2730 | (save-restriction | 2713 | (save-restriction |
| 2731 | ;; If the buffer is in line mode, and there is a partial | 2714 | ;; If the buffer is in line mode, and there is a partial |
| 2732 | ;; input line, save the line (by narrowing to leave it | 2715 | ;; input line, save the line (by narrowing to leave it |
| 2733 | ;; outside the restriction ) until we're done with output. | 2716 | ;; outside the restriction ) until we're done with output. |
| 2734 | (if (and (> (point-max) (process-mark proc)) | 2717 | (when (and (> (point-max) (process-mark proc)) |
| 2735 | (term-in-line-mode)) | 2718 | (term-in-line-mode)) |
| 2736 | (narrow-to-region (point-min) (process-mark proc))) | 2719 | (narrow-to-region (point-min) (process-mark proc))) |
| 2737 | 2720 | ||
| 2738 | (if term-log-buffer | 2721 | (when term-log-buffer |
| 2739 | (princ str term-log-buffer)) | 2722 | (princ str term-log-buffer)) |
| 2740 | (cond ((eq term-terminal-state 4) ;; Have saved pending output. | 2723 | (cond ((eq term-terminal-state 4) ;; Have saved pending output. |
| 2741 | (setq str (concat term-terminal-parameter str)) | 2724 | (setq str (concat term-terminal-parameter str)) |
| 2742 | (setq term-terminal-parameter nil) | 2725 | (setq term-terminal-parameter nil) |
| @@ -2750,7 +2733,7 @@ See `term-prompt-regexp'." | |||
| 2750 | (setq funny | 2733 | (setq funny |
| 2751 | (string-match "[\r\n\000\007\033\t\b\032\016\017]" | 2734 | (string-match "[\r\n\000\007\033\t\b\032\016\017]" |
| 2752 | str i)) | 2735 | str i)) |
| 2753 | (if (not funny) (setq funny str-length)) | 2736 | (when (not funny) (setq funny str-length)) |
| 2754 | (cond ((> funny i) | 2737 | (cond ((> funny i) |
| 2755 | (cond ((eq term-terminal-state 1) | 2738 | (cond ((eq term-terminal-state 1) |
| 2756 | ;; We are in state 1, we need to wrap | 2739 | ;; We are in state 1, we need to wrap |
| @@ -2824,10 +2807,10 @@ See `term-prompt-regexp'." | |||
| 2824 | (setq count (min term-width | 2807 | (setq count (min term-width |
| 2825 | (+ count 8 (- (mod count 8))))) | 2808 | (+ count 8 (- (mod count 8))))) |
| 2826 | (if (> term-width count) | 2809 | (if (> term-width count) |
| 2827 | (progn | 2810 | (progn |
| 2828 | (term-move-columns | 2811 | (term-move-columns |
| 2829 | (- count (term-current-column))) | 2812 | (- count (term-current-column))) |
| 2830 | (setq term-current-column count)) | 2813 | (setq term-current-column count)) |
| 2831 | (when (> term-width (term-current-column)) | 2814 | (when (> term-width (term-current-column)) |
| 2832 | (term-move-columns | 2815 | (term-move-columns |
| 2833 | (1- (- term-width (term-current-column))))) | 2816 | (1- (- term-width (term-current-column))))) |
| @@ -2969,44 +2952,43 @@ See `term-prompt-regexp'." | |||
| 2969 | (setq term-terminal-previous-parameter-2 -1) | 2952 | (setq term-terminal-previous-parameter-2 -1) |
| 2970 | (setq term-terminal-previous-parameter -1) | 2953 | (setq term-terminal-previous-parameter -1) |
| 2971 | (setq term-terminal-state 0))))) | 2954 | (setq term-terminal-state 0))))) |
| 2972 | (if (term-handling-pager) | 2955 | (when (term-handling-pager) |
| 2973 | ;; Finish stuff to get ready to handle PAGER. | 2956 | ;; Finish stuff to get ready to handle PAGER. |
| 2974 | (progn | 2957 | (if (> (% (current-column) term-width) 0) |
| 2975 | (if (> (% (current-column) term-width) 0) | 2958 | (setq term-terminal-parameter |
| 2976 | (setq term-terminal-parameter | 2959 | (substring str i)) |
| 2977 | (substring str i)) | 2960 | ;; We're at column 0. Goto end of buffer; to compensate, |
| 2978 | ;; We're at column 0. Goto end of buffer; to compensate, | 2961 | ;; prepend a ?\r for later. This looks more consistent. |
| 2979 | ;; prepend a ?\r for later. This looks more consistent. | 2962 | (if (zerop i) |
| 2980 | (if (zerop i) | 2963 | (setq term-terminal-parameter |
| 2981 | (setq term-terminal-parameter | 2964 | (concat "\r" (substring str i))) |
| 2982 | (concat "\r" (substring str i))) | 2965 | (setq term-terminal-parameter (substring str (1- i))) |
| 2983 | (setq term-terminal-parameter (substring str (1- i))) | 2966 | (aset term-terminal-parameter 0 ?\r)) |
| 2984 | (aset term-terminal-parameter 0 ?\r)) | 2967 | (goto-char (point-max))) |
| 2985 | (goto-char (point-max))) | 2968 | (setq term-terminal-state 4) |
| 2986 | (setq term-terminal-state 4) | 2969 | (make-local-variable 'term-pager-old-filter) |
| 2987 | (make-local-variable 'term-pager-old-filter) | 2970 | (setq term-pager-old-filter (process-filter proc)) |
| 2988 | (setq term-pager-old-filter (process-filter proc)) | 2971 | (set-process-filter proc term-pager-filter) |
| 2989 | (set-process-filter proc term-pager-filter) | 2972 | (setq i str-length)) |
| 2990 | (setq i str-length))) | ||
| 2991 | (setq i (1+ i)))) | 2973 | (setq i (1+ i)))) |
| 2992 | 2974 | ||
| 2993 | (if (>= (term-current-row) term-height) | 2975 | (when (>= (term-current-row) term-height) |
| 2994 | (term-handle-deferred-scroll)) | 2976 | (term-handle-deferred-scroll)) |
| 2995 | 2977 | ||
| 2996 | (set-marker (process-mark proc) (point)) | 2978 | (set-marker (process-mark proc) (point)) |
| 2997 | (if save-point | 2979 | (when save-point |
| 2998 | (progn (goto-char save-point) | 2980 | (goto-char save-point) |
| 2999 | (set-marker save-point nil))) | 2981 | (set-marker save-point nil)) |
| 3000 | 2982 | ||
| 3001 | ;; Check for a pending filename-and-line number to display. | 2983 | ;; Check for a pending filename-and-line number to display. |
| 3002 | ;; We do this before scrolling, because we might create a new window. | 2984 | ;; We do this before scrolling, because we might create a new window. |
| 3003 | (if (and term-pending-frame | 2985 | (when (and term-pending-frame |
| 3004 | (eq (window-buffer selected) (current-buffer))) | 2986 | (eq (window-buffer selected) (current-buffer))) |
| 3005 | (progn (term-display-line (car term-pending-frame) | 2987 | (term-display-line (car term-pending-frame) |
| 3006 | (cdr term-pending-frame)) | 2988 | (cdr term-pending-frame)) |
| 3007 | (setq term-pending-frame nil) | 2989 | (setq term-pending-frame nil) |
| 3008 | ;; We have created a new window, so check the window size. | 2990 | ;; We have created a new window, so check the window size. |
| 3009 | (term-check-size proc))) | 2991 | (term-check-size proc)) |
| 3010 | 2992 | ||
| 3011 | ;; Scroll each window displaying the buffer but (by default) | 2993 | ;; Scroll each window displaying the buffer but (by default) |
| 3012 | ;; only if the point matches the process-mark we started with. | 2994 | ;; only if the point matches the process-mark we started with. |
| @@ -3018,50 +3000,47 @@ See `term-prompt-regexp'." | |||
| 3018 | (setq last-win win) | 3000 | (setq last-win win) |
| 3019 | (while (progn | 3001 | (while (progn |
| 3020 | (setq win (next-window win nil t)) | 3002 | (setq win (next-window win nil t)) |
| 3021 | (if (eq (window-buffer win) (process-buffer proc)) | 3003 | (when (eq (window-buffer win) (process-buffer proc)) |
| 3022 | (let ((scroll term-scroll-to-bottom-on-output)) | 3004 | (let ((scroll term-scroll-to-bottom-on-output)) |
| 3023 | (select-window win) | 3005 | (select-window win) |
| 3024 | (if (or (= (point) save-marker) | 3006 | (when (or (= (point) save-marker) |
| 3025 | (eq scroll t) (eq scroll 'all) | 3007 | (eq scroll t) (eq scroll 'all) |
| 3026 | ;; Maybe user wants point to jump to the end. | 3008 | ;; Maybe user wants point to jump to the end. |
| 3027 | (and (eq selected win) | 3009 | (and (eq selected win) |
| 3028 | (or (eq scroll 'this) (not save-point))) | 3010 | (or (eq scroll 'this) (not save-point))) |
| 3029 | (and (eq scroll 'others) | 3011 | (and (eq scroll 'others) |
| 3030 | (not (eq selected win)))) | 3012 | (not (eq selected win)))) |
| 3031 | (progn | 3013 | (goto-char term-home-marker) |
| 3032 | (goto-char term-home-marker) | 3014 | (recenter 0) |
| 3033 | (recenter 0) | 3015 | (goto-char (process-mark proc)) |
| 3034 | (goto-char (process-mark proc)) | 3016 | (if (not (pos-visible-in-window-p (point) win)) |
| 3035 | (if (not (pos-visible-in-window-p (point) win)) | 3017 | (recenter -1))) |
| 3036 | (recenter -1)))) | 3018 | ;; Optionally scroll so that the text |
| 3037 | ;; Optionally scroll so that the text | 3019 | ;; ends at the bottom of the window. |
| 3038 | ;; ends at the bottom of the window. | 3020 | (when (and term-scroll-show-maximum-output |
| 3039 | (if (and term-scroll-show-maximum-output | ||
| 3040 | (>= (point) (process-mark proc))) | 3021 | (>= (point) (process-mark proc))) |
| 3041 | (save-excursion | 3022 | (save-excursion |
| 3042 | (goto-char (point-max)) | 3023 | (goto-char (point-max)) |
| 3043 | (recenter -1))))) | 3024 | (recenter -1))))) |
| 3044 | (not (eq win last-win)))) | 3025 | (not (eq win last-win)))) |
| 3045 | 3026 | ||
| 3046 | ;;; Stolen from comint.el and adapted -mm | 3027 | ;;; Stolen from comint.el and adapted -mm |
| 3047 | (if (> term-buffer-maximum-size 0) | 3028 | (when (> term-buffer-maximum-size 0) |
| 3048 | (save-excursion | 3029 | (save-excursion |
| 3049 | (goto-char (process-mark (get-buffer-process (current-buffer)))) | 3030 | (goto-char (process-mark (get-buffer-process (current-buffer)))) |
| 3050 | (forward-line (- term-buffer-maximum-size)) | 3031 | (forward-line (- term-buffer-maximum-size)) |
| 3051 | (beginning-of-line) | 3032 | (beginning-of-line) |
| 3052 | (delete-region (point-min) (point)))) | 3033 | (delete-region (point-min) (point)))) |
| 3053 | ;;; | ||
| 3054 | |||
| 3055 | (set-marker save-marker nil))))) | 3034 | (set-marker save-marker nil))))) |
| 3056 | 3035 | ||
| 3057 | (defun term-handle-deferred-scroll () | 3036 | (defun term-handle-deferred-scroll () |
| 3058 | (let ((count (- (term-current-row) term-height))) | 3037 | (let ((count (- (term-current-row) term-height))) |
| 3059 | (if (>= count 0) | 3038 | (when (>= count 0) |
| 3060 | (save-excursion | 3039 | (save-excursion |
| 3061 | (goto-char term-home-marker) | 3040 | (goto-char term-home-marker) |
| 3062 | (term-vertical-motion (1+ count)) | 3041 | (term-vertical-motion (1+ count)) |
| 3063 | (set-marker term-home-marker (point)) | 3042 | (set-marker term-home-marker (point)) |
| 3064 | (setq term-current-row (1- term-height)))))) | 3043 | (setq term-current-row (1- term-height)))))) |
| 3065 | 3044 | ||
| 3066 | ;;; Reset the terminal, delete all the content and set the face to the | 3045 | ;;; Reset the terminal, delete all the content and set the face to the |
| 3067 | ;;; default one. | 3046 | ;;; default one. |
| @@ -3172,17 +3151,17 @@ See `term-prompt-regexp'." | |||
| 3172 | (list :background | 3151 | (list :background |
| 3173 | (if (= term-ansi-current-color 0) | 3152 | (if (= term-ansi-current-color 0) |
| 3174 | (face-foreground 'default) | 3153 | (face-foreground 'default) |
| 3175 | (elt ansi-term-color-vector term-ansi-current-color)) | 3154 | (elt ansi-term-color-vector term-ansi-current-color)) |
| 3176 | :foreground | 3155 | :foreground |
| 3177 | (if (= term-ansi-current-bg-color 0) | 3156 | (if (= term-ansi-current-bg-color 0) |
| 3178 | (face-background 'default) | 3157 | (face-background 'default) |
| 3179 | (elt ansi-term-color-vector term-ansi-current-bg-color)))) | 3158 | (elt ansi-term-color-vector term-ansi-current-bg-color)))) |
| 3180 | (when term-ansi-current-bold | 3159 | (when term-ansi-current-bold |
| 3181 | (setq term-current-face | 3160 | (setq term-current-face |
| 3182 | (append '(:weight bold) term-current-face))) | 3161 | (append '(:weight bold) term-current-face))) |
| 3183 | (when term-ansi-current-underline | 3162 | (when term-ansi-current-underline |
| 3184 | (setq term-current-face | 3163 | (setq term-current-face |
| 3185 | (append '(:underline t) term-current-face)))) | 3164 | (append '(:underline t) term-current-face)))) |
| 3186 | (if term-ansi-current-invisible | 3165 | (if term-ansi-current-invisible |
| 3187 | (setq term-current-face | 3166 | (setq term-current-face |
| 3188 | (if (= term-ansi-current-bg-color 0) | 3167 | (if (= term-ansi-current-bg-color 0) |
| @@ -3202,12 +3181,12 @@ See `term-prompt-regexp'." | |||
| 3202 | :background | 3181 | :background |
| 3203 | (elt ansi-term-color-vector term-ansi-current-bg-color))) | 3182 | (elt ansi-term-color-vector term-ansi-current-bg-color))) |
| 3204 | (when term-ansi-current-bold | 3183 | (when term-ansi-current-bold |
| 3205 | (setq term-current-face | 3184 | (setq term-current-face |
| 3206 | (append '(:weight bold) term-current-face))) | 3185 | (append '(:weight bold) term-current-face))) |
| 3207 | (when term-ansi-current-underline | 3186 | (when term-ansi-current-underline |
| 3208 | (setq term-current-face | 3187 | (setq term-current-face |
| 3209 | (append '(:underline t) term-current-face)))))) | 3188 | (append '(:underline t) term-current-face)))))) |
| 3210 | 3189 | ||
| 3211 | ;;; (message "Debug %S" term-current-face) | 3190 | ;;; (message "Debug %S" term-current-face) |
| 3212 | (setq term-ansi-face-already-done nil)) | 3191 | (setq term-ansi-face-already-done nil)) |
| 3213 | 3192 | ||
| @@ -3221,14 +3200,14 @@ See `term-prompt-regexp'." | |||
| 3221 | ;; (eq char ?f) ;; xterm seems to handle this sequence too, not | 3200 | ;; (eq char ?f) ;; xterm seems to handle this sequence too, not |
| 3222 | ;; needed for now | 3201 | ;; needed for now |
| 3223 | ) | 3202 | ) |
| 3224 | (if (<= term-terminal-parameter 0) | 3203 | (when (<= term-terminal-parameter 0) |
| 3225 | (setq term-terminal-parameter 1)) | 3204 | (setq term-terminal-parameter 1)) |
| 3226 | (if (<= term-terminal-previous-parameter 0) | 3205 | (when (<= term-terminal-previous-parameter 0) |
| 3227 | (setq term-terminal-previous-parameter 1)) | 3206 | (setq term-terminal-previous-parameter 1)) |
| 3228 | (if (> term-terminal-previous-parameter term-height) | 3207 | (when (> term-terminal-previous-parameter term-height) |
| 3229 | (setq term-terminal-previous-parameter term-height)) | 3208 | (setq term-terminal-previous-parameter term-height)) |
| 3230 | (if (> term-terminal-parameter term-width) | 3209 | (when (> term-terminal-parameter term-width) |
| 3231 | (setq term-terminal-parameter term-width)) | 3210 | (setq term-terminal-parameter term-width)) |
| 3232 | (term-goto | 3211 | (term-goto |
| 3233 | (1- term-terminal-previous-parameter) | 3212 | (1- term-terminal-previous-parameter) |
| 3234 | (1- term-terminal-parameter))) | 3213 | (1- term-terminal-parameter))) |
| @@ -3445,50 +3424,49 @@ The top-most line is line 0." | |||
| 3445 | ; The page is full, so enter "pager" mode, and wait for input. | 3424 | ; The page is full, so enter "pager" mode, and wait for input. |
| 3446 | 3425 | ||
| 3447 | (defun term-process-pager () | 3426 | (defun term-process-pager () |
| 3448 | (if (not term-pager-break-map) | 3427 | (when (not term-pager-break-map) |
| 3449 | (let* ((map (make-keymap)) | 3428 | (let* ((map (make-keymap)) |
| 3450 | (i 0) tmp) | 3429 | (i 0) tmp) |
| 3451 | ; (while (< i 128) | 3430 | ; (while (< i 128) |
| 3452 | ; (define-key map (make-string 1 i) 'term-send-raw) | 3431 | ; (define-key map (make-string 1 i) 'term-send-raw) |
| 3453 | ; (setq i (1+ i))) | 3432 | ; (setq i (1+ i))) |
| 3454 | (define-key map "\e" | 3433 | (define-key map "\e" |
| 3455 | (lookup-key (current-global-map) "\e")) | 3434 | (lookup-key (current-global-map) "\e")) |
| 3456 | (define-key map "\C-x" | 3435 | (define-key map "\C-x" |
| 3457 | (lookup-key (current-global-map) "\C-x")) | 3436 | (lookup-key (current-global-map) "\C-x")) |
| 3458 | (define-key map "\C-u" | 3437 | (define-key map "\C-u" |
| 3459 | (lookup-key (current-global-map) "\C-u")) | 3438 | (lookup-key (current-global-map) "\C-u")) |
| 3460 | (define-key map " " 'term-pager-page) | 3439 | (define-key map " " 'term-pager-page) |
| 3461 | (define-key map "\r" 'term-pager-line) | 3440 | (define-key map "\r" 'term-pager-line) |
| 3462 | (define-key map "?" 'term-pager-help) | 3441 | (define-key map "?" 'term-pager-help) |
| 3463 | (define-key map "h" 'term-pager-help) | 3442 | (define-key map "h" 'term-pager-help) |
| 3464 | (define-key map "b" 'term-pager-back-page) | 3443 | (define-key map "b" 'term-pager-back-page) |
| 3465 | (define-key map "\177" 'term-pager-back-line) | 3444 | (define-key map "\177" 'term-pager-back-line) |
| 3466 | (define-key map "q" 'term-pager-discard) | 3445 | (define-key map "q" 'term-pager-discard) |
| 3467 | (define-key map "D" 'term-pager-disable) | 3446 | (define-key map "D" 'term-pager-disable) |
| 3468 | (define-key map "<" 'term-pager-bob) | 3447 | (define-key map "<" 'term-pager-bob) |
| 3469 | (define-key map ">" 'term-pager-eob) | 3448 | (define-key map ">" 'term-pager-eob) |
| 3470 | 3449 | ||
| 3471 | ;; Add menu bar. | 3450 | ;; Add menu bar. |
| 3472 | (progn | 3451 | (unless (featurep 'xemacs) |
| 3473 | (term-ifnot-xemacs | 3452 | (define-key map [menu-bar terminal] term-terminal-menu) |
| 3474 | (define-key map [menu-bar terminal] term-terminal-menu) | 3453 | (define-key map [menu-bar signals] term-signals-menu) |
| 3475 | (define-key map [menu-bar signals] term-signals-menu) | 3454 | (setq tmp (make-sparse-keymap "More pages?")) |
| 3476 | (setq tmp (make-sparse-keymap "More pages?")) | 3455 | (define-key tmp [help] '("Help" . term-pager-help)) |
| 3477 | (define-key tmp [help] '("Help" . term-pager-help)) | 3456 | (define-key tmp [disable] |
| 3478 | (define-key tmp [disable] | 3457 | '("Disable paging" . term-fake-pager-disable)) |
| 3479 | '("Disable paging" . term-fake-pager-disable)) | 3458 | (define-key tmp [discard] |
| 3480 | (define-key tmp [discard] | 3459 | '("Discard remaining output" . term-pager-discard)) |
| 3481 | '("Discard remaining output" . term-pager-discard)) | 3460 | (define-key tmp [eob] '("Goto to end" . term-pager-eob)) |
| 3482 | (define-key tmp [eob] '("Goto to end" . term-pager-eob)) | 3461 | (define-key tmp [bob] '("Goto to beginning" . term-pager-bob)) |
| 3483 | (define-key tmp [bob] '("Goto to beginning" . term-pager-bob)) | 3462 | (define-key tmp [line] '("1 line forwards" . term-pager-line)) |
| 3484 | (define-key tmp [line] '("1 line forwards" . term-pager-line)) | 3463 | (define-key tmp [bline] '("1 line backwards" . term-pager-back-line)) |
| 3485 | (define-key tmp [bline] '("1 line backwards" . term-pager-back-line)) | 3464 | (define-key tmp [back] '("1 page backwards" . term-pager-back-page)) |
| 3486 | (define-key tmp [back] '("1 page backwards" . term-pager-back-page)) | 3465 | (define-key tmp [page] '("1 page forwards" . term-pager-page)) |
| 3487 | (define-key tmp [page] '("1 page forwards" . term-pager-page)) | 3466 | (define-key map [menu-bar page] (cons "More pages?" tmp)) |
| 3488 | (define-key map [menu-bar page] (cons "More pages?" tmp)) | 3467 | ) |
| 3489 | )) | ||
| 3490 | 3468 | ||
| 3491 | (setq term-pager-break-map map))) | 3469 | (setq term-pager-break-map map))) |
| 3492 | ; (let ((process (get-buffer-process (current-buffer)))) | 3470 | ; (let ((process (get-buffer-process (current-buffer)))) |
| 3493 | ; (stop-process process)) | 3471 | ; (stop-process process)) |
| 3494 | (setq term-pager-old-local-map (current-local-map)) | 3472 | (setq term-pager-old-local-map (current-local-map)) |
| @@ -3506,8 +3484,8 @@ The top-most line is line 0." | |||
| 3506 | (interactive "p") | 3484 | (interactive "p") |
| 3507 | (let* ((moved (vertical-motion (1+ lines))) | 3485 | (let* ((moved (vertical-motion (1+ lines))) |
| 3508 | (deficit (- lines moved))) | 3486 | (deficit (- lines moved))) |
| 3509 | (if (> moved lines) | 3487 | (when (> moved lines) |
| 3510 | (backward-char)) | 3488 | (backward-char)) |
| 3511 | (cond ((<= deficit 0) ;; OK, had enough in the buffer for request. | 3489 | (cond ((<= deficit 0) ;; OK, had enough in the buffer for request. |
| 3512 | (recenter (1- term-height))) | 3490 | (recenter (1- term-height))) |
| 3513 | ((term-pager-continue deficit))))) | 3491 | ((term-pager-continue deficit))))) |
| @@ -3521,8 +3499,8 @@ The top-most line is line 0." | |||
| 3521 | (defun term-pager-bob () | 3499 | (defun term-pager-bob () |
| 3522 | (interactive) | 3500 | (interactive) |
| 3523 | (goto-char (point-min)) | 3501 | (goto-char (point-min)) |
| 3524 | (if (= (vertical-motion term-height) term-height) | 3502 | (when (= (vertical-motion term-height) term-height) |
| 3525 | (backward-char)) | 3503 | (backward-char)) |
| 3526 | (recenter (1- term-height))) | 3504 | (recenter (1- term-height))) |
| 3527 | 3505 | ||
| 3528 | ; pager mode command to go to end of buffer | 3506 | ; pager mode command to go to end of buffer |
| @@ -3573,7 +3551,7 @@ The top-most line is line 0." | |||
| 3573 | (interactive) | 3551 | (interactive) |
| 3574 | (if (term-pager-enabled) (term-pager-disable) (term-pager-enable))) | 3552 | (if (term-pager-enabled) (term-pager-disable) (term-pager-enable))) |
| 3575 | 3553 | ||
| 3576 | (term-ifnot-xemacs | 3554 | (unless (featurep 'xemacs) |
| 3577 | (defalias 'term-fake-pager-enable 'term-pager-toggle) | 3555 | (defalias 'term-fake-pager-enable 'term-pager-toggle) |
| 3578 | (defalias 'term-fake-pager-disable 'term-pager-toggle) | 3556 | (defalias 'term-fake-pager-disable 'term-pager-toggle) |
| 3579 | (put 'term-char-mode 'menu-enable '(term-in-line-mode)) | 3557 | (put 'term-char-mode 'menu-enable '(term-in-line-mode)) |
| @@ -3626,45 +3604,45 @@ all pending output has been dealt with.")) | |||
| 3626 | (let ((scroll-needed | 3604 | (let ((scroll-needed |
| 3627 | (- (+ (term-current-row) down) | 3605 | (- (+ (term-current-row) down) |
| 3628 | (if (< down 0) term-scroll-start term-scroll-end)))) | 3606 | (if (< down 0) term-scroll-start term-scroll-end)))) |
| 3629 | (if (or (and (< down 0) (< scroll-needed 0)) | 3607 | (when (or (and (< down 0) (< scroll-needed 0)) |
| 3630 | (and (> down 0) (> scroll-needed 0))) | 3608 | (and (> down 0) (> scroll-needed 0))) |
| 3631 | (let ((save-point (copy-marker (point))) (save-top)) | 3609 | (let ((save-point (copy-marker (point))) (save-top)) |
| 3632 | (goto-char term-home-marker) | 3610 | (goto-char term-home-marker) |
| 3633 | (cond (term-scroll-with-delete | 3611 | (cond (term-scroll-with-delete |
| 3634 | (if (< down 0) | 3612 | (if (< down 0) |
| 3635 | (progn | 3613 | (progn |
| 3636 | ;; Delete scroll-needed lines at term-scroll-end, | 3614 | ;; Delete scroll-needed lines at term-scroll-end, |
| 3637 | ;; then insert scroll-needed lines. | 3615 | ;; then insert scroll-needed lines. |
| 3638 | (term-vertical-motion (1- term-scroll-end)) | 3616 | (term-vertical-motion (1- term-scroll-end)) |
| 3639 | (end-of-line) | 3617 | (end-of-line) |
| 3640 | (setq save-top (point)) | 3618 | (setq save-top (point)) |
| 3641 | (term-vertical-motion scroll-needed) | 3619 | (term-vertical-motion scroll-needed) |
| 3642 | (end-of-line) | 3620 | (end-of-line) |
| 3643 | (delete-region save-top (point)) | 3621 | (delete-region save-top (point)) |
| 3644 | (goto-char save-point) | 3622 | (goto-char save-point) |
| 3645 | (setq down (- scroll-needed down)) | 3623 | (setq down (- scroll-needed down)) |
| 3646 | (term-vertical-motion down)) | 3624 | (term-vertical-motion down)) |
| 3647 | ;; Delete scroll-needed lines at term-scroll-start. | 3625 | ;; Delete scroll-needed lines at term-scroll-start. |
| 3648 | (term-vertical-motion term-scroll-start) | 3626 | (term-vertical-motion term-scroll-start) |
| 3649 | (setq save-top (point)) | 3627 | (setq save-top (point)) |
| 3650 | (term-vertical-motion scroll-needed) | ||
| 3651 | (delete-region save-top (point)) | ||
| 3652 | (goto-char save-point) | ||
| 3653 | (term-vertical-motion down) | ||
| 3654 | (term-adjust-current-row-cache (- scroll-needed))) | ||
| 3655 | (setq term-current-column nil) | ||
| 3656 | (term-insert-char ?\n (abs scroll-needed))) | ||
| 3657 | ((and (numberp term-pager-count) | ||
| 3658 | (< (setq term-pager-count (- term-pager-count down)) | ||
| 3659 | 0)) | ||
| 3660 | (setq down 0) | ||
| 3661 | (term-process-pager)) | ||
| 3662 | (t | ||
| 3663 | (term-adjust-current-row-cache (- scroll-needed)) | ||
| 3664 | (term-vertical-motion scroll-needed) | 3628 | (term-vertical-motion scroll-needed) |
| 3665 | (set-marker term-home-marker (point)))) | 3629 | (delete-region save-top (point)) |
| 3666 | (goto-char save-point) | 3630 | (goto-char save-point) |
| 3667 | (set-marker save-point nil)))) | 3631 | (term-vertical-motion down) |
| 3632 | (term-adjust-current-row-cache (- scroll-needed))) | ||
| 3633 | (setq term-current-column nil) | ||
| 3634 | (term-insert-char ?\n (abs scroll-needed))) | ||
| 3635 | ((and (numberp term-pager-count) | ||
| 3636 | (< (setq term-pager-count (- term-pager-count down)) | ||
| 3637 | 0)) | ||
| 3638 | (setq down 0) | ||
| 3639 | (term-process-pager)) | ||
| 3640 | (t | ||
| 3641 | (term-adjust-current-row-cache (- scroll-needed)) | ||
| 3642 | (term-vertical-motion scroll-needed) | ||
| 3643 | (set-marker term-home-marker (point)))) | ||
| 3644 | (goto-char save-point) | ||
| 3645 | (set-marker save-point nil)))) | ||
| 3668 | down) | 3646 | down) |
| 3669 | 3647 | ||
| 3670 | (defun term-down (down &optional check-for-scroll) | 3648 | (defun term-down (down &optional check-for-scroll) |
| @@ -3701,34 +3679,34 @@ all pending output has been dealt with.")) | |||
| 3701 | ;; if the line above point wraps around, add a ?\n to undo the wrapping. | 3679 | ;; if the line above point wraps around, add a ?\n to undo the wrapping. |
| 3702 | ;; FIXME: Probably should be called more than it is. | 3680 | ;; FIXME: Probably should be called more than it is. |
| 3703 | (defun term-unwrap-line () | 3681 | (defun term-unwrap-line () |
| 3704 | (if (not (bolp)) (insert-before-markers ?\n))) | 3682 | (when (not (bolp)) (insert-before-markers ?\n))) |
| 3705 | 3683 | ||
| 3706 | (defun term-erase-in-line (kind) | 3684 | (defun term-erase-in-line (kind) |
| 3707 | (if (= kind 1) ;; erase left of point | 3685 | (when (= kind 1) ;; erase left of point |
| 3708 | (let ((cols (term-horizontal-column)) (saved-point (point))) | 3686 | (let ((cols (term-horizontal-column)) (saved-point (point))) |
| 3709 | (term-vertical-motion 0) | 3687 | (term-vertical-motion 0) |
| 3710 | (delete-region (point) saved-point) | 3688 | (delete-region (point) saved-point) |
| 3711 | (term-insert-char ? cols))) | 3689 | (term-insert-char ? cols))) |
| 3712 | (if (not (eq kind 1)) ;; erase right of point | 3690 | (when (not (eq kind 1)) ;; erase right of point |
| 3713 | (let ((saved-point (point)) | 3691 | (let ((saved-point (point)) |
| 3714 | (wrapped (and (zerop (term-horizontal-column)) | 3692 | (wrapped (and (zerop (term-horizontal-column)) |
| 3715 | (not (zerop (term-current-column)))))) | 3693 | (not (zerop (term-current-column)))))) |
| 3716 | (term-vertical-motion 1) | 3694 | (term-vertical-motion 1) |
| 3717 | (delete-region saved-point (point)) | 3695 | (delete-region saved-point (point)) |
| 3718 | ;; wrapped is true if we're at the beginning of screen line, | 3696 | ;; wrapped is true if we're at the beginning of screen line, |
| 3719 | ;; but not a buffer line. If we delete the current screen line | 3697 | ;; but not a buffer line. If we delete the current screen line |
| 3720 | ;; that will make the previous line no longer wrap, and (because | 3698 | ;; that will make the previous line no longer wrap, and (because |
| 3721 | ;; of the way Emacs display works) point will be at the end of | 3699 | ;; of the way Emacs display works) point will be at the end of |
| 3722 | ;; the previous screen line rather then the beginning of the | 3700 | ;; the previous screen line rather then the beginning of the |
| 3723 | ;; current one. To avoid that, we make sure that current line | 3701 | ;; current one. To avoid that, we make sure that current line |
| 3724 | ;; contain a space, to force the previous line to continue to wrap. | 3702 | ;; contain a space, to force the previous line to continue to wrap. |
| 3725 | ;; We could do this always, but it seems preferable to not add the | 3703 | ;; We could do this always, but it seems preferable to not add the |
| 3726 | ;; extra space when wrapped is false. | 3704 | ;; extra space when wrapped is false. |
| 3727 | (if wrapped | 3705 | (when wrapped |
| 3728 | (insert ? )) | 3706 | (insert ? )) |
| 3729 | (insert ?\n) | 3707 | (insert ?\n) |
| 3730 | (put-text-property saved-point (point) 'face 'default) | 3708 | (put-text-property saved-point (point) 'face 'default) |
| 3731 | (goto-char saved-point)))) | 3709 | (goto-char saved-point)))) |
| 3732 | 3710 | ||
| 3733 | (defun term-erase-in-display (kind) | 3711 | (defun term-erase-in-display (kind) |
| 3734 | "Erases (that is blanks out) part of the window. | 3712 | "Erases (that is blanks out) part of the window. |
| @@ -3934,8 +3912,8 @@ inside of a \"[...]\" (see `skip-chars-forward')." | |||
| 3934 | (let ((limit (point)) | 3912 | (let ((limit (point)) |
| 3935 | (word (concat "[" word-chars "]")) | 3913 | (word (concat "[" word-chars "]")) |
| 3936 | (non-word (concat "[^" word-chars "]"))) | 3914 | (non-word (concat "[^" word-chars "]"))) |
| 3937 | (if (re-search-backward non-word nil 'move) | 3915 | (when (re-search-backward non-word nil 'move) |
| 3938 | (forward-char 1)) | 3916 | (forward-char 1)) |
| 3939 | ;; Anchor the search forwards. | 3917 | ;; Anchor the search forwards. |
| 3940 | (if (or (eolp) (looking-at non-word)) | 3918 | (if (or (eolp) (looking-at non-word)) |
| 3941 | nil | 3919 | nil |
| @@ -3976,10 +3954,10 @@ completions listing is dependent on the value of `term-completion-autolist'. | |||
| 3976 | 3954 | ||
| 3977 | Returns t if successful." | 3955 | Returns t if successful." |
| 3978 | (interactive) | 3956 | (interactive) |
| 3979 | (if (term-match-partial-filename) | 3957 | (when (term-match-partial-filename) |
| 3980 | (prog2 (or (eq (selected-window) (minibuffer-window)) | 3958 | (prog2 (or (eq (selected-window) (minibuffer-window)) |
| 3981 | (message "Completing file name...")) | 3959 | (message "Completing file name...")) |
| 3982 | (term-dynamic-complete-as-filename)))) | 3960 | (term-dynamic-complete-as-filename)))) |
| 3983 | 3961 | ||
| 3984 | (defun term-dynamic-complete-as-filename () | 3962 | (defun term-dynamic-complete-as-filename () |
| 3985 | "Dynamically complete at point as a filename. | 3963 | "Dynamically complete at point as a filename. |
| @@ -4003,7 +3981,7 @@ See `term-dynamic-complete-filename'. Returns t if successful." | |||
| 4003 | (message "No completions of %s" filename) | 3981 | (message "No completions of %s" filename) |
| 4004 | (setq success nil)) | 3982 | (setq success nil)) |
| 4005 | ((eq completion t) ; Means already completed "file". | 3983 | ((eq completion t) ; Means already completed "file". |
| 4006 | (if term-completion-addsuffix (insert " ")) | 3984 | (when term-completion-addsuffix (insert " ")) |
| 4007 | (or mini-flag (message "Sole completion"))) | 3985 | (or mini-flag (message "Sole completion"))) |
| 4008 | ((string-equal completion "") ; Means completion on "directory/". | 3986 | ((string-equal completion "") ; Means completion on "directory/". |
| 4009 | (term-dynamic-list-filename-completions)) | 3987 | (term-dynamic-list-filename-completions)) |
| @@ -4068,7 +4046,7 @@ See also `term-dynamic-complete-filename'." | |||
| 4068 | (message "Sole completion") | 4046 | (message "Sole completion") |
| 4069 | (insert (substring completion (length stub))) | 4047 | (insert (substring completion (length stub))) |
| 4070 | (message "Completed")) | 4048 | (message "Completed")) |
| 4071 | (if term-completion-addsuffix (insert " ")) | 4049 | (when term-completion-addsuffix (insert " ")) |
| 4072 | 'sole)) | 4050 | 'sole)) |
| 4073 | (t ; There's no unique completion. | 4051 | (t ; There's no unique completion. |
| 4074 | (let ((completion (try-completion stub candidates))) | 4052 | (let ((completion (try-completion stub candidates))) |