;;; term.el --- general command interpreter in a window stuff
-;; Copyright (C) 1988, 1990, 1992, 1994, 1995, 2002, 2003,
-;; 2004, 2005, 2006 Free Software Foundation, Inc.
+;; Copyright (C) 1988, 1990, 1992, 1994, 1995, 2001, 2002, 2003,
+;; 2004, 2005, 2006, 2007, 2008 Free Software Foundation, Inc.
;; Author: Per Bothner <per@bothner.com>
;; Maintainer: Dan Nicolaescu <dann@ics.uci.edu>, Per Bothner <per@bothner.com>
;; This file is part of GNU Emacs.
-;; GNU Emacs is free software; you can redistribute it and/or modify
+;; GNU Emacs is free software: you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
-;; the Free Software Foundation; either version 2, or (at your option)
-;; any later version.
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
;; GNU Emacs is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; GNU General Public License for more details.
;; You should have received a copy of the GNU General Public License
-;; along with GNU Emacs; see the file COPYING. If not, write to the
-;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
-;; Boston, MA 02110-1301, USA.
+;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
;;; Marck 13 2001
;;; Fixes for CJK support by Yong Lu <lyongu@yahoo.com>.
(defgroup term nil
"General command interpreter in a window."
- :group 'processes
- :group 'unix)
+ :group 'processes)
\f
;;; Buffer Local Variables:
(defvar term-scroll-with-delete nil) ;; term-scroll-with-delete is t if
;; forward scrolling should be implemented by delete to
;; top-most line(s); and nil if scrolling should be implemented
-;; by moving term-home-marker. It is set to t iff there is a
+;; by moving term-home-marker. It is set to t if there is a
;; (non-default) scroll-region OR the alternate buffer is used.
(defvar term-pending-delete-marker) ;; New user input in line mode needs to
;; be deleted, because it gets echoed by the inferior.
:type 'hook
:group 'term)
-(defvar term-mode-map nil)
+(defvar term-mode-map
+ (let ((map (make-sparse-keymap)))
+ (define-key map "\ep" 'term-previous-input)
+ (define-key map "\en" 'term-next-input)
+ (define-key map "\er" 'term-previous-matching-input)
+ (define-key map "\es" 'term-next-matching-input)
+ (unless (featurep 'xemacs)
+ (define-key map [?\A-\M-r]
+ 'term-previous-matching-input-from-input)
+ (define-key map [?\A-\M-s] 'term-next-matching-input-from-input))
+ (define-key map "\e\C-l" 'term-show-output)
+ (define-key map "\C-m" 'term-send-input)
+ (define-key map "\C-d" 'term-delchar-or-maybe-eof)
+ (define-key map "\C-c\C-a" 'term-bol)
+ (define-key map "\C-c\C-u" 'term-kill-input)
+ (define-key map "\C-c\C-w" 'backward-kill-word)
+ (define-key map "\C-c\C-c" 'term-interrupt-subjob)
+ (define-key map "\C-c\C-z" 'term-stop-subjob)
+ (define-key map "\C-c\C-\\" 'term-quit-subjob)
+ (define-key map "\C-c\C-m" 'term-copy-old-input)
+ (define-key map "\C-c\C-o" 'term-kill-output)
+ (define-key map "\C-c\C-r" 'term-show-output)
+ (define-key map "\C-c\C-e" 'term-show-maximum-output)
+ (define-key map "\C-c\C-l" 'term-dynamic-list-input-ring)
+ (define-key map "\C-c\C-n" 'term-next-prompt)
+ (define-key map "\C-c\C-p" 'term-previous-prompt)
+ (define-key map "\C-c\C-d" 'term-send-eof)
+ (define-key map "\C-c\C-k" 'term-char-mode)
+ (define-key map "\C-c\C-j" 'term-line-mode)
+ (define-key map "\C-c\C-q" 'term-pager-toggle)
+
+ ;; ;; completion:
+ ;; (define-key map [menu-bar completion]
+ ;; (cons "Complete" (make-sparse-keymap "Complete")))
+ ;; (define-key map [menu-bar completion complete-expand]
+ ;; '("Expand File Name" . term-replace-by-expanded-filename))
+ ;; (define-key map [menu-bar completion complete-listing]
+ ;; '("File Completion Listing" . term-dynamic-list-filename-completions))
+ ;; (define-key map [menu-bar completion complete-file]
+ ;; '("Complete File Name" . term-dynamic-complete-filename))
+ ;; (define-key map [menu-bar completion complete]
+ ;; '("Complete Before Point" . term-dynamic-complete))
+ ;; ;; Put them in the menu bar:
+ ;; (setq menu-bar-final-items (append '(terminal completion inout signals)
+ ;; menu-bar-final-items))
+ map))
+
(defvar term-raw-map nil
"Keyboard map for sending characters directly to the inferior process.")
(defvar term-escape-char nil
"Escape character for char sub-mode of term mode.
-Do not change it directly; use `term-set-escape-char' instead.")
+Do not change it directly; use `term-set-escape-char' instead.")
(defvar term-raw-escape-map nil)
(defvar term-pager-break-map nil)
(put 'term-scroll-show-maximum-output 'permanent-local t)
(put 'term-ptyp 'permanent-local t)
-;; Do FORM if running under XEmacs (previously Lucid Emacs).
-(defmacro term-if-xemacs (&rest 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 (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)))
;; True if currently doing PAGER handling.
;;; faces -mm
-(defcustom term-default-fg-color 'unspecified
+(defcustom term-default-fg-color (face-foreground term-current-face)
"Default color for foreground in `term'."
:group 'term
:type 'string)
-(defcustom term-default-bg-color 'unspecified
+(defcustom term-default-bg-color (face-background term-current-face)
"Default color for background in `term'."
:group 'term
:type 'string)
(defvar term-buffer-maximum-size 2048
"*The maximum size in lines for term buffers.
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
+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"
- [ "Character mode" term-char-mode (term-in-line-mode)]
- [ "Line mode" term-line-mode (term-in-char-mode)]
- [ "Enable paging" term-pager-toggle (not term-pager-count)]
- [ "Disable paging" term-pager-toggle term-pager-count])))
-
-(unless term-mode-map
- (setq term-mode-map (make-sparse-keymap))
- (define-key term-mode-map "\ep" 'term-previous-input)
- (define-key term-mode-map "\en" 'term-next-input)
- (define-key term-mode-map "\er" 'term-previous-matching-input)
- (define-key term-mode-map "\es" 'term-next-matching-input)
- (term-ifnot-xemacs
- (define-key term-mode-map [?\A-\M-r]
- 'term-previous-matching-input-from-input)
- (define-key term-mode-map [?\A-\M-s] 'term-next-matching-input-from-input))
- (define-key term-mode-map "\e\C-l" 'term-show-output)
- (define-key term-mode-map "\C-m" 'term-send-input)
- (define-key term-mode-map "\C-d" 'term-delchar-or-maybe-eof)
- (define-key term-mode-map "\C-c\C-a" 'term-bol)
- (define-key term-mode-map "\C-c\C-u" 'term-kill-input)
- (define-key term-mode-map "\C-c\C-w" 'backward-kill-word)
- (define-key term-mode-map "\C-c\C-c" 'term-interrupt-subjob)
- (define-key term-mode-map "\C-c\C-z" 'term-stop-subjob)
- (define-key term-mode-map "\C-c\C-\\" 'term-quit-subjob)
- (define-key term-mode-map "\C-c\C-m" 'term-copy-old-input)
- (define-key term-mode-map "\C-c\C-o" 'term-kill-output)
- (define-key term-mode-map "\C-c\C-r" 'term-show-output)
- (define-key term-mode-map "\C-c\C-e" 'term-show-maximum-output)
- (define-key term-mode-map "\C-c\C-l" 'term-dynamic-list-input-ring)
- (define-key term-mode-map "\C-c\C-n" 'term-next-prompt)
- (define-key term-mode-map "\C-c\C-p" 'term-previous-prompt)
- (define-key term-mode-map "\C-c\C-d" 'term-send-eof)
- (define-key term-mode-map "\C-c\C-k" 'term-char-mode)
- (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")))
-; (define-key term-mode-map [menu-bar completion complete-expand]
-; '("Expand File Name" . term-replace-by-expanded-filename))
-; (define-key term-mode-map [menu-bar completion complete-listing]
-; '("File Completion Listing" . term-dynamic-list-filename-completions))
-; (define-key term-mode-map [menu-bar completion complete-file]
-; '("Complete File Name" . term-dynamic-complete-filename))
-; (define-key term-mode-map [menu-bar completion complete]
-; '("Complete Before Point" . term-dynamic-complete))
-; ;; Put them in the menu bar:
-; (setq menu-bar-final-items (append '(terminal completion inout signals)
-; menu-bar-final-items))
- )
+(when (featurep 'xemacs)
+ (defvar term-terminal-menu
+ '("Terminal"
+ [ "Character mode" term-char-mode (term-in-line-mode)]
+ [ "Line mode" term-line-mode (term-in-char-mode)]
+ [ "Enable paging" term-pager-toggle (not term-pager-count)]
+ [ "Disable paging" term-pager-toggle term-pager-count])))
;; Menu bars:
-(term-ifnot-xemacs
- (progn
-
+(unless (featurep 'xemacs)
;; terminal:
(let (newmap)
(setq newmap (make-sparse-keymap "Terminal"))
(define-key newmap [terminal-pager-enable]
- '("Enable paging" . term-fake-pager-enable))
+ '(menu-item "Enable paging" term-fake-pager-enable
+ :help "Enable paging feature"))
(define-key newmap [terminal-pager-disable]
- '("Disable paging" . term-fake-pager-disable))
+ '(menu-item "Disable paging" term-fake-pager-disable
+ :help "Disable paging feature"))
(define-key newmap [terminal-char-mode]
- '("Character mode" . term-char-mode))
+ '(menu-item "Character mode" term-char-mode
+ :help "Switch to char (raw) sub-mode of term mode"))
(define-key newmap [terminal-line-mode]
- '("Line mode" . term-line-mode))
+ '(menu-item "Line mode" term-line-mode
+ :help "Switch to line (cooked) sub-mode of term mode"))
(setq term-terminal-menu (cons "Terminal" newmap))
;; completion: (line mode only)
;; Signals
(setq newmap (make-sparse-keymap "Signals"))
- (define-key newmap [eof] '("EOF" . term-send-eof))
- (define-key newmap [kill] '("KILL" . term-kill-subjob))
- (define-key newmap [quit] '("QUIT" . term-quit-subjob))
- (define-key newmap [cont] '("CONT" . term-continue-subjob))
- (define-key newmap [stop] '("STOP" . term-stop-subjob))
- (define-key newmap [] '("BREAK" . term-interrupt-subjob))
(define-key term-mode-map [menu-bar signals]
(setq term-signals-menu (cons "Signals" newmap)))
- )))
+ (define-key newmap [eof]
+ '(menu-item "EOF" term-send-eof
+ :help "Send an EOF to the current buffer's process"))
+ (define-key newmap [kill]
+ '(menu-item "KILL" term-kill-subjob
+ :help "Send kill signal to the current subjob"))
+ (define-key newmap [quit]
+ '(menu-item "QUIT" term-quit-subjob
+ :help "Send quit signal to the current subjob."))
+ (define-key newmap [cont]
+ '(menu-item "CONT" term-continue-subjob
+ :help "Send CONT signal to process buffer's process group"))
+ (define-key newmap [stop]
+ '(menu-item "STOP" term-stop-subjob
+ :help "Stop the current subjob"))
+ (define-key newmap [brk]
+ '(menu-item "BREAK" term-interrupt-subjob
+ :help "Interrupt the current subjob"))
+ ))
\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))
+ "Change `term-escape-char' and keymaps that depend on it."
+ (when 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
;;; 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 [deletechar] '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 [insert] 'term-send-insert)
- (define-key term-raw-map [S-prior] 'scroll-down)
- (define-key term-raw-map [S-next] 'scroll-up)
- (define-key term-raw-map [S-insert] 'term-paste)
- (define-key term-raw-map [prior] 'term-send-prior)
- (define-key term-raw-map [next] 'term-send-next)))
+ (if (featurep 'xemacs)
+ (define-key term-raw-map [button2] 'term-mouse-paste)
+ (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 [deletechar] '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 [insert] 'term-send-insert)
+ (define-key term-raw-map [S-prior] 'scroll-down)
+ (define-key term-raw-map [S-next] 'scroll-up)
+ (define-key term-raw-map [S-insert] 'term-paste)
+ (define-key term-raw-map [prior] 'term-send-prior)
+ (define-key term-raw-map [next] 'term-send-next))
(term-set-escape-char ?\C-c)
+(defvar overflow-newline-into-fringe)
+
(defun term-window-width ()
(if (featurep 'xemacs)
(1- (window-width))
(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))
(make-local-variable 'term-pending-frame)
(setq term-pending-frame nil)
- ;; Cua-mode's keybindings interfere with the term keybindings, disable it.
+ ;; Cua-mode's keybindings interfere with the term keybindings, disable it.
(set (make-local-variable 'cua-mode) nil)
(run-mode-hooks 'term-mode-hook)
- (term-if-xemacs
- (set-buffer-menubar
- (append current-menubar (list term-terminal-menu))))
+ (when (featurep '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))
(setq term-start-line-column nil)
(setq cur nil found t))
(setq cur (cdr cur))))))
- (if (not found)
- (goto-char save-point)))
+ (when (not found)
+ (goto-char save-point)))
found))
(defun term-check-size (process)
- (if (or (/= term-height (1- (window-height)))
- (/= term-width (term-window-width)))
- (progn
- (term-reset-size (1- (window-height)) (term-window-width))
- (set-process-window-size process term-height term-width))))
+ (when (or (/= term-height (1- (window-height)))
+ (/= term-width (term-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)
(let ((proc (get-buffer-process (current-buffer))))
;; Note that (term-current-row) must be called *after*
;; (point) has been updated to (process-mark proc).
(goto-char (process-mark proc))
- (if (term-pager-enabled)
- (setq term-pager-count (term-current-row)))
+ (when (term-pager-enabled)
+ (setq term-pager-count (term-current-row)))
(process-send-string proc chars))))
(defun term-send-raw ()
without any interpretation."
(interactive)
;; Convert `return' to C-m, etc.
- (if (and (symbolp last-input-char)
- (get last-input-char 'ascii-character))
- (setq last-input-char (get last-input-char 'ascii-character)))
+ (when (and (symbolp last-input-char)
+ (get last-input-char 'ascii-character))
+ (setq last-input-char (get last-input-char 'ascii-character)))
(term-send-raw-string (make-string 1 last-input-char)))
(defun term-send-raw-meta ()
(defun term-mouse-paste (click arg)
"Insert the last stretch of killed text at the position clicked on."
(interactive "e\nP")
- (term-if-xemacs
- (term-send-raw-string (or (condition-case () (x-get-selection) (error ()))
- (x-get-cutbuffer)
- (error "No selection or cut buffer available"))))
- (term-ifnot-xemacs
- ;; 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)
- (t (1- arg)))))))
+ (if (featurep 'xemacs)
+ (term-send-raw-string
+ (or (condition-case () (x-get-selection) (error ()))
+ (x-get-cutbuffer)
+ (error "No selection or cut buffer available")))
+ ;; 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)
+ (t (1- arg)))))))
(defun term-paste ()
"Insert the last stretch of killed text at point."
intervention from Emacs, except for the escape character (usually C-c)."
(interactive)
;; FIXME: Emit message? Cfr ilisp-raw-message
- (if (term-in-line-mode)
- (progn
- (setq term-old-mode-map (current-local-map))
- (use-local-map term-raw-map)
-
- ;; Send existing partial line to inferior (without newline).
- (let ((pmark (process-mark (get-buffer-process (current-buffer))))
- (save-input-sender term-input-sender))
- (if (> (point) pmark)
- (unwind-protect
- (progn
- (setq term-input-sender
- (symbol-function 'term-send-string))
- (end-of-line)
- (term-send-input))
- (setq term-input-sender save-input-sender))))
- (term-update-mode-line))))
+ (when (term-in-line-mode)
+ (setq term-old-mode-map (current-local-map))
+ (use-local-map term-raw-map)
+
+ ;; Send existing partial line to inferior (without newline).
+ (let ((pmark (process-mark (get-buffer-process (current-buffer))))
+ (save-input-sender term-input-sender))
+ (when (> (point) pmark)
+ (unwind-protect
+ (progn
+ (setq term-input-sender
+ (symbol-function 'term-send-string))
+ (end-of-line)
+ (term-send-input))
+ (setq term-input-sender save-input-sender))))
+ (term-update-mode-line)))
(defun term-line-mode ()
"Switch to line (\"cooked\") sub-mode of term mode.
This means that Emacs editing commands work as normally, until
you type \\[term-send-input] which sends the current line to the inferior."
(interactive)
- (if (term-in-char-mode)
- (progn
- (use-local-map term-old-mode-map)
- (term-update-mode-line))))
+ (when (term-in-char-mode)
+ (use-local-map term-old-mode-map)
+ (term-update-mode-line)))
(defun term-update-mode-line ()
- (setq mode-line-process
- (if (term-in-char-mode)
- (if (term-pager-enabled) '(": char page %s") '(": char %s"))
- (if (term-pager-enabled) '(": line page %s") '(": line %s"))))
+ (let ((term-mode (if (term-in-char-mode) "char" "line"))
+ (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))
+ (let ((temp (serial-speed)))
+ (setq serial-item-speed
+ `(:propertize
+ ,(or (and temp (format " %d" temp)) "")
+ help-echo "mouse-1: Change the speed of the serial port"
+ mouse-face mode-line-highlight
+ local-map (keymap (mode-line keymap
+ (down-mouse-1 . serial-mode-line-speed-menu-1))))))
+ (let ((temp (process-contact proc :summary)))
+ (setq serial-item-config
+ `(:propertize
+ ,(or (and temp (format " %s" temp)) "")
+ help-echo "mouse-1: Change the configuration of the serial port"
+ mouse-face mode-line-highlight
+ local-map (keymap (mode-line keymap
+ (down-mouse-1 . serial-mode-line-config-menu-1)))))))
+ (setq mode-line-process
+ (list ": " term-mode term-page
+ serial-item-speed
+ serial-item-config
+ " %s")))
(force-mode-line-update))
(defun term-check-proc (buffer)
- "True if there is a process associated w/buffer BUFFER, and
-it is alive (status RUN or STOP). BUFFER can be either a buffer or the
-name of one."
+ "True if there is a process associated w/buffer BUFFER, and it
+is alive. BUFFER can be either a buffer or the name of one."
(let ((proc (get-buffer-process buffer)))
- (and proc (memq (process-status proc) '(run stop)))))
+ (and proc (memq (process-status proc) '(run stop open listen connect)))))
;;;###autoload
(defun make-term (name program &optional startfile &rest switches)
"Start up a process in buffer for term modes.
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."
+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.
- (if proc (delete-process proc)))
+ (when proc (delete-process proc)))
;; Crank up a new process
(let ((proc (term-exec-1 name buffer command switches)))
(make-local-variable 'term-ptyp)
(run-hooks 'term-exec-hook)
buffer)))
-(defun term-sentinel (proc msg)
+(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))))
- ))))
+ (when (memq (process-status proc) '(signal exit))
+ (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."
(insert ?\n "Process " process-name " " msg)
;; Force mode line redisplay soon.
(force-mode-line-update)
- (if (and opoint (< opoint omax))
- (goto-char opoint))))
+ (when (and opoint (< opoint omax))
+ (goto-char opoint))))
;;; Name to use for TERM.
:kb=^?:kD=^[[3~:sc=\\E7:rc=\\E8:r1=\\Ec:"
;;; : -undefine ic
;;; don't define :te=\\E[2J\\E[?47l\\E8:ti=\\E7\\E[?47h\
- "termcap capabilities supported")
+ "Termcap capabilities supported.")
;;; This auxiliary function cranks up the process for term-exec in
;;; the appropriate environment.
(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.
+ ;; We are going to get rid of the binding for EMACS,
+ ;; probably in Emacs 23, because it breaks
+ ;; `./configure' of some packages that expect it to
+ ;; say where to find EMACS.
(format "EMACS=%s (term:%s)" emacs-version term-protocol-version)
+ (format "INSIDE_EMACS=%s,term:%s" emacs-version term-protocol-version)
(format "LINES=%d" term-height)
(format "COLUMNS=%d" term-width))
process-environment))
nil t))
(let ((history (buffer-substring (match-beginning 1)
(match-end 1))))
- (if (or (null term-input-ignoredups)
- (ring-empty-p ring)
- (not (string-equal (ring-ref ring 0) history)))
+ (when (or (null term-input-ignoredups)
+ (ring-empty-p ring)
+ (not (string-equal (ring-ref ring 0) history)))
(ring-insert-at-beginning ring history)))
(setq count (1+ count))))
(kill-buffer history-buf))
"Return the string matching REGEXP ARG places along the input ring.
Moves relative to `term-input-ring-index'."
(let* ((pos (term-previous-matching-input-string-position regexp arg)))
- (if pos (ring-ref term-input-ring pos))))
+ (when pos (ring-ref term-input-ring pos))))
(defun term-previous-matching-input-string-position
(regexp arg &optional start)
"Return the index matching REGEXP ARG places along the input ring.
Moves relative to START, or `term-input-ring-index'."
- (if (or (not (ring-p term-input-ring))
- (ring-empty-p term-input-ring))
- (error "No history"))
+ (when (or (not (ring-p term-input-ring))
+ (ring-empty-p term-input-ring))
+ (error "No history"))
(let* ((len (ring-length term-input-ring))
(motion (if (> arg 0) 1 -1))
(n (mod (- (or start (term-search-start arg)) motion) len))
tried-each-ring-item (= n prev)))
(setq arg (if (> arg 0) (1- arg) (1+ arg))))
;; Now that we know which ring element to use, if we found it, return that.
- (if (string-match regexp (ring-ref term-input-ring n))
- n)))
+ (when (string-match regexp (ring-ref term-input-ring n))
+ n)))
(defun term-previous-matching-input (regexp arg)
"Search backwards through input history for match for REGEXP.
With prefix argument N, search for Nth previous match.
If N is negative, search forwards for the -Nth following match."
(interactive "p")
- (if (not (memq last-command '(term-previous-matching-input-from-input
+ (when (not (memq last-command '(term-previous-matching-input-from-input
term-next-matching-input-from-input)))
- ;; Starting a new search
- (setq term-matching-input-from-input-string
- (buffer-substring
- (process-mark (get-buffer-process (current-buffer)))
- (point))
- term-input-ring-index nil))
+ ;; Starting a new search
+ (setq term-matching-input-from-input-string
+ (buffer-substring
+ (process-mark (get-buffer-process (current-buffer)))
+ (point))
+ term-input-ring-index nil))
(term-previous-matching-input
(concat "^" (regexp-quote term-matching-input-from-input-string))
arg))
Returns t if successful."
(interactive)
- (if (and term-input-autoexpand
- (string-match "[!^]" (funcall term-get-old-input))
- (save-excursion (beginning-of-line)
- (looking-at term-prompt-regexp)))
- ;; Looks like there might be history references in the command.
- (let ((previous-modified-tick (buffer-modified-tick)))
- (message "Expanding history references...")
- (term-replace-by-expanded-history-before-point silent)
- (/= previous-modified-tick (buffer-modified-tick)))))
+ (when (and term-input-autoexpand
+ (string-match "[!^]" (funcall term-get-old-input))
+ (save-excursion (beginning-of-line)
+ (looking-at term-prompt-regexp)))
+ ;; Looks like there might be history references in the command.
+ (let ((previous-modified-tick (buffer-modified-tick)))
+ (message "Expanding history references...")
+ (term-replace-by-expanded-history-before-point silent)
+ (/= previous-modified-tick (buffer-modified-tick)))))
(defun term-replace-by-expanded-history-before-point (silent)
(delete-region pmark (point))
(insert input)
copy))))
- (if (term-pager-enabled)
- (save-excursion
- (goto-char (process-mark proc))
- (setq term-pager-count (term-current-row))))
- (if (and (funcall term-input-filter history)
- (or (null term-input-ignoredups)
- (not (ring-p term-input-ring))
- (ring-empty-p term-input-ring)
- (not (string-equal (ring-ref term-input-ring 0)
- history))))
- (ring-insert term-input-ring history))
+ (when (term-pager-enabled)
+ (save-excursion
+ (goto-char (process-mark proc))
+ (setq term-pager-count (term-current-row))))
+ (when (and (funcall term-input-filter history)
+ (or (null term-input-ignoredups)
+ (not (ring-p term-input-ring))
+ (ring-empty-p term-input-ring)
+ (not (string-equal (ring-ref term-input-ring 0)
+ history))))
+ (ring-insert term-input-ring history))
(let ((functions term-input-filter-functions))
(while functions
(funcall (car functions) (concat input "\n"))
;; in case we get output amidst sending the input.
(set-marker term-last-input-start pmark)
(set-marker term-last-input-end (point))
- (if input-is-new
- (progn
- ;; Set up to delete, because inferior should echo.
- (if (marker-buffer term-pending-delete-marker)
- (delete-region term-pending-delete-marker pmark))
- (set-marker term-pending-delete-marker pmark-val)
- (set-marker (process-mark proc) (point))))
+ (when input-is-new
+ ;; Set up to delete, because inferior should echo.
+ (when (marker-buffer term-pending-delete-marker)
+ (delete-region term-pending-delete-marker pmark))
+ (set-marker term-pending-delete-marker pmark-val)
+ (set-marker (process-mark proc) (point)))
(goto-char pmark)
(funcall term-input-sender proc input)))))
(defun term-get-old-input-default ()
- "Default for term-get-old-input.
+ "Default for `term-get-old-input'.
Take the current line, and discard any initial text matching
-term-prompt-regexp."
+`term-prompt-regexp'."
(save-excursion
(beginning-of-line)
(term-skip-prompt)
(insert input))))
(defun term-skip-prompt ()
- "Skip past the text matching regexp term-prompt-regexp.
+ "Skip past the text matching regexp `term-prompt-regexp'.
If this takes us past the end of the current line, don't skip at all."
(let ((eol (save-excursion (end-of-line) (point))))
- (if (and (looking-at term-prompt-regexp)
- (<= (match-end 0) eol))
- (goto-char (match-end 0)))))
+ (when (and (looking-at term-prompt-regexp)
+ (<= (match-end 0) eol))
+ (goto-char (match-end 0)))))
(defun term-after-pmark-p ()
-- go straight to column 0.
The prompt skip is done by skipping text matching the regular expression
-term-prompt-regexp, a buffer local variable."
+`term-prompt-regexp', a buffer local variable."
(interactive "P")
(beginning-of-line)
- (if (null arg) (term-skip-prompt)))
+ (when (null arg) (term-skip-prompt)))
;;; These two functions are for entering text you don't want echoed or
;;; saved -- typically passwords to ftp, telnet, or somesuch.
Security bug: your string can still be temporarily recovered with
\\[view-lossage]."
(interactive "P") ; Defeat snooping via C-x esc
- (if (not (stringp str))
- (setq str (term-read-noecho "Non-echoed text: " t)))
- (if (not proc)
- (setq proc (get-buffer-process (current-buffer))))
+ (when (not (stringp str))
+ (setq str (term-read-noecho "Non-echoed text: " t)))
+ (when (not proc)
+ (setq proc (get-buffer-process (current-buffer))))
(if (not proc) (error "Current buffer has no process")
(setq term-kill-echo-list (nconc term-kill-echo-list
(cons str nil)))
(defun term-send-string (proc str)
"Send to PROC the contents of STR as input.
-This is equivalent to process-send-string, except that long input strings
-are broken up into chunks of size term-input-chunk-size. Processes
+This is equivalent to `process-send-string', except that long input strings
+are broken up into chunks of size `term-input-chunk-size'. Processes
are given a chance to output between chunks. This can help prevent processes
from hanging when you send them long inputs on some OS's."
(let* ((len (length str))
(defun term-send-region (proc start end)
"Send to PROC the region delimited by START and END.
-This is a replacement for process-send-region that tries to keep
+This is a replacement for `process-send-region' that tries to keep
your process from hanging on long inputs. See `term-send-string'."
(term-send-string proc (buffer-substring start end)))
(interactive)
(let* ((pmark (process-mark (get-buffer-process (current-buffer))))
(p-pos (marker-position pmark)))
- (if (> (point) p-pos)
- (kill-region pmark (point)))))
+ (when (> (point) p-pos)
+ (kill-region pmark (point)))))
(defun term-delchar-or-maybe-eof (arg)
"Delete ARG characters forward, or send an EOF to process if at end of
(interactive "p")
(if (eobp)
(process-send-eof)
- (delete-char arg)))
+ (delete-char arg)))
(defun term-send-eof ()
"Send an EOF to the current buffer's process."
(interactive (term-regexp-arg "Backward input matching (regexp): "))
(let* ((re (concat term-prompt-regexp ".*" regexp))
(pos (save-excursion (end-of-line (if (> arg 0) 0 1))
- (if (re-search-backward re nil t arg)
- (point)))))
+ (when (re-search-backward re nil t arg)
+ (point)))))
(if (null pos)
(progn (message "Not found")
(ding))
(defun term-check-source (fname)
(let ((buff (get-file-buffer fname)))
- (if (and buff
- (buffer-modified-p buff)
- (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)))))
+ (when (and buff
+ (buffer-modified-p buff)
+ (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)))))
;;; (TERM-GET-SOURCE prompt prev-dir/file source-modes mustmatch-p)
;; Try to position the proc window so you can see the answer.
;; This is bogus code. If you delete the (sit-for 0), it breaks.
;; I don't know why. Wizards invited to improve it.
- (if (not (pos-visible-in-window-p proc-pt proc-win))
- (let ((opoint (window-point proc-win)))
- (set-window-point proc-win proc-mark) (sit-for 0)
- (if (not (pos-visible-in-window-p opoint proc-win))
- (push-mark opoint)
- (set-window-point proc-win opoint)))))))
+ (when (not (pos-visible-in-window-p proc-pt proc-win))
+ (let ((opoint (window-point proc-win)))
+ (set-window-point proc-win proc-mark) (sit-for 0)
+ (if (not (pos-visible-in-window-p opoint proc-win))
+ (push-mark opoint)
+ (set-window-point proc-win opoint)))))))
\f
;;; Returns the current column in the current screen line.
;;; Note: (current-column) yields column in buffer line.
(defun term-emulate-terminal (proc str)
(with-current-buffer (process-buffer proc)
- (let* ((i 0) char funny count save-point save-marker old-point temp win
+ (let* ((i 0) char funny
+ count ; number of decoded chars in substring
+ count-bytes ; number of bytes
+ decoded-substring
+ save-point save-marker old-point temp win
(buffer-undo-list t)
(selected (selected-window))
last-win
;; Let's handle the messages. -mm
(let* ((newstr (term-handle-ansi-terminal-messages str)))
- (if (not (eq str newstr))
- (setq handled-ansi-message t
- str newstr)))
+ (when (not (eq str newstr))
+ (setq handled-ansi-message t
+ str newstr)))
(setq str-length (length str))
- (if (marker-buffer term-pending-delete-marker)
- (progn
- ;; Delete text following term-pending-delete-marker.
- (delete-region term-pending-delete-marker (process-mark proc))
- (set-marker term-pending-delete-marker nil)))
+ (when (marker-buffer term-pending-delete-marker)
+ ;; Delete text following term-pending-delete-marker.
+ (delete-region term-pending-delete-marker (process-mark proc))
+ (set-marker term-pending-delete-marker nil))
(if (eq (window-buffer) (current-buffer))
(progn
(setq save-marker (copy-marker (process-mark proc)))
- (if (/= (point) (process-mark proc))
- (progn (setq save-point (point-marker))
- (goto-char (process-mark proc))))
+ (when (/= (point) (process-mark proc))
+ (setq save-point (point-marker))
+ (goto-char (process-mark proc)))
(save-restriction
;; If the buffer is in line mode, and there is a partial
;; input line, save the line (by narrowing to leave it
;; outside the restriction ) until we're done with output.
- (if (and (> (point-max) (process-mark proc))
- (term-in-line-mode))
- (narrow-to-region (point-min) (process-mark proc)))
+ (when (and (> (point-max) (process-mark proc))
+ (term-in-line-mode))
+ (narrow-to-region (point-min) (process-mark proc)))
- (if term-log-buffer
- (princ str term-log-buffer))
+ (when term-log-buffer
+ (princ str term-log-buffer))
(cond ((eq term-terminal-state 4) ;; Have saved pending output.
(setq str (concat term-terminal-parameter str))
(setq term-terminal-parameter nil)
(setq funny
(string-match "[\r\n\000\007\033\t\b\032\016\017]"
str i))
- (if (not funny) (setq funny str-length))
+ (when (not funny) (setq funny str-length))
(cond ((> funny i)
+ ;; Decode the string before counting
+ ;; characters, to avoid garbling of certain
+ ;; multibyte characters (bug#1006).
+ (setq decoded-substring
+ (decode-coding-string
+ (substring str i funny)
+ locale-coding-system))
(cond ((eq term-terminal-state 1)
;; We are in state 1, we need to wrap
;; around. Go to the beginning of
(term-down 1 t)
(term-move-columns (- (term-current-column)))
(setq term-terminal-state 0)))
- (setq count (- funny i))
+ (setq count (length decoded-substring))
(setq temp (- (+ (term-horizontal-column) count)
term-width))
(cond ((<= temp 0)) ;; All count chars fit in line.
((> count temp) ;; Some chars fit.
;; This iteration, handle only what fits.
(setq count (- count temp))
+ (setq count-bytes
+ (length
+ (encode-coding-string
+ (substring decoded-substring 0 count)
+ 'binary)))
(setq temp 0)
- (setq funny (+ count i)))
+ (setq funny (+ count-bytes i)))
((or (not (or term-pager-count
term-scroll-with-delete))
(> (term-handle-scroll 1) 0))
(term-adjust-current-row-cache 1)
(setq count (min count term-width))
- (setq funny (+ count i))
+ (setq count-bytes
+ (length
+ (encode-coding-string
+ (substring decoded-substring 0 count)
+ 'binary)))
+ (setq funny (+ count-bytes i))
(setq term-start-line-column
term-current-column))
(t ;; Doing PAGER processing.
;; following point if not eob nor insert-mode.
(let ((old-column (current-column))
columns pos)
- (insert (decode-coding-string (substring str i funny) locale-coding-system))
+ (insert decoded-substring)
(setq term-current-column (current-column)
columns (- term-current-column old-column))
(when (not (or (eobp) term-insert-mode))
(setq count (min term-width
(+ count 8 (- (mod count 8)))))
(if (> term-width count)
- (progn
- (term-move-columns
- (- count (term-current-column)))
- (setq term-current-column count))
+ (progn
+ (term-move-columns
+ (- count (term-current-column)))
+ (setq term-current-column count))
(when (> term-width (term-current-column))
(term-move-columns
(1- (- term-width (term-current-column)))))
;; (setq term-terminal-state 0))
((eq char ?M) ;; scroll reversed (terminfo: ri)
(if (or (< (term-current-row) term-scroll-start)
- (>= (1- (term-current-row))
+ (>= (1- (term-current-row))
term-scroll-start))
;; Scrolling up will not move outside
;; the scroll region.
(when term-saved-cursor
(term-goto (nth 0 term-saved-cursor)
(nth 1 term-saved-cursor))
- (setq term-ansi-current-bg-color
+ (setq term-ansi-current-bg-color
(nth 2 term-saved-cursor)
term-ansi-current-bold
(nth 3 term-saved-cursor)
(setq term-terminal-previous-parameter-2 -1)
(setq term-terminal-previous-parameter -1)
(setq term-terminal-state 0)))))
- (if (term-handling-pager)
- ;; Finish stuff to get ready to handle PAGER.
- (progn
- (if (> (% (current-column) term-width) 0)
- (setq term-terminal-parameter
- (substring str i))
- ;; We're at column 0. Goto end of buffer; to compensate,
- ;; prepend a ?\r for later. This looks more consistent.
- (if (zerop i)
- (setq term-terminal-parameter
- (concat "\r" (substring str i)))
- (setq term-terminal-parameter (substring str (1- i)))
- (aset term-terminal-parameter 0 ?\r))
- (goto-char (point-max)))
- (setq term-terminal-state 4)
- (make-local-variable 'term-pager-old-filter)
- (setq term-pager-old-filter (process-filter proc))
- (set-process-filter proc term-pager-filter)
- (setq i str-length)))
+ (when (term-handling-pager)
+ ;; Finish stuff to get ready to handle PAGER.
+ (if (> (% (current-column) term-width) 0)
+ (setq term-terminal-parameter
+ (substring str i))
+ ;; We're at column 0. Goto end of buffer; to compensate,
+ ;; prepend a ?\r for later. This looks more consistent.
+ (if (zerop i)
+ (setq term-terminal-parameter
+ (concat "\r" (substring str i)))
+ (setq term-terminal-parameter (substring str (1- i)))
+ (aset term-terminal-parameter 0 ?\r))
+ (goto-char (point-max)))
+ (setq term-terminal-state 4)
+ (make-local-variable 'term-pager-old-filter)
+ (setq term-pager-old-filter (process-filter proc))
+ (set-process-filter proc term-pager-filter)
+ (setq i str-length))
(setq i (1+ i))))
- (if (>= (term-current-row) term-height)
- (term-handle-deferred-scroll))
+ (when (>= (term-current-row) term-height)
+ (term-handle-deferred-scroll))
(set-marker (process-mark proc) (point))
- (if save-point
- (progn (goto-char save-point)
- (set-marker save-point nil)))
+ (when save-point
+ (goto-char save-point)
+ (set-marker save-point nil))
;; Check for a pending filename-and-line number to display.
;; We do this before scrolling, because we might create a new window.
- (if (and term-pending-frame
- (eq (window-buffer selected) (current-buffer)))
- (progn (term-display-line (car term-pending-frame)
- (cdr term-pending-frame))
- (setq term-pending-frame nil)
- ;; We have created a new window, so check the window size.
- (term-check-size proc)))
+ (when (and term-pending-frame
+ (eq (window-buffer selected) (current-buffer)))
+ (term-display-line (car term-pending-frame)
+ (cdr term-pending-frame))
+ (setq term-pending-frame nil)
+ ;; We have created a new window, so check the window size.
+ (term-check-size proc))
;; Scroll each window displaying the buffer but (by default)
;; only if the point matches the process-mark we started with.
(setq last-win win)
(while (progn
(setq win (next-window win nil t))
- (if (eq (window-buffer win) (process-buffer proc))
- (let ((scroll term-scroll-to-bottom-on-output))
- (select-window win)
- (if (or (= (point) save-marker)
+ (when (eq (window-buffer win) (process-buffer proc))
+ (let ((scroll term-scroll-to-bottom-on-output))
+ (select-window win)
+ (when (or (= (point) save-marker)
(eq scroll t) (eq scroll 'all)
;; Maybe user wants point to jump to the end.
(and (eq selected win)
(or (eq scroll 'this) (not save-point)))
(and (eq scroll 'others)
(not (eq selected win))))
- (progn
- (goto-char term-home-marker)
- (recenter 0)
- (goto-char (process-mark proc))
- (if (not (pos-visible-in-window-p (point) win))
- (recenter -1))))
- ;; Optionally scroll so that the text
- ;; ends at the bottom of the window.
- (if (and term-scroll-show-maximum-output
+ (goto-char term-home-marker)
+ (recenter 0)
+ (goto-char (process-mark proc))
+ (if (not (pos-visible-in-window-p (point) win))
+ (recenter -1)))
+ ;; Optionally scroll so that the text
+ ;; ends at the bottom of the window.
+ (when (and term-scroll-show-maximum-output
(>= (point) (process-mark proc)))
- (save-excursion
- (goto-char (point-max))
- (recenter -1)))))
+ (save-excursion
+ (goto-char (point-max))
+ (recenter -1)))))
(not (eq win last-win))))
;;; Stolen from comint.el and adapted -mm
- (if (> term-buffer-maximum-size 0)
- (save-excursion
- (goto-char (process-mark (get-buffer-process (current-buffer))))
- (forward-line (- term-buffer-maximum-size))
- (beginning-of-line)
- (delete-region (point-min) (point))))
-;;;
-
- (set-marker save-marker nil)))))
+ (when (> term-buffer-maximum-size 0)
+ (save-excursion
+ (goto-char (process-mark (get-buffer-process (current-buffer))))
+ (forward-line (- term-buffer-maximum-size))
+ (beginning-of-line)
+ (delete-region (point-min) (point))))
+ (set-marker save-marker nil)))
+ ;; This might be expensive, but we need it to handle something
+ ;; like `sleep 5 | less -c' in more-or-less real time.
+ (when (get-buffer-window (current-buffer))
+ (redisplay))))
(defun term-handle-deferred-scroll ()
(let ((count (- (term-current-row) term-height)))
- (if (>= count 0)
- (save-excursion
- (goto-char term-home-marker)
- (term-vertical-motion (1+ count))
- (set-marker term-home-marker (point))
- (setq term-current-row (1- term-height))))))
+ (when (>= count 0)
+ (save-excursion
+ (goto-char term-home-marker)
+ (term-vertical-motion (1+ count))
+ (set-marker term-home-marker (point))
+ (setq term-current-row (1- term-height))))))
;;; Reset the terminal, delete all the content and set the face to the
;;; default one.
(setq term-scroll-start 0)
(setq term-scroll-end term-height)
(setq term-insert-mode nil)
- (setq term-current-face 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)
;;; 0 (Reset) or unknown (reset anyway)
(t
- (setq term-current-face 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-current-face
(list :background
(if (= term-ansi-current-color 0)
- (face-foreground 'default)
- (elt ansi-term-color-vector term-ansi-current-color))
+ term-default-fg-color
+ (elt ansi-term-color-vector term-ansi-current-color))
:foreground
(if (= term-ansi-current-bg-color 0)
- (face-background 'default)
- (elt ansi-term-color-vector term-ansi-current-bg-color))))
+ 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)))
+ (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))))
+ (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)
)
(setq term-current-face
(list :foreground
- (elt ansi-term-color-vector term-ansi-current-color)
+ (if (= term-ansi-current-color 0)
+ term-default-fg-color
+ (elt ansi-term-color-vector term-ansi-current-color))
:background
- (elt ansi-term-color-vector term-ansi-current-bg-color)))
+ (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)))
+ (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))))))
+ (setq term-current-face
+ (append '(:underline t) term-current-face))))))
;;; (message "Debug %S" term-current-face)
(setq term-ansi-face-already-done nil))
;; (eq char ?f) ;; xterm seems to handle this sequence too, not
;; needed for now
)
- (if (<= term-terminal-parameter 0)
- (setq term-terminal-parameter 1))
- (if (<= term-terminal-previous-parameter 0)
- (setq term-terminal-previous-parameter 1))
- (if (> term-terminal-previous-parameter term-height)
- (setq term-terminal-previous-parameter term-height))
- (if (> term-terminal-parameter term-width)
- (setq term-terminal-parameter term-width))
+ (when (<= term-terminal-parameter 0)
+ (setq term-terminal-parameter 1))
+ (when (<= term-terminal-previous-parameter 0)
+ (setq term-terminal-previous-parameter 1))
+ (when (> term-terminal-previous-parameter term-height)
+ (setq term-terminal-previous-parameter term-height))
+ (when (> term-terminal-parameter term-width)
+ (setq term-terminal-parameter term-width))
(term-goto
(1- term-terminal-previous-parameter)
(1- term-terminal-parameter)))
((eq char ?A)
(term-handle-deferred-scroll)
(let ((tcr (term-current-row)))
- (term-down
+ (term-down
(if (< (- tcr term-terminal-parameter) term-scroll-start)
;; If the amount to move is before scroll start, move
;; to scroll start.
((eq char ?B)
(let ((tcr (term-current-row)))
(unless (= tcr (1- term-scroll-end))
- (term-down
+ (term-down
(if (> (+ tcr term-terminal-parameter) term-scroll-end)
(- term-scroll-end 1 tcr)
(max 1 term-terminal-parameter)) t))))
((eq char ?r)
(term-set-scroll-region
(1- term-terminal-previous-parameter)
- term-terminal-parameter))
+ (1- term-terminal-parameter)))
(t)))
(defun term-set-scroll-region (top bottom)
; The page is full, so enter "pager" mode, and wait for input.
(defun term-process-pager ()
- (if (not term-pager-break-map)
- (let* ((map (make-keymap))
- (i 0) tmp)
+ (when (not term-pager-break-map)
+ (let* ((map (make-keymap))
+ (i 0) tmp)
; (while (< i 128)
; (define-key map (make-string 1 i) 'term-send-raw)
; (setq i (1+ i)))
- (define-key map "\e"
- (lookup-key (current-global-map) "\e"))
- (define-key map "\C-x"
- (lookup-key (current-global-map) "\C-x"))
- (define-key map "\C-u"
- (lookup-key (current-global-map) "\C-u"))
- (define-key map " " 'term-pager-page)
- (define-key map "\r" 'term-pager-line)
- (define-key map "?" 'term-pager-help)
- (define-key map "h" 'term-pager-help)
- (define-key map "b" 'term-pager-back-page)
- (define-key map "\177" 'term-pager-back-line)
- (define-key map "q" 'term-pager-discard)
- (define-key map "D" 'term-pager-disable)
- (define-key map "<" 'term-pager-bob)
- (define-key map ">" 'term-pager-eob)
-
- ;; Add menu bar.
- (progn
- (term-ifnot-xemacs
- (define-key map [menu-bar terminal] term-terminal-menu)
- (define-key map [menu-bar signals] term-signals-menu)
- (setq tmp (make-sparse-keymap "More pages?"))
- (define-key tmp [help] '("Help" . term-pager-help))
- (define-key tmp [disable]
- '("Disable paging" . term-fake-pager-disable))
- (define-key tmp [discard]
- '("Discard remaining output" . term-pager-discard))
- (define-key tmp [eob] '("Goto to end" . term-pager-eob))
- (define-key tmp [bob] '("Goto to beginning" . term-pager-bob))
- (define-key tmp [line] '("1 line forwards" . term-pager-line))
- (define-key tmp [bline] '("1 line backwards" . term-pager-back-line))
- (define-key tmp [back] '("1 page backwards" . term-pager-back-page))
- (define-key tmp [page] '("1 page forwards" . term-pager-page))
- (define-key map [menu-bar page] (cons "More pages?" tmp))
- ))
+ (define-key map "\e"
+ (lookup-key (current-global-map) "\e"))
+ (define-key map "\C-x"
+ (lookup-key (current-global-map) "\C-x"))
+ (define-key map "\C-u"
+ (lookup-key (current-global-map) "\C-u"))
+ (define-key map " " 'term-pager-page)
+ (define-key map "\r" 'term-pager-line)
+ (define-key map "?" 'term-pager-help)
+ (define-key map "h" 'term-pager-help)
+ (define-key map "b" 'term-pager-back-page)
+ (define-key map "\177" 'term-pager-back-line)
+ (define-key map "q" 'term-pager-discard)
+ (define-key map "D" 'term-pager-disable)
+ (define-key map "<" 'term-pager-bob)
+ (define-key map ">" 'term-pager-eob)
+
+ ;; Add menu bar.
+ (unless (featurep 'xemacs)
+ (define-key map [menu-bar terminal] term-terminal-menu)
+ (define-key map [menu-bar signals] term-signals-menu)
+ (setq tmp (make-sparse-keymap "More pages?"))
+ (define-key tmp [help] '("Help" . term-pager-help))
+ (define-key tmp [disable]
+ '("Disable paging" . term-fake-pager-disable))
+ (define-key tmp [discard]
+ '("Discard remaining output" . term-pager-discard))
+ (define-key tmp [eob] '("Goto to end" . term-pager-eob))
+ (define-key tmp [bob] '("Goto to beginning" . term-pager-bob))
+ (define-key tmp [line] '("1 line forwards" . term-pager-line))
+ (define-key tmp [bline] '("1 line backwards" . term-pager-back-line))
+ (define-key tmp [back] '("1 page backwards" . term-pager-back-page))
+ (define-key tmp [page] '("1 page forwards" . term-pager-page))
+ (define-key map [menu-bar page] (cons "More pages?" tmp))
+ )
- (setq term-pager-break-map map)))
+ (setq term-pager-break-map map)))
; (let ((process (get-buffer-process (current-buffer))))
; (stop-process process))
(setq term-pager-old-local-map (current-local-map))
(interactive "p")
(let* ((moved (vertical-motion (1+ lines)))
(deficit (- lines moved)))
- (if (> moved lines)
- (backward-char))
+ (when (> moved lines)
+ (backward-char))
(cond ((<= deficit 0) ;; OK, had enough in the buffer for request.
(recenter (1- term-height)))
((term-pager-continue deficit)))))
(defun term-pager-page (arg)
- "Proceed past the **MORE** break, allowing the next page of output to appear"
+ "Proceed past the **MORE** break, allowing the next page of output to appear."
(interactive "p")
(term-pager-line (* arg term-height)))
(defun term-pager-bob ()
(interactive)
(goto-char (point-min))
- (if (= (vertical-motion term-height) term-height)
- (backward-char))
+ (when (= (vertical-motion term-height) term-height)
+ (backward-char))
(recenter (1- term-height)))
; pager mode command to go to end of buffer
(interactive)
(if (term-pager-enabled) (term-pager-disable) (term-pager-enable)))
-(term-ifnot-xemacs
+(unless (featurep 'xemacs)
(defalias 'term-fake-pager-enable 'term-pager-toggle)
(defalias 'term-fake-pager-disable 'term-pager-toggle)
(put 'term-char-mode 'menu-enable '(term-in-line-mode))
(put 'term-fake-pager-disable 'menu-enable 'term-pager-count))
(defun term-pager-help ()
- "Provide help on commands available in a terminal-emulator **MORE** break"
+ "Provide help on commands available in a terminal-emulator **MORE** break."
(interactive)
(message "Terminal-emulator pager break help...")
(sit-for 0)
(defun term-handle-scroll (down)
(let ((scroll-needed
- (- (+ (term-current-row) down)
+ (- (+ (term-current-row) down)
(if (< down 0) term-scroll-start term-scroll-end))))
- (if (or (and (< down 0) (< scroll-needed 0))
- (and (> down 0) (> scroll-needed 0)))
- (let ((save-point (copy-marker (point))) (save-top))
- (goto-char term-home-marker)
- (cond (term-scroll-with-delete
- (if (< down 0)
- (progn
- ;; Delete scroll-needed lines at term-scroll-end,
- ;; then insert scroll-needed lines.
- (term-vertical-motion (1- term-scroll-end))
- (end-of-line)
- (setq save-top (point))
- (term-vertical-motion scroll-needed)
- (end-of-line)
- (delete-region save-top (point))
- (goto-char save-point)
- (setq down (- scroll-needed down))
- (term-vertical-motion down))
- ;; Delete scroll-needed lines at term-scroll-start.
- (term-vertical-motion term-scroll-start)
- (setq save-top (point))
- (term-vertical-motion scroll-needed)
- (delete-region save-top (point))
- (goto-char save-point)
- (term-vertical-motion down)
- (term-adjust-current-row-cache (- scroll-needed)))
- (setq term-current-column nil)
- (term-insert-char ?\n (abs scroll-needed)))
- ((and (numberp term-pager-count)
- (< (setq term-pager-count (- term-pager-count down))
- 0))
- (setq down 0)
- (term-process-pager))
- (t
- (term-adjust-current-row-cache (- scroll-needed))
+ (when (or (and (< down 0) (< scroll-needed 0))
+ (and (> down 0) (> scroll-needed 0)))
+ (let ((save-point (copy-marker (point))) (save-top))
+ (goto-char term-home-marker)
+ (cond (term-scroll-with-delete
+ (if (< down 0)
+ (progn
+ ;; Delete scroll-needed lines at term-scroll-end,
+ ;; then insert scroll-needed lines.
+ (term-vertical-motion term-scroll-end)
+ (end-of-line)
+ (setq save-top (point))
+ (term-vertical-motion scroll-needed)
+ (end-of-line)
+ (delete-region save-top (point))
+ (goto-char save-point)
+ (setq down (- scroll-needed down))
+ (term-vertical-motion down))
+ ;; Delete scroll-needed lines at term-scroll-start.
+ (term-vertical-motion term-scroll-start)
+ (setq save-top (point))
(term-vertical-motion scroll-needed)
- (set-marker term-home-marker (point))))
- (goto-char save-point)
- (set-marker save-point nil))))
+ (delete-region save-top (point))
+ (goto-char save-point)
+ (term-vertical-motion down)
+ (term-adjust-current-row-cache (- scroll-needed)))
+ (setq term-current-column nil)
+ (term-insert-char ?\n (abs scroll-needed)))
+ ((and (numberp term-pager-count)
+ (< (setq term-pager-count (- term-pager-count down))
+ 0))
+ (setq down 0)
+ (term-process-pager))
+ (t
+ (term-adjust-current-row-cache (- scroll-needed))
+ (term-vertical-motion scroll-needed)
+ (set-marker term-home-marker (point))))
+ (goto-char save-point)
+ (set-marker save-point nil))))
down)
(defun term-down (down &optional check-for-scroll)
;; if the line above point wraps around, add a ?\n to undo the wrapping.
;; FIXME: Probably should be called more than it is.
(defun term-unwrap-line ()
- (if (not (bolp)) (insert-before-markers ?\n)))
+ (when (not (bolp)) (insert-before-markers ?\n)))
(defun term-erase-in-line (kind)
- (if (= kind 1) ;; erase left of point
- (let ((cols (term-horizontal-column)) (saved-point (point)))
- (term-vertical-motion 0)
- (delete-region (point) saved-point)
- (term-insert-char ? cols)))
- (if (not (eq kind 1)) ;; erase right of point
- (let ((saved-point (point))
- (wrapped (and (zerop (term-horizontal-column))
- (not (zerop (term-current-column))))))
- (term-vertical-motion 1)
- (delete-region saved-point (point))
- ;; wrapped is true if we're at the beginning of screen line,
- ;; but not a buffer line. If we delete the current screen line
- ;; that will make the previous line no longer wrap, and (because
- ;; of the way Emacs display works) point will be at the end of
- ;; the previous screen line rather then the beginning of the
- ;; current one. To avoid that, we make sure that current line
- ;; contain a space, to force the previous line to continue to wrap.
- ;; We could do this always, but it seems preferable to not add the
- ;; extra space when wrapped is false.
- (if wrapped
- (insert ? ))
- (insert ?\n)
- (put-text-property saved-point (point) 'face 'default)
- (goto-char saved-point))))
+ (when (= kind 1) ;; erase left of point
+ (let ((cols (term-horizontal-column)) (saved-point (point)))
+ (term-vertical-motion 0)
+ (delete-region (point) saved-point)
+ (term-insert-char ? cols)))
+ (when (not (eq kind 1)) ;; erase right of point
+ (let ((saved-point (point))
+ (wrapped (and (zerop (term-horizontal-column))
+ (not (zerop (term-current-column))))))
+ (term-vertical-motion 1)
+ (delete-region saved-point (point))
+ ;; wrapped is true if we're at the beginning of screen line,
+ ;; but not a buffer line. If we delete the current screen line
+ ;; that will make the previous line no longer wrap, and (because
+ ;; of the way Emacs display works) point will be at the end of
+ ;; the previous screen line rather then the beginning of the
+ ;; current one. To avoid that, we make sure that current line
+ ;; contain a space, to force the previous line to continue to wrap.
+ ;; We could do this always, but it seems preferable to not add the
+ ;; extra space when wrapped is false.
+ (when wrapped
+ (insert ? ))
+ (insert ?\n)
+ (put-text-property saved-point (point) 'face 'default)
+ (goto-char saved-point))))
(defun term-erase-in-display (kind)
"Erases (that is blanks out) part of the window.
If KIND is 0, erase from (point) to (point-max);
-if KIND is 1, erase from home to point; else erase from home to point-max.
-Should only be called when point is at the start of a screen line."
+if KIND is 1, erase from home to point; else erase from home to point-max."
(term-handle-deferred-scroll)
(cond ((eq term-terminal-parameter 0)
- (delete-region (point) (point-max))
- (term-unwrap-line))
+ (let ((need-unwrap (bolp)))
+ (delete-region (point) (point-max))
+ (when need-unwrap (term-unwrap-line))))
((let ((row (term-current-row))
(col (term-horizontal-column))
(start-region term-home-marker)
(save-current-column term-current-column)
(save-start-line-column term-start-line-column)
(save-current-row (term-current-row)))
- (when (>= (+ save-current-row lines) term-scroll-end)
- (setq lines (- lines (- (+ save-current-row lines) term-scroll-end))))
+ ;; The number of inserted lines shouldn't exceed the scroll region end.
+ ;; The `term-scroll-end' line is part of the scrolling region, so
+ ;; we need to go one line past it in order to ensure correct
+ ;; scrolling.
+ (when (> (+ save-current-row lines) (1+ term-scroll-end))
+ (setq lines (- lines (- (+ save-current-row lines) (1+ term-scroll-end)))))
(term-down lines)
(delete-region start (point))
- (term-down (- term-scroll-end save-current-row lines))
+ (term-down (- (1+ term-scroll-end) save-current-row lines))
(term-insert-char ?\n lines)
(setq term-current-column save-current-column)
(setq term-start-line-column save-start-line-column)
(save-start-line-column term-start-line-column)
(save-current-row (term-current-row)))
;; Inserting lines should take into account the scroll region.
+ ;; The `term-scroll-end' line is part of the scrolling region, so
+ ;; we need to go one line past it in order to ensure correct
+ ;; scrolling.
(if (< save-current-row term-scroll-start)
- ;; If point is before scroll start,
- (progn
+ ;; If point is before scroll start,
+ (progn
(setq lines (- lines (- term-scroll-start save-current-row)))
(term-down (- term-scroll-start save-current-row))
(setq start (point)))
;; The number of inserted lines shouldn't exceed the scroll region end.
- (when (>= (+ save-current-row lines) term-scroll-end)
- (setq lines (- lines (- (+ save-current-row lines) term-scroll-end))))
- (term-down (- term-scroll-end save-current-row lines)))
+ (when (> (+ save-current-row lines) (1+ term-scroll-end))
+ (setq lines (- lines (- (+ save-current-row lines)(1+ term-scroll-end)))))
+ (term-down (- (1+ term-scroll-end) save-current-row lines)))
(setq start-deleted (point))
(term-down lines)
(delete-region start-deleted (point))
(let ((limit (point))
(word (concat "[" word-chars "]"))
(non-word (concat "[^" word-chars "]")))
- (if (re-search-backward non-word nil 'move)
- (forward-char 1))
+ (when (re-search-backward non-word nil 'move)
+ (forward-char 1))
;; Anchor the search forwards.
(if (or (eolp) (looking-at non-word))
nil
Returns t if successful."
(interactive)
- (if (term-match-partial-filename)
- (prog2 (or (eq (selected-window) (minibuffer-window))
- (message "Completing file name..."))
- (term-dynamic-complete-as-filename))))
+ (when (term-match-partial-filename)
+ (prog2 (or (eq (selected-window) (minibuffer-window))
+ (message "Completing file name..."))
+ (term-dynamic-complete-as-filename))))
(defun term-dynamic-complete-as-filename ()
"Dynamically complete at point as a filename.
(message "No completions of %s" filename)
(setq success nil))
((eq completion t) ; Means already completed "file".
- (if term-completion-addsuffix (insert " "))
+ (when term-completion-addsuffix (insert " "))
(or mini-flag (message "Sole completion")))
((string-equal completion "") ; Means completion on "directory/".
(term-dynamic-list-filename-completions))
(message "Sole completion")
(insert (substring completion (length stub)))
(message "Completed"))
- (if term-completion-addsuffix (insert " "))
+ (when term-completion-addsuffix (insert " "))
'sole))
(t ; There's no unique completion.
(let ((completion (try-completion stub candidates)))
(switch-to-buffer term-ansi-buffer-name))
\f
+;;; Serial terminals
+;;; ===========================================================================
+(defun serial-port-is-file-p ()
+ "Guess whether serial ports are files on this system.
+Return t if this is a Unix-based system, where serial ports are
+files, such as /dev/ttyS0.
+Return nil if this is Windows or DOS, where serial ports have
+special identifiers such as COM1."
+ (not (member system-type (list 'windows-nt 'cygwin 'ms-dos))))
+
+(defvar serial-name-history
+ (if (serial-port-is-file-p)
+ (or (when (file-exists-p "/dev/ttys0") (list "/dev/ttys0"))
+ (when (file-exists-p "/dev/ttyS0") (list "/dev/ttyS0")))
+ (list "COM1"))
+ "History of serial ports used by `serial-read-name'.")
+
+(defvar serial-speed-history
+ ;; Initialised with reasonable values for newbies.
+ (list "9600" ;; Given twice because 9600 b/s is the most common speed
+ "1200" "2400" "4800" "9600" "14400" "19200"
+ "28800" "38400" "57600" "115200")
+ "History of serial port speeds used by `serial-read-speed'.")
+
+(defun serial-nice-speed-history ()
+ "Return `serial-speed-history' cleaned up for a mouse-menu."
+ (let ((x) (y))
+ (setq x
+ (sort
+ (copy-sequence serial-speed-history)
+ '(lambda (a b) (when (and (stringp a) (stringp b))
+ (> (string-to-number a) (string-to-number b))))))
+ (dolist (i x) (when (not (equal i (car y))) (push i y)))
+ y))
+
+(defconst serial-no-speed "nil"
+ "String for `serial-read-speed' for special serial ports.
+If `serial-read-speed' reads this string from the user, it
+returns nil, which is recognized by `serial-process-configure'
+for special serial ports that cannot be configured.")
+
+(defun serial-supported-or-barf ()
+ "Signal an error if serial processes are not supported"
+ (unless (fboundp 'make-serial-process)
+ (error "Serial processes are not supported on this system")))
+
+(defun serial-read-name ()
+ "Read a serial port name from the user.
+Try to be nice by providing useful defaults and history.
+On Windows, prepend \\.\ to the port name unless it already
+contains a backslash. This handles the legacy ports COM1-COM9 as
+well as the newer ports COM10 and higher."
+ (serial-supported-or-barf)
+ (let* ((file-name-history serial-name-history)
+ (h (car file-name-history))
+ (x (if (serial-port-is-file-p)
+ (read-file-name
+ ;; `prompt': The most recently used port is provided as
+ ;; the default value, which is used when the user
+ ;; simply presses return.
+ (if (stringp h) (format "Serial port (default %s): " h)
+ "Serial port: ")
+ ;; `directory': Most systems have their serial ports
+ ;; in the same directory, so start in the directory
+ ;; of the most recently used port, or in a reasonable
+ ;; default directory.
+ (or (and h (file-name-directory h))
+ (and (file-exists-p "/dev/") "/dev/")
+ (and (file-exists-p "/") "/"))
+ ;; `default': This causes (read-file-name) to return
+ ;; the empty string if he user simply presses return.
+ ;; Using nil here may result in a default directory
+ ;; of the current buffer, which is not useful for
+ ;; serial port.
+ "")
+ (read-from-minibuffer
+ (if (stringp h) (format "Serial port (default %s): " h)
+ "Serial port: ")
+ nil nil nil '(file-name-history . 1) nil nil))))
+ (if (or (null x) (and (stringp x) (zerop (length x))))
+ (setq x h)
+ (setq serial-name-history file-name-history))
+ (when (or (null x) (and (stringp x) (zerop (length x))))
+ (error "No serial port selected"))
+ (when (and (not (serial-port-is-file-p))
+ (not (string-match "\\\\" x)))
+ (set 'x (concat "\\\\.\\" x)))
+ x))
+
+(defun serial-read-speed ()
+ "Read a serial port speed (in bits per second) from the user.
+Try to be nice by providing useful defaults and history."
+ (serial-supported-or-barf)
+ (let* ((history serial-speed-history)
+ (h (car history))
+ (x (read-from-minibuffer
+ (cond ((string= h serial-no-speed)
+ "Speed (default nil = set by port): ")
+ (h
+ (format "Speed (default %s b/s): " h))
+ (t
+ (format "Speed (b/s): ")))
+ nil nil nil '(history . 1) nil nil)))
+ (when (or (null x) (and (stringp x) (zerop (length x))))
+ (setq x h))
+ (when (or (null x) (not (stringp x)) (zerop (length x)))
+ (error "Invalid speed"))
+ (if (string= x serial-no-speed)
+ (setq x nil)
+ (setq x (string-to-number x))
+ (when (or (null x) (not (integerp x)) (<= x 0))
+ (error "Invalid speed")))
+ (setq serial-speed-history history)
+ x))
+
+;;;###autoload
+(defun serial-term (port speed)
+ "Start a terminal-emulator for a serial port in a new buffer.
+PORT is the path or name of the serial port. For example, this
+could be \"/dev/ttyS0\" on Unix. On Windows, this could be
+\"COM1\" or \"\\\\.\\COM10\".
+SPEED is the speed of the serial port in bits per second. 9600
+is a common value. SPEED can be nil, see
+`serial-process-configure' for details.
+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 (serial-read-name) (serial-read-speed)))
+ (serial-supported-or-barf)
+ (let* ((process (make-serial-process
+ :port port
+ :speed speed
+ :coding 'no-conversion
+ :noquery t))
+ (buffer (process-buffer process)))
+ (save-excursion
+ (set-buffer buffer)
+ (term-mode)
+ (term-char-mode)
+ (goto-char (point-max))
+ (set-marker (process-mark process) (point))
+ (set-process-filter process 'term-emulate-terminal)
+ (set-process-sentinel process 'term-sentinel))
+ (switch-to-buffer buffer)
+ buffer))
+
+(defvar serial-mode-line-speed-menu nil)
+(defvar serial-mode-line-config-menu nil)
+
+(defun serial-speed ()
+ "Return the speed of the serial port of the current buffer's process.
+The return value may be nil for a special serial port."
+ (process-contact (get-buffer-process (current-buffer)) :speed))
+
+(defun serial-mode-line-speed-menu-1 (event)
+ (interactive "e")
+ (save-selected-window
+ (select-window (posn-window (event-start event)))
+ (serial-update-speed-menu)
+ (let* ((selection (serial-mode-line-speed-menu event))
+ (binding (and selection (lookup-key serial-mode-line-speed-menu
+ (vector (car selection))))))
+ (when binding (call-interactively binding)))))
+
+(defun serial-mode-line-speed-menu (event)
+ (x-popup-menu event serial-mode-line-speed-menu))
+
+(defun serial-update-speed-menu ()
+ (setq serial-mode-line-speed-menu (make-sparse-keymap "Speed (b/s)"))
+ (define-key serial-mode-line-speed-menu [serial-mode-line-speed-menu-other]
+ '(menu-item "Other..."
+ (lambda (event) (interactive "e")
+ (let ((speed (serial-read-speed)))
+ (serial-process-configure :speed speed)
+ (term-update-mode-line)
+ (message "Speed set to %d b/s" speed)))))
+ (dolist (str (serial-nice-speed-history))
+ (let ((num (or (and (stringp str) (string-to-number str)) 0)))
+ (define-key
+ serial-mode-line-speed-menu
+ (vector (make-symbol (format "serial-mode-line-speed-menu-%s" str)))
+ `(menu-item
+ ,str
+ (lambda (event) (interactive "e")
+ (serial-process-configure :speed ,num)
+ (term-update-mode-line)
+ (message "Speed set to %d b/s" ,num))
+ :button (:toggle . (= (serial-speed) ,num)))))))
+
+(defun serial-mode-line-config-menu-1 (event)
+ (interactive "e")
+ (save-selected-window
+ (select-window (posn-window (event-start event)))
+ (serial-update-config-menu)
+ (let* ((selection (serial-mode-line-config-menu event))
+ (binding (and selection (lookup-key serial-mode-line-config-menu
+ (vector (car selection))))))
+ (when binding (call-interactively binding)))))
+
+(defun serial-mode-line-config-menu (event)
+ (x-popup-menu event serial-mode-line-config-menu))
+
+(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))
+ (dolist (y '((:flowcontrol hw "Hardware flowcontrol (RTS/CTS)")
+ (:flowcontrol sw "Software flowcontrol (XON/XOFF)")
+ (:flowcontrol nil "No flowcontrol")
+ (:stopbits 2 "2 stopbits")
+ (:stopbits 1 "1 stopbit")
+ (:parity odd "Odd parity")
+ (:parity even "Even parity")
+ (:parity nil "No parity")
+ (:bytesize 7 "7 bits per byte")
+ (:bytesize 8 "8 bits per byte")))
+ (define-key serial-mode-line-config-menu
+ (vector (make-symbol (format "%s-%s" (nth 0 y) (nth 1 y))))
+ `(menu-item
+ ,(nth 2 y)
+ (lambda (event) (interactive "e")
+ (serial-process-configure ,(nth 0 y) ',(nth 1 y))
+ (term-update-mode-line)
+ (message "%s" ,(nth 2 y)))
+ ;; Use :toggle instead of :radio because a non-standard port
+ ;; configuration may not match any menu items.
+ :button (:toggle . ,(equal (plist-get config (nth 0 y))
+ (nth 1 y))))))))
+
+\f
;;; Converting process modes to use term mode
;;; ===========================================================================
;;; Renaming variables
\f
(provide 'term)
-;;; arch-tag: eee16bc8-2cd7-4147-9534-a5694752f716
+;; arch-tag: eee16bc8-2cd7-4147-9534-a5694752f716
;;; term.el ends here
HCoop / bpt / emacs.git / blobdiff