;;; Copyright (C) 1988, 1990, 1992, 1994, 1995 Free Software Foundation, Inc.
-;;; Author: Per Bothner <bothner@cygnus.com>
-;;; Based on comint mode written by: Olin Shivers <shivers@cs.cmu.edu>
-;;; Keyword: processes
+;; Author: Per Bothner <bothner@cygnus.com>
+;; Based on comint mode written by: Olin Shivers <shivers@cs.cmu.edu>
+;; Keywords: processes
;; This file is part of GNU Emacs.
;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
;; Boston, MA 02111-1307, USA.
+;;; Marck 13 2001
+;;; Fixes for CJK support by Yong Lu <lyongu@yahoo.com>.
+
;;; Dir/Hostname tracking and ANSI colorization by
;;; Marco Melgazzi <marco@techie.com>.
;;; To see what I've modified and where it came from search for '-mm'
+;;; Commentary:
+
;;; Speed considerations and a few caveats
;;; --------------------------------------
;;;
;; 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)
(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)))
(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)
(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)
;;; 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
Notice that a setting of 0 means 'don't truncate anything'. This variable
is buffer-local.")
;;;
-
+\f
(term-if-xemacs
(defvar term-terminal-menu
'("Terminal"
[ "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))
(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")))
;; Menu bars:
(term-ifnot-xemacs
- (term-if-emacs19
+ (progn
;; terminal:
(let (newmap)
(define-key term-mode-map [menu-bar signals]
(setq term-signals-menu (cons "Signals" newmap)))
)))
+\f
+;; 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)))))
+
+\f
+(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))
+\f
(defun term-reset-size (height width)
(setq term-height height)
(setq term-width width)
(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)
(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."
;; 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)
(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))
-
+\f
(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
;;;###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.
+
+\\<term-raw-map>Type \\[switch-to-buffer] to switch to another buffer."
(interactive (list (read-from-minibuffer "Run program: "
(or explicit-shell-file-name
(getenv "ESHELL")
;; 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
(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")
(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))
(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"
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."
;;; 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),
(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.
(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,
((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)
((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"
; 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) -
;; 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))
(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)
(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))
\f
(provide 'term)
+;;; arch-tag: eee16bc8-2cd7-4147-9534-a5694752f716
;;; term.el ends here