X-Git-Url: https://code.delx.au/gnu-emacs/blobdiff_plain/db7fa396bda9d18bddf9732826f53b52fa2203e9..4cb2afc64f004ba91ff0bd37cf8ca6669b228988:/lisp/term.el diff --git a/lisp/term.el b/lisp/term.el index 262686cf9f..f1bd8d9a4f 100644 --- a/lisp/term.el +++ b/lisp/term.el @@ -2,9 +2,9 @@ ;;; Copyright (C) 1988, 1990, 1992, 1994, 1995 Free Software Foundation, Inc. -;;; Author: Per Bothner -;;; Based on comint mode written by: Olin Shivers -;;; Keyword: processes +;; Author: Per Bothner +;; Based on comint mode written by: Olin Shivers +;; Keywords: processes ;; This file is part of GNU Emacs. @@ -23,11 +23,16 @@ ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, ;; Boston, MA 02111-1307, USA. +;;; Marck 13 2001 +;;; Fixes for CJK support by Yong Lu . + ;;; Dir/Hostname tracking and ANSI colorization by ;;; Marco Melgazzi . ;;; To see what I've modified and where it came from search for '-mm' +;;; Commentary: + ;;; Speed considerations and a few caveats ;;; -------------------------------------- ;;; @@ -387,12 +392,14 @@ ;; term-mode-hook is the term mode hook. Basically for your keybindings. ;; term-load-hook is run after loading in this package. -;; Code: +;;; Code: ;; This is passed to the inferior in the EMACS environment variable, ;; so it is important to increase it if there are protocol-relevant changes. (defconst term-protocol-version "0.95") +(eval-when-compile + (require 'ange-ftp)) (require 'ring) (require 'ehelp) @@ -651,18 +658,12 @@ Buffer local variable.") (put 'term-scroll-show-maximum-output 'permanent-local t) (put 'term-ptyp 'permanent-local t) -;; Do FORMS if running under Emacs 19 or later. -(defmacro term-if-emacs19 (&rest forms) - (if (string-match "^\\(19\\|[2-9][0-9]\\)" emacs-version) - (cons 'progn forms))) -;; True if running under XEmacs (previously Lucid Emacs). -(defmacro term-is-xemacs () '(string-match "Lucid" emacs-version)) ;; Do FORM if running under XEmacs (previously Lucid Emacs). (defmacro term-if-xemacs (&rest forms) - (if (term-is-xemacs) (cons 'progn forms))) + (if (featurep 'xemacs) (cons 'progn forms))) ;; Do FORM if NOT running under XEmacs (previously Lucid Emacs). (defmacro term-ifnot-xemacs (&rest forms) - (if (not (term-is-xemacs)) (cons 'progn forms))) + (if (not (featurep 'xemacs)) (cons 'progn forms))) (defmacro term-in-char-mode () '(eq (current-local-map) term-raw-map)) (defmacro term-in-line-mode () '(not (term-in-char-mode))) @@ -685,7 +686,7 @@ Buffer local variable.") (defvar term-ansi-at-save-anon nil) (defvar term-ansi-current-bold 0) (defvar term-ansi-current-color 0) -(defvar term-ansi-face-alredy-done 0) +(defvar term-ansi-face-already-done 0) (defvar term-ansi-current-bg-color 0) (defvar term-ansi-current-underline 0) (defvar term-ansi-current-highlight 0) @@ -694,11 +695,6 @@ Buffer local variable.") (defvar term-ansi-default-fg 0) (defvar term-ansi-default-bg 0) (defvar term-ansi-current-temp 0) -(defvar term-ansi-fg-faces-vector nil) -(defvar term-ansi-bg-faces-vector nil) -(defvar term-ansi-inv-fg-faces-vector nil) -(defvar term-ansi-inv-bg-faces-vector nil) -(defvar term-ansi-reverse-faces-vector nil) ;;; Four should be enough, if you want more, just add. -mm (defvar term-terminal-more-parameters 0) @@ -709,142 +705,19 @@ Buffer local variable.") ;;; faces -mm -(defmacro term-ignore-error (&rest body) - `(condition-case nil - (progn ,@body) - (error nil))) - -(defvar term-default-fg-color nil) -(defvar term-default-bg-color nil) - -(when (fboundp 'make-face) -;;; --- Simple faces --- - (make-face 'term-default-fg) - (make-face 'term-default-bg) - (make-face 'term-default-fg-inv) - (make-face 'term-default-bg-inv) - (make-face 'term-bold) - (make-face 'term-underline) - (make-face 'term-invisible) - (make-face 'term-invisible-inv) - - (copy-face 'default 'term-default-fg) - (copy-face 'default 'term-default-bg) - (term-ignore-error - (set-face-foreground 'term-default-fg term-default-fg-color)) - (term-ignore-error - (set-face-background 'term-default-bg term-default-bg-color)) - - (copy-face 'default 'term-default-fg-inv) - (copy-face 'default 'term-default-bg-inv) - (term-ignore-error - (set-face-foreground 'term-default-fg-inv term-default-bg-color)) - (term-ignore-error - (set-face-background 'term-default-bg-inv term-default-fg-color)) - - (copy-face 'default 'term-invisible) - (term-ignore-error - (set-face-background 'term-invisible term-default-bg-color)) - - (copy-face 'default 'term-invisible-inv) - (term-ignore-error - (set-face-background 'term-invisible-inv term-default-fg-color)) - - (copy-face 'default 'term-bold) - (copy-face 'default 'term-underline) - - ;; Set the colors of the new faces. - (term-ignore-error - (make-face-bold 'term-bold)) - - (term-ignore-error - (set-face-underline-p 'term-underline t)) - -;;; --- Fg faces --- - (make-face 'term-black) - (make-face 'term-red) - (make-face 'term-green) - (make-face 'term-yellow) - (make-face 'term-blue) - (make-face 'term-magenta) - (make-face 'term-cyan) - (make-face 'term-white) - - (copy-face 'default 'term-black) - (term-ignore-error - (set-face-foreground 'term-black "black")) - (copy-face 'default 'term-red) - (term-ignore-error - (set-face-foreground 'term-red "red")) - (copy-face 'default 'term-green) - (term-ignore-error - (set-face-foreground 'term-green "green")) - (copy-face 'default 'term-yellow) - (term-ignore-error - (set-face-foreground 'term-yellow "yellow")) - (copy-face 'default 'term-blue) - (term-ignore-error - (set-face-foreground 'term-blue "blue")) - (copy-face 'default 'term-magenta) - (term-ignore-error - (set-face-foreground 'term-magenta "magenta")) - (copy-face 'default 'term-cyan) - (term-ignore-error - (set-face-foreground 'term-cyan "cyan")) - (copy-face 'default 'term-white) - (term-ignore-error - (set-face-foreground 'term-white "white")) - -;;; --- Bg faces --- - (make-face 'term-blackbg) - (make-face 'term-redbg) - (make-face 'term-greenbg) - (make-face 'term-yellowbg) - (make-face 'term-bluebg) - (make-face 'term-magentabg) - (make-face 'term-cyanbg) - (make-face 'term-whitebg) - - (copy-face 'default 'term-blackbg) - (term-ignore-error - (set-face-background 'term-blackbg "black")) - (copy-face 'default 'term-redbg) - (term-ignore-error - (set-face-background 'term-redbg "red")) - (copy-face 'default 'term-greenbg) - (term-ignore-error - (set-face-background 'term-greenbg "green")) - (copy-face 'default 'term-yellowbg) - (term-ignore-error - (set-face-background 'term-yellowbg "yellow")) - (copy-face 'default 'term-bluebg) - (term-ignore-error - (set-face-background 'term-bluebg "blue")) - (copy-face 'default 'term-magentabg) - (term-ignore-error - (set-face-background 'term-magentabg "magenta")) - (copy-face 'default 'term-cyanbg) - (term-ignore-error - (set-face-background 'term-cyanbg "cyan")) - (copy-face 'default 'term-whitebg) - (term-ignore-error - (set-face-background 'term-whitebg "white"))) - -(defvar ansi-term-fg-faces-vector - [term-default-fg term-black term-red term-green term-yellow term-blue - term-magenta term-cyan term-white]) - -(defvar ansi-term-bg-faces-vector - [term-default-bg term-blackbg term-redbg term-greenbg term-yellowbg - term-bluebg term-magentabg term-cyanbg term-whitebg]) - -(defvar ansi-term-inv-bg-faces-vector - [term-default-fg-inv term-black term-red term-green term-yellow term-blue - term-magenta term-cyan term-white]) - -(defvar ansi-term-inv-fg-faces-vector - [term-default-bg-inv term-blackbg term-redbg term-greenbg term-yellowbg - term-bluebg term-magentabg term-cyanbg term-whitebg]) +(defcustom term-default-fg-color nil + "Default color for foreground in `term'." + :group 'term + :type 'string) + +(defcustom term-default-bg-color nil + "Default color for background in `term'." + :group 'term + :type 'string) + +(defvar ansi-term-color-vector + [nil "black" "red" "green" "yellow" "blue" + "magenta" "cyan" "white"]) ;;; Inspiration came from comint.el -mm (defvar term-buffer-maximum-size 2048 @@ -853,7 +726,7 @@ Term buffers are truncated from the top to be no greater than this number. Notice that a setting of 0 means 'don't truncate anything'. This variable is buffer-local.") ;;; - + (term-if-xemacs (defvar term-terminal-menu '("Terminal" @@ -862,149 +735,6 @@ is buffer-local.") [ "Enable paging" term-pager-toggle (not term-pager-count)] [ "Disable paging" term-pager-toggle term-pager-count]))) -(put 'term-mode 'mode-class 'special) - -(defun term-mode () - "Major mode for interacting with an inferior interpreter. -Interpreter name is same as buffer name, sans the asterisks. -In line sub-mode, return at end of buffer sends line as input, -while return not at end copies rest of line to end and sends it. -In char sub-mode, each character (except `term-escape-char`) is -set immediately. - -This mode is typically customised to create inferior-lisp-mode, -shell-mode, etc.. This can be done by setting the hooks -term-input-filter-functions, term-input-filter, term-input-sender and -term-get-old-input to appropriate functions, and the variable -term-prompt-regexp to the appropriate regular expression. - -An input history is maintained of size `term-input-ring-size', and -can be accessed with the commands \\[term-next-input], -\\[term-previous-input], and \\[term-dynamic-list-input-ring]. -Input ring history expansion can be achieved with the commands -\\[term-replace-by-expanded-history] or \\[term-magic-space]. -Input ring expansion is controlled by the variable `term-input-autoexpand', -and addition is controlled by the variable `term-input-ignoredups'. - -Input to, and output from, the subprocess can cause the window to scroll to -the end of the buffer. See variables `term-scroll-to-bottom-on-input', -and `term-scroll-to-bottom-on-output'. - -If you accidentally suspend your process, use \\[term-continue-subjob] -to continue it. - -\\{term-mode-map} - -Entry to this mode runs the hooks on term-mode-hook" - (interactive) - ;; Do not remove this. All major modes must do this. - (kill-all-local-variables) - (setq major-mode 'term-mode) - (setq mode-name "Term") - (use-local-map term-mode-map) - (make-local-variable 'term-home-marker) - (setq term-home-marker (copy-marker 0)) - (make-local-variable 'term-saved-home-marker) - (make-local-variable 'term-height) - (make-local-variable 'term-width) - (setq term-width (1- (window-width))) - (setq term-height (1- (window-height))) - (make-local-variable 'term-terminal-parameter) - (make-local-variable 'term-saved-cursor) - (make-local-variable 'term-last-input-start) - (setq term-last-input-start (make-marker)) - (make-local-variable 'term-last-input-end) - (setq term-last-input-end (make-marker)) - (make-local-variable 'term-last-input-match) - (setq term-last-input-match "") - (make-local-variable 'term-prompt-regexp) ; Don't set; default - (make-local-variable 'term-input-ring-size) ; ...to global val. - (make-local-variable 'term-input-ring) - (make-local-variable 'term-input-ring-file-name) - (or (and (boundp 'term-input-ring) term-input-ring) - (setq term-input-ring (make-ring term-input-ring-size))) - (make-local-variable 'term-input-ring-index) - (or (and (boundp 'term-input-ring-index) term-input-ring-index) - (setq term-input-ring-index nil)) - - (make-local-variable 'term-command-hook) - (setq term-command-hook (symbol-function 'term-command-hook)) - -;;; I'm not sure these saves are necessary but, since I -;;; haven't tested the whole thing on a net connected machine with -;;; a properly configured ange-ftp, I've decided to be conservative -;;; and put them in. -mm - - (make-local-variable 'term-ansi-at-host) - (setq term-ansi-at-host (system-name)) - - (make-local-variable 'term-ansi-at-dir) - (setq term-ansi-at-dir default-directory) - - (make-local-variable 'term-ansi-at-message) - (setq term-ansi-at-message nil) - -;;; For user tracking purposes -mm - (make-local-variable 'ange-ftp-default-user) - (make-local-variable 'ange-ftp-default-password) - (make-local-variable 'ange-ftp-generate-anonymous-password) - -;;; You may want to have different scroll-back sizes -mm - (make-local-variable 'term-buffer-maximum-size) - -;;; Of course these have to be buffer-local -mm - (make-local-variable 'term-ansi-current-bold) - (make-local-variable 'term-ansi-current-color) - (make-local-variable 'term-ansi-face-alredy-done) - (make-local-variable 'term-ansi-current-bg-color) - (make-local-variable 'term-ansi-current-underline) - (make-local-variable 'term-ansi-current-highlight) - (make-local-variable 'term-ansi-current-reverse) - (make-local-variable 'term-ansi-current-invisible) - - (make-local-variable 'term-terminal-state) - (make-local-variable 'term-kill-echo-list) - (make-local-variable 'term-start-line-column) - (make-local-variable 'term-current-column) - (make-local-variable 'term-current-row) - (make-local-variable 'term-log-buffer) - (make-local-variable 'term-scroll-start) - (make-local-variable 'term-scroll-end) - (setq term-scroll-end term-height) - (make-local-variable 'term-scroll-with-delete) - (make-local-variable 'term-pager-count) - (make-local-variable 'term-pager-old-local-map) - (make-local-variable 'term-old-mode-map) - (make-local-variable 'term-insert-mode) - (make-local-variable 'term-dynamic-complete-functions) - (make-local-variable 'term-completion-fignore) - (make-local-variable 'term-get-old-input) - (make-local-variable 'term-matching-input-from-input-string) - (make-local-variable 'term-input-autoexpand) - (make-local-variable 'term-input-ignoredups) - (make-local-variable 'term-delimiter-argument-list) - (make-local-variable 'term-input-filter-functions) - (make-local-variable 'term-input-filter) - (make-local-variable 'term-input-sender) - (make-local-variable 'term-eol-on-send) - (make-local-variable 'term-scroll-to-bottom-on-output) - (make-local-variable 'term-scroll-show-maximum-output) - (make-local-variable 'term-ptyp) - (make-local-variable 'term-exec-hook) - (make-local-variable 'term-vertical-motion) - (make-local-variable 'term-pending-delete-marker) - (setq term-pending-delete-marker (make-marker)) - (make-local-variable 'term-current-face) - (make-local-variable 'term-pending-frame) - (setq term-pending-frame nil) - (run-hooks 'term-mode-hook) - (term-if-xemacs - (set-buffer-menubar - (append current-menubar (list term-terminal-menu)))) - (or term-input-ring - (setq term-input-ring (make-ring term-input-ring-size))) - (term-update-mode-line)) - (if term-mode-map nil (setq term-mode-map (make-sparse-keymap)) @@ -1037,7 +767,6 @@ Entry to this mode runs the hooks on term-mode-hook" (define-key term-mode-map "\C-c\C-j" 'term-line-mode) (define-key term-mode-map "\C-c\C-q" 'term-pager-toggle) - ; ;; completion: ; (define-key term-mode-map [menu-bar completion] ; (cons "Complete" (make-sparse-keymap "Complete"))) @@ -1056,7 +785,7 @@ Entry to this mode runs the hooks on term-mode-hook" ;; Menu bars: (term-ifnot-xemacs - (term-if-emacs19 + (progn ;; terminal: (let (newmap) @@ -1135,7 +864,228 @@ Entry to this mode runs the hooks on term-mode-hook" (define-key term-mode-map [menu-bar signals] (setq term-signals-menu (cons "Signals" newmap))) ))) + +;; Set up term-raw-map, etc. + +(defun term-set-escape-char (c) + "Change term-escape-char and keymaps that depend on it." + (if term-escape-char + (define-key term-raw-map term-escape-char 'term-send-raw)) + (setq c (make-string 1 c)) + (define-key term-raw-map c term-raw-escape-map) + ;; Define standard bindings in term-raw-escape-map + (define-key term-raw-escape-map "\C-v" + (lookup-key (current-global-map) "\C-v")) + (define-key term-raw-escape-map "\C-u" + (lookup-key (current-global-map) "\C-u")) + (define-key term-raw-escape-map c 'term-send-raw) + (define-key term-raw-escape-map "\C-q" 'term-pager-toggle) + ;; The keybinding for term-char-mode is needed by the menubar code. + (define-key term-raw-escape-map "\C-k" 'term-char-mode) + (define-key term-raw-escape-map "\C-j" 'term-line-mode) + ;; It's convenient to have execute-extended-command here. + (define-key term-raw-escape-map [?\M-x] 'execute-extended-command)) + +(let* ((map (make-keymap)) + (esc-map (make-keymap)) + (i 0)) + (while (< i 128) + (define-key map (make-string 1 i) 'term-send-raw) + (define-key esc-map (make-string 1 i) 'term-send-raw-meta) + (setq i (1+ i))) + (dolist (elm (generic-character-list)) + (define-key map (vector elm) 'term-send-raw)) + (define-key map "\e" esc-map) + (setq term-raw-map map) + (setq term-raw-escape-map + (copy-keymap (lookup-key (current-global-map) "\C-x"))) + +;;; Added nearly all the 'grey keys' -mm + + (progn + (term-if-xemacs + (define-key term-raw-map [button2] 'term-mouse-paste)) + (term-ifnot-xemacs + (define-key term-raw-map [mouse-2] 'term-mouse-paste) + (define-key term-raw-map [menu-bar terminal] term-terminal-menu) + (define-key term-raw-map [menu-bar signals] term-signals-menu)) + (define-key term-raw-map [up] 'term-send-up) + (define-key term-raw-map [down] 'term-send-down) + (define-key term-raw-map [right] 'term-send-right) + (define-key term-raw-map [left] 'term-send-left) + (define-key term-raw-map [delete] 'term-send-del) + (define-key term-raw-map [backspace] 'term-send-backspace) + (define-key term-raw-map [home] 'term-send-home) + (define-key term-raw-map [end] 'term-send-end) + (define-key term-raw-map [prior] 'term-send-prior) + (define-key term-raw-map [next] 'term-send-next))) + +(term-set-escape-char ?\C-c) + +(defun term-window-width () + (if (featurep 'xemacs) + (1- (window-width)) + (if window-system + (window-width) + (1- (window-width))))) + + +(put 'term-mode 'mode-class 'special) + +(defun term-mode () + "Major mode for interacting with an inferior interpreter. +The interpreter name is same as buffer name, sans the asterisks. + +There are two submodes: line mode and char mode. By default, you are +in char mode. In char sub-mode, each character (except +`term-escape-char') is set immediately. + +In line mode, you send a line of input at a time; use +\\[term-send-input] to send. + +In line mode, this maintains an input history of size +`term-input-ring-size', and you can access it with the commands +\\[term-next-input], \\[term-previous-input], and +\\[term-dynamic-list-input-ring]. Input ring history expansion can be +achieved with the commands \\[term-replace-by-expanded-history] or +\\[term-magic-space]. Input ring expansion is controlled by the +variable `term-input-autoexpand', and addition is controlled by the +variable `term-input-ignoredups'. + +Input to, and output from, the subprocess can cause the window to scroll to +the end of the buffer. See variables `term-scroll-to-bottom-on-input', +and `term-scroll-to-bottom-on-output'. +If you accidentally suspend your process, use \\[term-continue-subjob] +to continue it. + +This mode can be customised to create specific modes for running +particular subprocesses. This can be done by setting the hooks +`term-input-filter-functions', `term-input-filter', +`term-input-sender' and `term-get-old-input' to appropriate functions, +and the variable `term-prompt-regexp' to the appropriate regular +expression. + +Commands in raw mode: + +\\{term-raw-map} + +Commands in line mode: + +\\{term-mode-map} + +Entry to this mode runs the hooks on `term-mode-hook'." + (interactive) + ;; Do not remove this. All major modes must do this. + (kill-all-local-variables) + (setq major-mode 'term-mode) + (setq mode-name "Term") + (use-local-map term-mode-map) + (make-local-variable 'term-home-marker) + (setq term-home-marker (copy-marker 0)) + (make-local-variable 'term-saved-home-marker) + (make-local-variable 'term-height) + (make-local-variable 'term-width) + (setq term-width (term-window-width)) + (setq term-height (1- (window-height))) + (term-ifnot-xemacs + (set (make-local-variable 'overflow-newline-into-fringe) nil)) + (make-local-variable 'term-terminal-parameter) + (make-local-variable 'term-saved-cursor) + (make-local-variable 'term-last-input-start) + (setq term-last-input-start (make-marker)) + (make-local-variable 'term-last-input-end) + (setq term-last-input-end (make-marker)) + (make-local-variable 'term-last-input-match) + (setq term-last-input-match "") + (make-local-variable 'term-prompt-regexp) ; Don't set; default + (make-local-variable 'term-input-ring-size) ; ...to global val. + (make-local-variable 'term-input-ring) + (make-local-variable 'term-input-ring-file-name) + (or (and (boundp 'term-input-ring) term-input-ring) + (setq term-input-ring (make-ring term-input-ring-size))) + (make-local-variable 'term-input-ring-index) + (or (and (boundp 'term-input-ring-index) term-input-ring-index) + (setq term-input-ring-index nil)) + + (make-local-variable 'term-command-hook) + (setq term-command-hook (symbol-function 'term-command-hook)) + +;;; I'm not sure these saves are necessary but, since I +;;; haven't tested the whole thing on a net connected machine with +;;; a properly configured ange-ftp, I've decided to be conservative +;;; and put them in. -mm + + (make-local-variable 'term-ansi-at-host) + (setq term-ansi-at-host (system-name)) + + (make-local-variable 'term-ansi-at-dir) + (setq term-ansi-at-dir default-directory) + + (make-local-variable 'term-ansi-at-message) + (setq term-ansi-at-message nil) + +;;; For user tracking purposes -mm + (make-local-variable 'ange-ftp-default-user) + (make-local-variable 'ange-ftp-default-password) + (make-local-variable 'ange-ftp-generate-anonymous-password) + +;;; You may want to have different scroll-back sizes -mm + (make-local-variable 'term-buffer-maximum-size) + +;;; Of course these have to be buffer-local -mm + (make-local-variable 'term-ansi-current-bold) + (make-local-variable 'term-ansi-current-color) + (make-local-variable 'term-ansi-face-already-done) + (make-local-variable 'term-ansi-current-bg-color) + (make-local-variable 'term-ansi-current-underline) + (make-local-variable 'term-ansi-current-highlight) + (make-local-variable 'term-ansi-current-reverse) + (make-local-variable 'term-ansi-current-invisible) + + (make-local-variable 'term-terminal-state) + (make-local-variable 'term-kill-echo-list) + (make-local-variable 'term-start-line-column) + (make-local-variable 'term-current-column) + (make-local-variable 'term-current-row) + (make-local-variable 'term-log-buffer) + (make-local-variable 'term-scroll-start) + (make-local-variable 'term-scroll-end) + (setq term-scroll-end term-height) + (make-local-variable 'term-scroll-with-delete) + (make-local-variable 'term-pager-count) + (make-local-variable 'term-pager-old-local-map) + (make-local-variable 'term-old-mode-map) + (make-local-variable 'term-insert-mode) + (make-local-variable 'term-dynamic-complete-functions) + (make-local-variable 'term-completion-fignore) + (make-local-variable 'term-get-old-input) + (make-local-variable 'term-matching-input-from-input-string) + (make-local-variable 'term-input-autoexpand) + (make-local-variable 'term-input-ignoredups) + (make-local-variable 'term-delimiter-argument-list) + (make-local-variable 'term-input-filter-functions) + (make-local-variable 'term-input-filter) + (make-local-variable 'term-input-sender) + (make-local-variable 'term-eol-on-send) + (make-local-variable 'term-scroll-to-bottom-on-output) + (make-local-variable 'term-scroll-show-maximum-output) + (make-local-variable 'term-ptyp) + (make-local-variable 'term-exec-hook) + (make-local-variable 'term-vertical-motion) + (make-local-variable 'term-pending-delete-marker) + (setq term-pending-delete-marker (make-marker)) + (make-local-variable 'term-current-face) + (make-local-variable 'term-pending-frame) + (setq term-pending-frame nil) + (run-hooks 'term-mode-hook) + (term-if-xemacs + (set-buffer-menubar + (append current-menubar (list term-terminal-menu)))) + (or term-input-ring + (setq term-input-ring (make-ring term-input-ring-size))) + (term-update-mode-line)) + (defun term-reset-size (height width) (setq term-height height) (setq term-width width) @@ -1174,9 +1124,9 @@ Entry to this mode runs the hooks on term-mode-hook" (defun term-check-size (process) (if (or (/= term-height (1- (window-height))) - (/= term-width (1- (window-width)))) + (/= term-width (term-window-width))) (progn - (term-reset-size (1- (window-height)) (1- (window-width))) + (term-reset-size (1- (window-height)) (term-window-width)) (set-process-window-size process term-height term-width)))) (defun term-send-raw-string (chars) @@ -1202,20 +1152,22 @@ without any interpretation." (defun term-send-raw-meta () (interactive) - (if (symbolp last-input-char) + (let ((char last-input-char)) + (when (symbolp last-input-char) ;; Convert `return' to C-m, etc. - (let ((tmp (get last-input-char 'event-symbol-elements))) - (if tmp - (setq last-input-char (car tmp))) - (if (symbolp last-input-char) - (progn - (setq tmp (get last-input-char 'ascii-character)) - (if tmp (setq last-input-char tmp)))))) - (term-send-raw-string (if (and (numberp last-input-char) - (> last-input-char 127) - (< last-input-char 256)) - (make-string 1 last-input-char) - (format "\e%c" last-input-char)))) + (let ((tmp (get char 'event-symbol-elements))) + (when tmp + (setq char (car tmp))) + (when (symbolp char) + (setq tmp (get char 'ascii-character)) + (when tmp + (setq char tmp))))) + (setq char (event-basic-type char)) + (term-send-raw-string (if (and (numberp char) + (> char 127) + (< char 256)) + (make-string 1 char) + (format "\e%c" char))))) (defun term-mouse-paste (click arg) "Insert the last stretch of killed text at the position clicked on." @@ -1228,6 +1180,7 @@ without any interpretation." ;; Give temporary modes such as isearch a chance to turn off. (run-hooks 'mouse-leave-buffer-hook) (setq this-command 'yank) + (mouse-set-point click) (term-send-raw-string (current-kill (cond ((listp arg) 0) ((eq arg '-) -1) @@ -1246,66 +1199,12 @@ without any interpretation." (defun term-send-next () (interactive) (term-send-raw-string "\e[6~")) (defun term-send-del () (interactive) (term-send-raw-string "\C-?")) (defun term-send-backspace () (interactive) (term-send-raw-string "\C-H")) - -(defun term-set-escape-char (c) - "Change term-escape-char and keymaps that depend on it." - (if term-escape-char - (define-key term-raw-map term-escape-char 'term-send-raw)) - (setq c (make-string 1 c)) - (define-key term-raw-map c term-raw-escape-map) - ;; Define standard bindings in term-raw-escape-map - (define-key term-raw-escape-map "\C-x" - (lookup-key (current-global-map) "\C-x")) - (define-key term-raw-escape-map "\C-v" - (lookup-key (current-global-map) "\C-v")) - (define-key term-raw-escape-map "\C-u" - (lookup-key (current-global-map) "\C-u")) - (define-key term-raw-escape-map c 'term-send-raw) - (define-key term-raw-escape-map "\C-q" 'term-pager-toggle) - ;; The keybinding for term-char-mode is needed by the menubar code. - (define-key term-raw-escape-map "\C-k" 'term-char-mode) - (define-key term-raw-escape-map "\C-j" 'term-line-mode)) - + (defun term-char-mode () "Switch to char (\"raw\") sub-mode of term mode. Each character you type is sent directly to the inferior without intervention from Emacs, except for the escape character (usually C-c)." (interactive) - (if (not term-raw-map) - (let* ((map (make-keymap)) - (esc-map (make-keymap)) - (i 0)) - (while (< i 128) - (define-key map (make-string 1 i) 'term-send-raw) - (define-key esc-map (make-string 1 i) 'term-send-raw-meta) - (setq i (1+ i))) - (define-key map "\e" esc-map) - (setq term-raw-map map) - (setq term-raw-escape-map - (copy-keymap (lookup-key (current-global-map) "\C-x"))) - -;;; Added nearly all the 'grey keys' -mm - - (term-if-emacs19 - (term-if-xemacs - (define-key term-raw-map [button2] 'term-mouse-paste)) - (term-ifnot-xemacs - (define-key term-raw-map [mouse-2] 'term-mouse-paste) - (define-key term-raw-map [menu-bar terminal] term-terminal-menu) - (define-key term-raw-map [menu-bar signals] term-signals-menu)) - (define-key term-raw-map [up] 'term-send-up) - (define-key term-raw-map [down] 'term-send-down) - (define-key term-raw-map [right] 'term-send-right) - (define-key term-raw-map [left] 'term-send-left) - (define-key term-raw-map [delete] 'term-send-del) - (define-key term-raw-map [backspace] 'term-send-backspace) - (define-key term-raw-map [home] 'term-send-home) - (define-key term-raw-map [end] 'term-send-end) - (define-key term-raw-map [prior] 'term-send-prior) - (define-key term-raw-map [next] 'term-send-next)) - - - (term-set-escape-char ?\C-c))) ;; FIXME: Emit message? Cfr ilisp-raw-message (if (term-in-line-mode) (progn @@ -1368,7 +1267,11 @@ the process. Any more args are arguments to PROGRAM." ;;;###autoload (defun term (program) - "Start a terminal-emulator in a new buffer." + "Start a terminal-emulator in a new buffer. +The buffer is in Term mode; see `term-mode' for the +commands to use in that buffer. + +\\Type \\[switch-to-buffer] to switch to another buffer." (interactive (list (read-from-minibuffer "Run program: " (or explicit-shell-file-name (getenv "ESHELL") @@ -1391,11 +1294,12 @@ buffer. The hook term-exec-hook is run after each exec." ;; Crank up a new process (let ((proc (term-exec-1 name buffer command switches))) (make-local-variable 'term-ptyp) - (setq term-ptyp process-connection-type) ; T if pty, NIL if pipe. + (setq term-ptyp process-connection-type) ; t if pty, nil if pipe. ;; Jump to the end, and set the process mark. (goto-char (point-max)) (set-marker (process-mark proc) (point)) (set-process-filter proc 'term-emulate-terminal) + (set-process-sentinel proc 'term-sentinel) ;; Feed it the startfile. (cond (startfile ;;This is guaranteed to wait long enough @@ -1412,6 +1316,49 @@ buffer. The hook term-exec-hook is run after each exec." (run-hooks 'term-exec-hook) buffer))) +(defun term-sentinel (proc msg) + "Sentinel for term buffers. +The main purpose is to get rid of the local keymap." + (let ((buffer (process-buffer proc))) + (if (memq (process-status proc) '(signal exit)) + (progn + (if (null (buffer-name buffer)) + ;; buffer killed + (set-process-buffer proc nil) + (let ((obuf (current-buffer))) + ;; save-excursion isn't the right thing if + ;; process-buffer is current-buffer + (unwind-protect + (progn + ;; Write something in the compilation buffer + ;; and hack its mode line. + (set-buffer buffer) + ;; Get rid of local keymap. + (use-local-map nil) + (term-handle-exit (process-name proc) + msg) + ;; Since the buffer and mode line will show that the + ;; process is dead, we can delete it now. Otherwise it + ;; will stay around until M-x list-processes. + (delete-process proc)) + (set-buffer obuf)))) + )))) + +(defun term-handle-exit (process-name msg) + "Write process exit (or other change) message MSG in the current buffer." + (let ((buffer-read-only nil) + (omax (point-max)) + (opoint (point))) + ;; Record where we put the message, so we can ignore it + ;; later on. + (goto-char omax) + (insert ?\n "Process " process-name " " msg) + ;; Force mode line redisplay soon. + (force-mode-line-update) + (if (and opoint (< opoint omax)) + (goto-char opoint)))) + + ;;; Name to use for TERM. ;;; Using "emacs" loses, because bash disables editing if TERM == emacs. (defvar term-term-name "eterm") @@ -1445,6 +1392,7 @@ buffer. The hook term-exec-hook is run after each exec." (format "TERMINFO=%s" data-directory) (format term-termcap-format "TERMCAP=" term-term-name term-height term-width)) + ;; Breaks `./configure' of w3 and url which try to run $EMACS. (format "EMACS=%s (term:%s)" emacs-version term-protocol-version) (format "LINES=%d" term-height) (format "COLUMNS=%d" term-width)) @@ -1452,6 +1400,8 @@ buffer. The hook term-exec-hook is run after each exec." (process-connection-type t) ;; We should suppress conversion of end-of-line format. (inhibit-eol-conversion t) + ;; inhibit-eol-conversion doesn't seem to do the job, but this does. + (coding-system-for-read 'unknown-unix) ) (apply 'start-process name buffer "/bin/sh" "-c" @@ -2005,13 +1955,13 @@ If the interpreter is the csh, initial string matching regexp term-prompt-regexp. term-input-filter-functions monitors input for \"cd\", \"pushd\", and \"popd\" commands. When it sees one, it cd's the buffer. - term-input-filter is the default: returns T if the input isn't all white + term-input-filter is the default: returns t if the input isn't all white space. If the term is Lucid Common Lisp, term-get-old-input snarfs the sexp ending at point. term-input-filter-functions does nothing. - term-input-filter returns NIL if the input matches input-filter-regexp, + term-input-filter returns nil if the input matches input-filter-regexp, which matches (1) all whitespace (2) :a, :c, etc. Similarly for Soar, Scheme, etc." @@ -2389,7 +2339,7 @@ See `term-prompt-regexp'." ;;; your cursor over a string that's a filename and have it taken as default. ;;; ;;; If the command is given in a file buffer whose major mode is in -;;; SOURCE-MODES, then the the filename is the default file, and the +;;; SOURCE-MODES, then the filename is the default file, and the ;;; file's directory is the default directory. ;;; ;;; If the buffer isn't a source file buffer (e.g., it's the process buffer), @@ -2599,10 +2549,10 @@ See `term-prompt-regexp'." (cond (term-current-column) ((setq term-current-column (current-column))))) -;;; Move DELTA column right (or left if delta < 0). +;;; Move DELTA column right (or left if delta < 0 limiting at column 0). (defun term-move-columns (delta) - (setq term-current-column (+ (term-current-column) delta)) + (setq term-current-column (max 0 (+ (term-current-column) delta))) (move-to-column term-current-column t)) ;; Insert COUNT copies of CHAR in the default face. @@ -2779,19 +2729,21 @@ See `term-prompt-regexp'." (setq term-current-column nil) (setq term-start-line-column nil))) (setq old-point (point)) - ;; In the common case that we're at the end of - ;; the buffer, we can save a little work. - (cond ((/= (point) (point-max)) - (if term-insert-mode - ;; Inserting spaces, then deleting them, - ;; then inserting the actual text is - ;; inefficient, but it is simple, and - ;; the actual overhead is miniscule. - (term-insert-spaces count)) - (term-move-columns count) - (delete-region old-point (point))) - (t (setq term-current-column (+ (term-current-column) count)))) - (insert (substring str i funny)) + + ;; Insert a string, check how many columns + ;; we moved, then delete that many columns + ;; following point if not eob nor insert-mode. + (let ((old-column (current-column)) + columns pos) + (insert (substring str i funny)) + (setq term-current-column (current-column) + columns (- term-current-column old-column)) + (when (not (or (eobp) term-insert-mode)) + (setq pos (point)) + (term-move-columns columns) + (delete-region pos (point)))) + (setq term-current-column nil) + (put-text-property old-point (point) 'face term-current-face) ;; If the last char was written in last column, @@ -2839,11 +2791,11 @@ See `term-prompt-regexp'." ((eq char ?\^G) (beep t)) ; Bell ((eq char ?\032) - (let ((end (string-match "\n" str i))) + (let ((end (string-match "\r?$" str i))) (if end - (progn (funcall term-command-hook - (substring str (1+ i) (1- end))) - (setq i end)) + (funcall term-command-hook + (prog1 (substring str (1+ i) end) + (setq i (match-end 0)))) (setq term-terminal-parameter (substring str i)) (setq term-terminal-state 4) @@ -3040,22 +2992,31 @@ See `term-prompt-regexp'." ((eq parameter 8) (setq term-ansi-current-invisible 1)) +;;; Foreground ((and (>= parameter 30) (<= parameter 37)) (setq term-ansi-current-color (- parameter 29))) +;;; Reset foreground + ((eq parameter 39) + (setq term-ansi-current-color 0)) + +;;; Background ((and (>= parameter 40) (<= parameter 47)) (setq term-ansi-current-bg-color (- parameter 39))) +;;; Reset background + ((eq parameter 49) + (setq term-ansi-current-bg-color 0)) + ;;; 0 (Reset) or unknown (reset anyway) (t - (setq term-current-face - (list 'term-default-fg 'term-default-bg)) + (setq term-current-face nil) (setq term-ansi-current-underline 0) (setq term-ansi-current-bold 0) (setq term-ansi-current-reverse 0) (setq term-ansi-current-color 0) (setq term-ansi-current-invisible 0) - (setq term-ansi-face-alredy-done 1) + (setq term-ansi-face-already-done 1) (setq term-ansi-current-bg-color 0))) ; (message "Debug: U-%d R-%d B-%d I-%d D-%d F-%d B-%d" @@ -3063,53 +3024,65 @@ See `term-prompt-regexp'." ; term-ansi-current-reverse ; term-ansi-current-bold ; term-ansi-current-invisible -; term-ansi-face-alredy-done +; term-ansi-face-already-done ; term-ansi-current-color ; term-ansi-current-bg-color) - (if (= term-ansi-face-alredy-done 0) + (if (= term-ansi-face-already-done 0) (if (= term-ansi-current-reverse 1) - (progn - (if (= term-ansi-current-invisible 1) - (if (= term-ansi-current-color 0) - (setq term-current-face - '(term-default-bg-inv term-default-fg)) - (setq term-current-face - (list (elt ansi-term-inv-fg-faces-vector term-ansi-current-color) - (elt ansi-term-inv-bg-faces-vector term-ansi-current-color)))) - ;; No need to bother with anything else if it's invisible - (progn + (if (= term-ansi-current-invisible 1) + (setq term-current-face + (if (= term-ansi-current-color 0) + (list :background + term-default-fg-color + :foreground + term-default-fg-color) + (list :background + (elt ansi-term-color-vector term-ansi-current-color) + :foreground + (elt ansi-term-color-vector term-ansi-current-color))) + ;; No need to bother with anything else if it's invisible + ) + (setq term-current-face + (list :background + (elt ansi-term-color-vector term-ansi-current-color) + :foreground + (elt ansi-term-color-vector term-ansi-current-bg-color))) + (if (= term-ansi-current-bold 1) (setq term-current-face - (list (elt ansi-term-inv-fg-faces-vector term-ansi-current-color) - (elt ansi-term-inv-bg-faces-vector term-ansi-current-bg-color))) - (if (= term-ansi-current-bold 1) - (setq term-current-face - (append '(term-bold) term-current-face))) - (if (= term-ansi-current-underline 1) - (setq term-current-face - (append '(term-underline) term-current-face)))))) - (if (= term-ansi-current-invisible 1) - (if (= term-ansi-current-bg-color 0) + (append '(:weight bold) term-current-face))) + (if (= term-ansi-current-underline 1) (setq term-current-face - '(term-default-fg-inv term-default-bg)) - (setq term-current-face - (list (elt ansi-term-fg-faces-vector term-ansi-current-bg-color) - (elt ansi-term-bg-faces-vector term-ansi-current-bg-color)))) - ;; No need to bother with anything else if it's invisible + (append '(:underline t) term-current-face)))) + (if (= term-ansi-current-invisible 1) + (setq term-current-face + (if (= term-ansi-current-bg-color 0) + (list :background + term-default-bg-color + :foreground + term-default-bg-color) + (list :foreground + (elt ansi-term-color-vector term-ansi-current-bg-color) + :background + (elt ansi-term-color-vector term-ansi-current-bg-color))) + ;; No need to bother with anything else if it's invisible + ) (setq term-current-face - (list (elt ansi-term-fg-faces-vector term-ansi-current-color) - (elt ansi-term-bg-faces-vector term-ansi-current-bg-color))) + (list :foreground + (elt ansi-term-color-vector term-ansi-current-color) + :background + (elt ansi-term-color-vector term-ansi-current-bg-color))) (if (= term-ansi-current-bold 1) (setq term-current-face - (append '(term-bold) term-current-face))) + (append '(:weight bold) term-current-face))) (if (= term-ansi-current-underline 1) (setq term-current-face - (append '(term-underline) term-current-face)))))) + (append '(:underline t) term-current-face)))))) ; (message "Debug %S" term-current-face) - (setq term-ansi-face-alredy-done 0)) + (setq term-ansi-face-already-done 0)) ;;; Handle a character assuming (eq terminal-state 2) - @@ -3248,7 +3221,9 @@ The top-most line is line 0." ;; Default value for the symbol term-command-hook. (defun term-command-hook (string) - (cond ((= (aref string 0) ?\032) + (cond ((equal string "") + t) + ((= (aref string 0) ?\032) ;; gdb (when invoked with -fullname) prints: ;; \032\032FULLFILENAME:LINENUMBER:CHARPOS:BEG_OR_MIDDLE:PC\n (let* ((first-colon (string-match ":" string 1)) @@ -3342,7 +3317,7 @@ The top-most line is line 0." (define-key map ">" 'term-pager-eob) ;; Add menu bar. - (term-if-emacs19 + (progn (term-ifnot-xemacs (define-key map [menu-bar terminal] term-terminal-menu) (define-key map [menu-bar signals] term-signals-menu) @@ -3819,7 +3794,7 @@ See `term-dynamic-complete-filename'. Returns t if successful." (t (car term-completion-addsuffix)))) (filesuffix (cond ((not term-completion-addsuffix) "") ((not (consp term-completion-addsuffix)) " ") - (t (cdr term-completion-addsuffix)))) + (t (cdr term-completion-addsuffix)))) (filename (or (term-match-partial-filename) "")) (pathdir (file-name-directory filename)) (pathnondir (file-name-nondirectory filename)) @@ -4100,4 +4075,5 @@ the process. Any more args are arguments to PROGRAM." (provide 'term) +;;; arch-tag: eee16bc8-2cd7-4147-9534-a5694752f716 ;;; term.el ends here