;;; term.el --- general command interpreter in a window stuff
;; Copyright (C) 1988, 1990, 1992, 1994, 1995, 2001, 2002, 2003,
-;; 2004, 2005, 2006, 2007, 2008, 2009 Free Software Foundation, Inc.
+;; 2004, 2005, 2006, 2007, 2008, 2009, 2010 Free Software Foundation, Inc.
;; Author: Per Bothner <per@bothner.com>
;; Maintainer: Dan Nicolaescu <dann@ics.uci.edu>, Per Bothner <per@bothner.com>
(defconst term-protocol-version "0.96")
(eval-when-compile
- (require 'ange-ftp))
+ (require 'ange-ftp)
+ (require 'cl))
(require 'ring)
(require 'ehelp)
;;; faces -mm
-(defcustom term-default-fg-color (face-foreground term-current-face)
+(defcustom term-default-fg-color
+ ;; FIXME: This depends on the current frame, so depending on when
+ ;; it's loaded, the result may be different.
+ (face-foreground term-current-face)
"Default color for foreground in `term'."
:group 'term
:type 'string)
-(defcustom term-default-bg-color (face-background term-current-face)
+(defcustom term-default-bg-color
+ ;; FIXME: This depends on the current frame, so depending on when
+ ;; it's loaded, the result may be different.
+ (face-background term-current-face)
"Default color for background in `term'."
:group 'term
:type 'string)
(setq i (1+ i)))
dt))
+(defun term-ansi-reset ()
+ (setq term-current-face (nconc
+ (if term-default-bg-color
+ (list :background term-default-bg-color))
+ (if term-default-fg-color
+ (list :foreground term-default-fg-color))))
+ (setq term-ansi-current-underline nil)
+ (setq term-ansi-current-bold nil)
+ (setq term-ansi-current-reverse nil)
+ (setq term-ansi-current-color 0)
+ (setq term-ansi-current-invisible nil)
+ (setq term-ansi-face-already-done t)
+ (setq term-ansi-current-bg-color 0))
+
(defun term-mode ()
"Major mode for interacting with an inferior interpreter.
The interpreter name is same as buffer name, sans the asterisks.
(make-local-variable 'term-pending-delete-marker)
(setq term-pending-delete-marker (make-marker))
(make-local-variable 'term-current-face)
- (setq term-current-face (list :background term-default-bg-color
- :foreground term-default-fg-color))
+ (term-ansi-reset)
(make-local-variable 'term-pending-frame)
(setq term-pending-frame nil)
;; Cua-mode's keybindings interfere with the term keybindings, disable it.
"Send the last character typed through the terminal-emulator
without any interpretation."
(interactive)
- ;; Convert `return' to C-m, etc.
- (when (and (symbolp last-input-event)
- (get last-input-event 'ascii-character))
- (setq last-input-event (get last-input-event 'ascii-character)))
- (term-send-raw-string (make-string 1 last-input-event)))
+ (let ((keys (this-command-keys)))
+ (term-send-raw-string (string (aref keys (1- (length keys)))))))
(defun term-send-raw-meta ()
(interactive)
(term-page (when (term-pager-enabled) " page"))
(serial-item-speed)
(serial-item-config)
- (temp)
(proc (get-buffer-process (current-buffer))))
(when (and (term-check-proc (current-buffer))
(equal (process-type nil) 'serial))
;; If no process, or nuked process, crank up a new one and put buffer in
;; term mode. Otherwise, leave buffer and existing process alone.
(cond ((not (term-check-proc buffer))
- (save-excursion
- (set-buffer buffer)
+ (with-current-buffer buffer
(term-mode)) ; Install local vars, mode, keymap, ...
(term-exec buffer name program startfile switches)))
buffer))
Blasts any old process running in the buffer. Doesn't set the buffer mode.
You can use this to cheaply run a series of processes in the same term
buffer. The hook `term-exec-hook' is run after each exec."
- (save-excursion
- (set-buffer buffer)
- (let ((proc (get-buffer-process buffer))) ; Blast any old process.
+ (with-current-buffer buffer
+ (let ((proc (get-buffer-process buffer))) ; Blast any old process.
(when proc (delete-process proc)))
;; Crank up a new process
(let ((proc (term-exec-1 name buffer command switches)))
(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
- ;;but has bad results if the term does not prompt at all
- ;; (while (= size (buffer-size))
- ;; (sleep-for 1))
- ;;I hope 1 second is enough!
- (sleep-for 1)
- (goto-char (point-max))
- (insert-file-contents startfile)
- (setq startfile (buffer-substring (point) (point-max)))
- (delete-region (point) (point-max))
- (term-send-string proc startfile)))
+ (when startfile
+ ;;This is guaranteed to wait long enough
+ ;;but has bad results if the term does not prompt at all
+ ;; (while (= size (buffer-size))
+ ;; (sleep-for 1))
+ ;;I hope 1 second is enough!
+ (sleep-for 1)
+ (goto-char (point-max))
+ (insert-file-contents startfile)
+ (term-send-string
+ proc (delete-and-extract-region (point) (point-max)))))
(run-hooks 'term-exec-hook)
- buffer)))
+ buffer))
(defun term-sentinel (proc msg)
"Sentinel for term buffers.
(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)))
- ))))
+ (with-current-buffer buffer
+ ;; Write something in the compilation buffer
+ ;; and hack its mode line.
+ ;; 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))))))
(defun term-handle-exit (process-name msg)
"Write process exit (or other change) message MSG in the current buffer."
(count 0)
(ring (make-ring term-input-ring-size)))
(unwind-protect
- (save-excursion
- (set-buffer history-buf)
+ (with-current-buffer history-buf
(widen)
(erase-buffer)
(insert-file-contents file)
(index (ring-length ring)))
;; Write it all out into a buffer first. Much faster, but messier,
;; than writing it one line at a time.
- (save-excursion
- (set-buffer history-buf)
+ (with-current-buffer history-buf
(erase-buffer)
(while (> index 0)
(setq index (1- index))
(y-or-n-p (format "Save buffer %s first? "
(buffer-name buff))))
;; save BUFF.
- (let ((old-buffer (current-buffer)))
- (set-buffer buff)
- (save-buffer)
- (set-buffer old-buffer)))))
+ (with-current-buffer buff
+ (save-buffer)))))
;; (TERM-GET-SOURCE prompt prev-dir/file source-modes mustmatch-p)
(while (string-match "\eAnSiT.+\n" message)
;; Extract the command code and the argument.
(let* ((start (match-beginning 0))
- (end (match-end 0))
(command-code (aref message (+ start 6)))
(argument
(save-match-data
(defun term-reset-terminal ()
"Reset the terminal, delete all the content and set the face to the default one."
(erase-buffer)
+ (term-ansi-reset)
(setq term-current-row 0)
(setq term-current-column 1)
(setq term-scroll-start 0)
(setq term-scroll-end term-height)
(setq term-insert-mode nil)
- (setq term-current-face (list :background term-default-bg-color
- :foreground term-default-fg-color))
- (setq term-ansi-current-underline nil)
- (setq term-ansi-current-bold nil)
- (setq term-ansi-current-reverse nil)
- (setq term-ansi-current-color 0)
- (setq term-ansi-current-invisible nil)
- (setq term-ansi-face-already-done nil)
- (setq term-ansi-current-bg-color 0))
+ ;; FIXME: No idea why this is here, it looks wrong. --Stef
+ (setq term-ansi-face-already-done nil))
;; New function to deal with ansi colorized output, as you can see you can
;; have any bold/underline/fg/bg/reverse combination. -mm
+(defvar term-bold-attribute '(:weight bold)
+ "Attribute to use for the bold terminal attribute.
+Set it to nil to disable bold.")
+
(defun term-handle-colors-array (parameter)
(cond
;; 0 (Reset) or unknown (reset anyway)
(t
- (setq term-current-face (list :background term-default-bg-color
- :foreground term-default-fg-color))
- (setq term-ansi-current-underline nil)
- (setq term-ansi-current-bold nil)
- (setq term-ansi-current-reverse nil)
- (setq term-ansi-current-color 0)
- (setq term-ansi-current-invisible nil)
- (setq term-ansi-face-already-done t)
- (setq term-ansi-current-bg-color 0)))
+ (term-ansi-reset)))
;; (message "Debug: U-%d R-%d B-%d I-%d D-%d F-%d B-%d"
;; term-ansi-current-underline
(unless term-ansi-face-already-done
- (if term-ansi-current-reverse
- (if term-ansi-current-invisible
- (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
- (if (= term-ansi-current-color 0)
- term-default-fg-color
- (elt ansi-term-color-vector term-ansi-current-color))
- :foreground
- (if (= term-ansi-current-bg-color 0)
- term-default-bg-color
- (elt ansi-term-color-vector term-ansi-current-bg-color))))
- (when term-ansi-current-bold
- (setq term-current-face
- (append '(:weight bold) term-current-face)))
- (when term-ansi-current-underline
- (setq term-current-face
- (append '(:underline t) term-current-face))))
- (if term-ansi-current-invisible
- (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 :foreground
- (if (= term-ansi-current-color 0)
- term-default-fg-color
- (elt ansi-term-color-vector term-ansi-current-color))
- :background
- (if (= term-ansi-current-bg-color 0)
- term-default-bg-color
- (elt ansi-term-color-vector term-ansi-current-bg-color))))
- (when term-ansi-current-bold
- (setq term-current-face
- (append '(:weight bold) term-current-face)))
- (when term-ansi-current-underline
- (setq term-current-face
- (append '(:underline t) term-current-face))))))
+ (if term-ansi-current-invisible
+ (let ((color
+ (if term-ansi-current-reverse
+ (if (= term-ansi-current-color 0)
+ term-default-fg-color
+ (elt ansi-term-color-vector term-ansi-current-color))
+ (if (= term-ansi-current-bg-color 0)
+ term-default-bg-color
+ (elt ansi-term-color-vector term-ansi-current-bg-color)))))
+ (setq term-current-face
+ (list :background color
+ :foreground color))
+ ) ;; No need to bother with anything else if it's invisible.
+
+ (setq term-current-face
+ (if term-ansi-current-reverse
+ (if (= term-ansi-current-color 0)
+ (list :background term-default-fg-color
+ :foreground term-default-bg-color)
+ (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-color 0)
+ (list :foreground term-default-fg-color
+ :background term-default-bg-color)
+ (list :foreground
+ (elt ansi-term-color-vector term-ansi-current-color)
+ :background
+ (elt ansi-term-color-vector term-ansi-current-bg-color)))))
+
+ (when term-ansi-current-bold
+ (setq term-current-face
+ (append term-bold-attribute term-current-face)))
+ (when term-ansi-current-underline
+ (setq term-current-face
+ (list* :underline t term-current-face)))))
;; (message "Debug %S" term-current-face)
+ ;; FIXME: shouldn't we set term-ansi-face-already-done to t here? --Stef
(setq term-ansi-face-already-done nil))
(defun term-display-buffer-line (buffer line)
(let* ((window (display-buffer buffer t))
(pos))
- (save-excursion
- (set-buffer buffer)
+ (with-current-buffer buffer
(save-restriction
(widen)
- (goto-line line)
+ (goto-char (point-min))
+ (forward-line (1- line))
(setq pos (point))
(setq overlay-arrow-string "=>")
(or overlay-arrow-position
(defun term-process-pager ()
(when (not term-pager-break-map)
(let* ((map (make-keymap))
- (i 0) tmp)
+ ;; (i 0)
+ tmp)
;; (while (< i 128)
;; (define-key map (make-string 1 i) 'term-send-raw)
;; (setq i (1+ i)))
(message "Output logging off."))
(if (get-buffer name)
nil
- (save-excursion
- (set-buffer (get-buffer-create name))
+ (with-current-buffer (get-buffer-create name)
(fundamental-mode)
(buffer-disable-undo (current-buffer))
(erase-buffer)))
;; term-dynamic-list-filename-completions List completions in help buffer.
;; term-replace-by-expanded-filename Expand and complete filename at point;
;; replace with expanded/completed name.
-;; term-dynamic-simple-complete Complete stub given candidates.
;; These are not installed in the term-mode keymap. But they are
;; available for people who want them. Shell-mode installs them:
(t
(message "Partially completed")
'partial)))))))
+(make-obsolete 'term-dynamic-simple-complete 'completion-in-region "23.2")
(defun term-dynamic-list-filename-completions ()
(display-completion-list (sort completions 'string-lessp)))
(message "Hit space to flush")
(let (key first)
- (if (save-excursion
- (set-buffer (get-buffer "*Completions*"))
+ (if (with-current-buffer (get-buffer "*Completions*")
(setq key (read-key-sequence nil)
first (aref key 0))
(and (consp first)
;; If the user does mouse-choose-completion with the mouse,
;; execute the command, then delete the completion window.
(progn
- (mouse-choose-completion first)
+ (choose-completion first)
(set-window-configuration conf))
(if (eq first ?\s)
(set-window-configuration conf)
;; If no process, or nuked process, crank up a new one and put buffer in
;; term mode. Otherwise, leave buffer and existing process alone.
(cond ((not (term-check-proc buffer))
- (save-excursion
- (set-buffer buffer)
+ (with-current-buffer buffer
(term-mode)) ; Install local vars, mode, keymap, ...
(term-exec buffer name program startfile switches)))
buffer))
:coding 'no-conversion
:noquery t))
(buffer (process-buffer process)))
- (save-excursion
- (set-buffer buffer)
+ (with-current-buffer buffer
(term-mode)
(term-char-mode)
(goto-char (point-max))
(defun serial-update-config-menu ()
(setq serial-mode-line-config-menu (make-sparse-keymap "Configuration"))
(let ((config (process-contact
- (get-buffer-process (current-buffer)) t))
- (y)
- (str))
+ (get-buffer-process (current-buffer)) t)))
(dolist (y '((:flowcontrol hw "Hardware flowcontrol (RTS/CTS)")
(:flowcontrol sw "Software flowcontrol (XON/XOFF)")
(:flowcontrol nil "No flowcontrol")
;; For modes that use term-mode, term-dynamic-complete-functions is the
;; hook to add completion functions to. Functions on this list should return
;; non-nil if completion occurs (i.e., further completion should not occur).
-;; You could use term-dynamic-simple-complete to do the bulk of the
+;; You could use completion-in-region to do the bulk of the
;; completion job.
\f
(provide 'term)