(require 'ring)
(require 'ehelp)
+
+(defgroup term nil
+ "General command interpreter in a window"
+ :group 'processes
+ :group 'unix)
+
\f
;;; Buffer Local Variables:
;;;============================================================================
(defvar term-pager-old-local-map nil) ;; Saves old keymap while paging.
(defvar term-pager-old-filter) ;; Saved process-filter while paging.
-(defvar explicit-shell-file-name nil
- "*If non-nil, is file name to use for explicitly requested inferior shell.")
+(defcustom explicit-shell-file-name nil
+ "*If non-nil, is file name to use for explicitly requested inferior shell."
+ :type '(choice (const nil) file)
+ :group 'term)
(defvar term-prompt-regexp "^"
"Regexp to recognise prompts in the inferior process.
This is a good thing to set in mode hooks.")
-(defvar term-input-autoexpand nil
+(defcustom term-input-autoexpand nil
"*If non-nil, expand input command history references on completion.
This mirrors the optional behavior of tcsh (its autoexpand and histlit).
into the buffer's input ring. See also `term-magic-space' and
`term-dynamic-complete'.
-This variable is buffer-local.")
+This variable is buffer-local."
+ :type '(choice (const nil) (const t) (const input) (const history))
+ :group 'term)
-(defvar term-input-ignoredups nil
+(defcustom term-input-ignoredups nil
"*If non-nil, don't add input matching the last on the input ring.
This mirrors the optional behavior of bash.
-This variable is buffer-local.")
+This variable is buffer-local."
+ :type 'boolean
+ :group 'term)
-(defvar term-input-ring-file-name nil
+(defcustom term-input-ring-file-name nil
"*If non-nil, name of the file to read/write input history.
See also `term-read-input-ring' and `term-write-input-ring'.
-This variable is buffer-local, and is a good thing to set in mode hooks.")
+This variable is buffer-local, and is a good thing to set in mode hooks."
+ :type 'boolean
+ :group 'term)
-(defvar term-scroll-to-bottom-on-output nil
+(defcustom term-scroll-to-bottom-on-output nil
"*Controls whether interpreter output causes window to scroll.
If nil, then do not scroll. If t or `all', scroll all windows showing buffer.
If `this', scroll only the selected window.
The default is nil.
See variable `term-scroll-show-maximum-output'.
-This variable is buffer-local.")
+This variable is buffer-local."
+ :type 'boolean
+ :group 'term)
-(defvar term-scroll-show-maximum-output nil
+(defcustom term-scroll-show-maximum-output nil
"*Controls how interpreter output causes window to scroll.
If non-nil, then show the maximum output when the window is scrolled.
See variable `term-scroll-to-bottom-on-output'.
-This variable is buffer-local.")
+This variable is buffer-local."
+ :type 'boolean
+ :group 'term)
;; Where gud-display-frame should put the debugging arrow. This is
;; set by the marker-filter, which scans the debugger's output for
the user command term-send-input. term-simple-send just sends
the string plus a newline.")
-(defvar term-eol-on-send t
+(defcustom term-eol-on-send t
"*Non-nil means go to the end of the line before sending input.
-See `term-send-input'.")
+See `term-send-input'."
+ :type 'boolean
+ :group 'term)
-(defvar term-mode-hook '()
+(defcustom term-mode-hook '()
"Called upon entry into term-mode
-This is run before the process is cranked up.")
+This is run before the process is cranked up."
+ :type 'hook
+ :group 'term)
-(defvar term-exec-hook '()
+(defcustom term-exec-hook '()
"Called each time a process is exec'd by term-exec.
This is called after the process is cranked up. It is useful for things that
must be done each time a process is executed in a term-mode buffer (e.g.,
\(process-kill-without-query)). In contrast, the term-mode-hook is only
-executed once when the buffer is created.")
+executed once when the buffer is created."
+ :type 'hook
+ :group 'term)
(defvar term-mode-map nil)
(defvar term-raw-map nil
(put 'term-scroll-show-maximum-output 'permanent-local t)
(put 'term-ptyp 'permanent-local t)
-;; Do FORMS if running under Emacs-19.
+;; Do FORMS if running under Emacs 19 or later.
(defmacro term-if-emacs19 (&rest forms)
- (if (string-match "^19" emacs-version) (cons 'progn 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).
;;; faces -mm
+(defmacro term-ignore-error (&rest body)
+ `(condition-case nil
+ (progn ,@body)
+ (error nil)))
-(defvar term-default-fg-color "azure3")
-(defvar term-default-bg-color "SkyBlue4")
+(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)
-(set-face-foreground 'term-default-fg term-default-fg-color)
-(set-face-background 'term-default-bg term-default-bg-color)
-
-(copy-face 'default 'term-default-fg-inv)
-(copy-face 'default 'term-default-bg-inv)
-(set-face-foreground 'term-default-fg-inv term-default-bg-color)
-(set-face-background 'term-default-bg-inv term-default-fg-color)
-
-(copy-face 'default 'term-invisible)
-(set-face-background 'term-invisible term-default-bg-color)
-(set-face-background 'term-invisible term-default-bg-color)
-
-(copy-face 'default 'term-invisible-inv)
-(set-face-background 'term-invisible-inv term-default-fg-color)
-(set-face-background 'term-invisible-inv term-default-fg-color)
-
-(copy-face 'default 'term-bold)
-(make-face-bold 'term-bold)
-
-(copy-face 'default 'term-underline)
-(set-face-underline-p 'term-underline t)
+ (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)
-(set-face-foreground 'term-black "black")
-(copy-face 'default 'term-red)
-(set-face-foreground 'term-red "red")
-(copy-face 'default 'term-green)
-(set-face-foreground 'term-green "green")
-(copy-face 'default 'term-yellow)
-(set-face-foreground 'term-yellow "yellow")
-(copy-face 'default 'term-blue)
-(set-face-foreground 'term-blue "blue")
-(copy-face 'default 'term-magenta)
-(set-face-foreground 'term-magenta "magenta")
-(copy-face 'default 'term-cyan)
-(set-face-foreground 'term-cyan "cyan")
-(copy-face 'default 'term-white)
-(set-face-foreground 'term-white "white")
+ (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)
-(set-face-background 'term-blackbg "black")
-(copy-face 'default 'term-redbg)
-(set-face-background 'term-redbg "red")
-(copy-face 'default 'term-greenbg)
-(set-face-background 'term-greenbg "green")
-(copy-face 'default 'term-yellowbg)
-(set-face-background 'term-yellowbg "yellow")
-(copy-face 'default 'term-bluebg)
-(set-face-background 'term-bluebg "blue")
-(copy-face 'default 'term-magentabg)
-(set-face-background 'term-magentabg "magenta")
-(copy-face 'default 'term-cyanbg)
-(set-face-background 'term-cyanbg "cyan")
-(copy-face 'default 'term-whitebg)
-(set-face-background 'term-whitebg "white")
-
-(setq ansi-term-fg-faces-vector
+ (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])
-(setq ansi-term-bg-faces-vector
+(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])
-(setq ansi-term-inv-bg-faces-vector
+(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])
-(setq ansi-term-inv-fg-faces-vector
+(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])
[ "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.
(format "LINES=%d" term-height)
(format "COLUMNS=%d" term-width))
process-environment))
- (process-connection-type t))
+ (process-connection-type t)
+ ;; We should suppress conversion of end-of-line format.
+ (inhibit-eol-conversion t)
+ )
(apply 'start-process name buffer
"/bin/sh" "-c"
(format "stty -nl echo rows %d columns %d sane 2>/dev/null;\
(defun term-regexp-arg (prompt)
;; Return list of regexp and prefix arg using PROMPT.
- (let* ((minibuffer-history-sexp-flag nil)
- ;; Don't clobber this.
+ (let* (;; Don't clobber this.
(last-command last-command)
(regexp (read-from-minibuffer prompt nil nil nil
'minibuffer-history-search-history)))
;;; have any bold/underline/fg/bg/reverse combination. -mm
(defun term-handle-colors-array (parameter)
- (cond
+ (cond
;;; Bold
- ((eq parameter 1)
- (setq term-ansi-current-bold 1))
+ ((eq parameter 1)
+ (setq term-ansi-current-bold 1))
;;; Underline
- ((eq parameter 4)
- (setq term-ansi-current-underline 1))
+ ((eq parameter 4)
+ (setq term-ansi-current-underline 1))
;;; Blink (unsupported by Emacs), will be translated to bold.
;;; This may change in the future though.
- ((eq parameter 5)
- (setq term-ansi-current-bold 1))
+ ((eq parameter 5)
+ (setq term-ansi-current-bold 1))
;;; Reverse
- ((eq parameter 7)
- (setq term-ansi-current-reverse 1))
+ ((eq parameter 7)
+ (setq term-ansi-current-reverse 1))
;;; Invisible
- ((eq parameter 8)
- (setq term-ansi-current-invisible 1))
+ ((eq parameter 8)
+ (setq term-ansi-current-invisible 1))
- ((and (>= parameter 30) (<= parameter 37))
- (setq term-ansi-current-color (- parameter 29)))
+ ((and (>= parameter 30) (<= parameter 37))
+ (setq term-ansi-current-color (- parameter 29)))
- ((and (>= parameter 40) (<= parameter 47))
- (setq term-ansi-current-bg-color (- parameter 39)))
+ ((and (>= parameter 40) (<= parameter 47))
+ (setq term-ansi-current-bg-color (- parameter 39)))
;;; 0 (Reset) or unknown (reset anyway)
- (t
- (setq term-current-face
- (list 'term-default-fg 'term-default-bg))
- (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-current-bg-color 0)))
+ (t
+ (setq term-current-face
+ (list 'term-default-fg 'term-default-bg))
+ (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-current-bg-color 0)))
; (message "Debug: U-%d R-%d B-%d I-%d D-%d F-%d B-%d"
; term-ansi-current-underline
; term-ansi-current-bg-color)
- (if (= term-ansi-face-alredy-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
- (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))))))
- (progn
- (if (= term-ansi-current-invisible 1)
- (if (= term-ansi-current-bg-color 0)
- (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
- (progn
- (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)))
- (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-face-alredy-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
+ (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)
+ (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
+ (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)))
+ (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))))))
; (message "Debug %S" term-current-face)
- (setq term-ansi-face-alredy-done 0))
+ (setq term-ansi-face-alredy-done 0))
;;; Handle a character assuming (eq terminal-state 2) -
;;; Modified to allow ansi coloring -mm
;; \E[m - Set/reset standard mode
((eq char ?m)
- (progn
-; (message "Debug: Current param stack 4)%d 3)%d 2)%d 1)%d 0)%d"
-; term-terminal-previous-parameter-4
-; term-terminal-previous-parameter-3
-; term-terminal-previous-parameter-2
-; term-terminal-previous-parameter
-; term-terminal-parameter)
-
- (if (= term-terminal-more-parameters 1)
- (progn (if (>= term-terminal-previous-parameter-4 0)
- (term-handle-colors-array term-terminal-previous-parameter-4))
- (if (>= term-terminal-previous-parameter-3 0)
- (term-handle-colors-array term-terminal-previous-parameter-3))
- (if (>= term-terminal-previous-parameter-2 0)
- (term-handle-colors-array term-terminal-previous-parameter-2))
- (term-handle-colors-array term-terminal-previous-parameter)))
- (term-handle-colors-array term-terminal-parameter)))
-
-
+ (when (= term-terminal-more-parameters 1)
+ (if (>= term-terminal-previous-parameter-4 0)
+ (term-handle-colors-array term-terminal-previous-parameter-4))
+ (if (>= term-terminal-previous-parameter-3 0)
+ (term-handle-colors-array term-terminal-previous-parameter-3))
+ (if (>= term-terminal-previous-parameter-2 0)
+ (term-handle-colors-array term-terminal-previous-parameter-2))
+ (term-handle-colors-array term-terminal-previous-parameter))
+ (term-handle-colors-array term-terminal-parameter))
;; \E[6n - Report cursor position
((eq char ?n)
HCoop / bpt / emacs.git / blobdiff