;;; term.el --- general command interpreter in a window stuff
-;;; Copyright (C) 1988, 1990, 1992, 1994, 1995, 2004 Free Software Foundation, Inc.
+;; Copyright (C) 1988, 1990, 1992, 1994, 1995, 2001, 2002, 2003,
+;; 2004, 2005, 2006, 2007 Free Software Foundation, Inc.
-;; Author: Per Bothner <bothner@cygnus.com>
+;; Author: Per Bothner <per@bothner.com>
+;; Maintainer: Dan Nicolaescu <dann@ics.uci.edu>, Per Bothner <per@bothner.com>
;; Based on comint mode written by: Olin Shivers <shivers@cs.cmu.edu>
;; Keywords: processes
;; 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., 59 Temple Place - Suite 330,
-;; Boston, MA 02111-1307, USA.
+;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
+;; Boston, MA 02110-1301, USA.
;;; Marck 13 2001
;;; Fixes for CJK support by Yong Lu <lyongu@yahoo.com>.
(require 'ehelp)
(defgroup term nil
- "General command interpreter in a window"
+ "General command interpreter in a window."
:group 'processes
:group 'unix)
:group 'term)
(defvar term-prompt-regexp "^"
- "Regexp to recognise prompts in the inferior process.
+ "Regexp to recognize prompts in the inferior process.
Defaults to \"^\", the null string at BOL.
Good choices:
This is a good thing to set in mode hooks.")
(defvar term-delimiter-argument-list ()
- "List of characters to recognise as separate arguments in input.
+ "List of characters to recognize as separate arguments in input.
Strings comprising a character in this list will separate the arguments
surrounding them, and also be regarded as arguments in their own right (unlike
whitespace). See `term-arguments'.
"Function that submits old text in term mode.
This function is called when return is typed while the point is in old text.
It returns the text to be submitted as process input. The default is
-term-get-old-input-default, which grabs the current line, and strips off
-leading text matching term-prompt-regexp")
+`term-get-old-input-default', which grabs the current line, and strips off
+leading text matching `term-prompt-regexp'.")
(defvar term-dynamic-complete-functions
'(term-replace-by-expanded-history term-dynamic-complete-filename)
(function (lambda (str) (not (string-match "\\`\\s *\\'" str))))
"Predicate for filtering additions to input history.
Only inputs answering true to this function are saved on the input
-history list. Default is to save anything that isn't all whitespace")
+history list. Default is to save anything that isn't all whitespace.")
(defvar term-input-filter-functions '()
"Functions to call before input is sent to the process.
(defvar term-input-sender (function term-simple-send)
"Function to actually send to PROCESS the STRING submitted by user.
-Usually this is just 'term-simple-send, but if your mode needs to
+Usually this is just `term-simple-send', but if your mode needs to
massage the input string, this is your hook. This is called from
-the user command term-send-input. term-simple-send just sends
+the user command `term-send-input'. `term-simple-send' just sends
the string plus a newline.")
(defcustom term-eol-on-send t
:group 'term)
(defcustom term-mode-hook '()
- "Called upon entry into term-mode
+ "Called upon entry into term mode.
This is run before the process is cranked up."
:type 'hook
:group 'term)
(defcustom term-exec-hook '()
- "Called each time a process is exec'd by term-exec.
+ "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
+must be done each time a process is executed in a term mode buffer (e.g.,
+`process-kill-without-query'). In contrast, `term-mode-hook' is only
executed once when the buffer is created."
:type 'hook
:group 'term)
(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.")
+ "Escape character for char sub-mode of term mode.
+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.
(defvar term-ansi-at-save-user nil)
(defvar term-ansi-at-save-pwd nil)
(defvar term-ansi-at-save-anon nil)
-(defvar term-ansi-current-bold 0)
+(defvar term-ansi-current-bold nil)
(defvar term-ansi-current-color 0)
-(defvar term-ansi-face-already-done 0)
+(defvar term-ansi-face-already-done nil)
(defvar term-ansi-current-bg-color 0)
-(defvar term-ansi-current-underline 0)
-(defvar term-ansi-current-highlight 0)
-(defvar term-ansi-current-reverse 0)
-(defvar term-ansi-current-invisible 0)
+(defvar term-ansi-current-underline nil)
+(defvar term-ansi-current-reverse nil)
+(defvar term-ansi-current-invisible nil)
;;; Four should be enough, if you want more, just add. -mm
(defvar term-terminal-more-parameters 0)
:group 'term
:type 'string)
+;;; Use the same colors that xterm uses, see `xterm-standard-colors'.
(defvar ansi-term-color-vector
- [unspecified "black" "red" "green" "yellow" "blue"
- "magenta" "cyan" "white"])
+ [unspecified "black" "red3" "green3" "yellow3" "blue2"
+ "magenta3" "cyan3" "white"])
;;; Inspiration came from comint.el -mm
(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])))
-
-(if term-mode-map
- nil
+(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])))
+
+(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))
+ (unless (featurep '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)
)
;; Menu bars:
-(term-ifnot-xemacs
- (progn
-
+(unless (featurep 'xemacs)
;; terminal:
(let (newmap)
(setq newmap (make-sparse-keymap "Terminal"))
(define-key newmap [] '("BREAK" . term-interrupt-subjob))
(define-key term-mode-map [menu-bar signals]
(setq term-signals-menu (cons "Signals" newmap)))
- )))
+ ))
\f
;; Set up term-raw-map, etc.
(defun term-set-escape-char (c)
- "Change term-escape-char and keymaps that depend on it."
- (if term-escape-char
- (define-key term-raw-map term-escape-char 'term-send-raw))
+ "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
(i 0))
(while (< i 128)
(define-key map (make-string 1 i) 'term-send-raw)
- (define-key esc-map (make-string 1 i) 'term-send-raw-meta)
+ ;; Avoid O and [. They are used in escape sequences for various keys.
+ (unless (or (eq i ?O) (eq i 91))
+ (define-key esc-map (make-string 1 i) 'term-send-raw-meta))
(setq i (1+ i)))
(dolist (elm (generic-character-list))
(define-key map (vector elm) 'term-send-raw))
;;; Added nearly all the 'grey keys' -mm
- (progn
- (term-if-xemacs
- (define-key term-raw-map [button2] 'term-mouse-paste))
- (term-ifnot-xemacs
- (define-key term-raw-map [mouse-2] 'term-mouse-paste)
- (define-key term-raw-map [menu-bar terminal] term-terminal-menu)
- (define-key term-raw-map [menu-bar signals] term-signals-menu))
- (define-key term-raw-map [up] 'term-send-up)
- (define-key term-raw-map [down] 'term-send-down)
- (define-key term-raw-map [right] 'term-send-right)
- (define-key term-raw-map [left] 'term-send-left)
- (define-key term-raw-map [delete] 'term-send-del)
- (define-key term-raw-map [backspace] 'term-send-backspace)
- (define-key term-raw-map [home] 'term-send-home)
- (define-key term-raw-map [end] 'term-send-end)
- (define-key term-raw-map [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)
(make-display-table)))
i)
;; avoid changing the display table for ^J
- (setq i 0)
+ (setq i 0)
(while (< i 10)
(aset dt i (vector i))
(setq i (1+ i)))
- (setq i 11)
+ (setq i 11)
(while (< i 32)
(aset dt i (vector i))
(setq i (1+ i)))
There are two submodes: line mode and char mode. By default, you are
in char mode. In char sub-mode, each character (except
-`term-escape-char') is set immediately.
+`term-escape-char') is sent immediately to the subprocess.
+The escape character is equivalent to the usual meaning of C-x.
In line mode, you send a line of input at a time; use
\\[term-send-input] to send.
If you accidentally suspend your process, use \\[term-continue-subjob]
to continue it.
-This mode can be customised to create specific modes for running
+This mode can be customized to create specific modes for running
particular subprocesses. This can be done by setting the hooks
`term-input-filter-functions', `term-input-filter',
`term-input-sender' and `term-get-old-input' to appropriate functions,
(make-local-variable 'term-ansi-face-already-done)
(make-local-variable 'term-ansi-current-bg-color)
(make-local-variable 'term-ansi-current-underline)
- (make-local-variable 'term-ansi-current-highlight)
(make-local-variable 'term-ansi-current-reverse)
(make-local-variable 'term-ansi-current-invisible)
+ (make-local-variable 'term-terminal-parameter)
+ (make-local-variable 'term-terminal-previous-parameter)
+ (make-local-variable 'term-terminal-previous-parameter-2)
+ (make-local-variable 'term-terminal-previous-parameter-3)
+ (make-local-variable 'term-terminal-previous-parameter-4)
+ (make-local-variable 'term-terminal-more-parameters)
+
(make-local-variable 'term-terminal-state)
(make-local-variable 'term-kill-echo-list)
(make-local-variable 'term-start-line-column)
(make-local-variable 'term-current-face)
(make-local-variable 'term-pending-frame)
(setq term-pending-frame nil)
- (run-hooks 'term-mode-hook)
- (term-if-xemacs
- (set-buffer-menubar
- (append current-menubar (list term-terminal-menu))))
+ ;; Cua-mode's keybindings interfere with the term keybindings, disable it.
+ (set (make-local-variable 'cua-mode) nil)
+ (run-mode-hooks 'term-mode-hook)
+ (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 term-current-row nil)
(setq term-current-column nil)
- (term-scroll-region 0 height))
+ (term-set-scroll-region 0 height))
;; Recursive routine used to check if any string in term-kill-echo-list
;; matches part of the buffer before point.
(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."
;; Which would be better: "\e[A" or "\eOA"? readline accepts either.
;; For my configuration it's definitely better \eOA but YMMV. -mm
;; For example: vi works with \eOA while elm wants \e[A ...
+;;; (terminfo: kcuu1, kcud1, kcuf1, kcub1, khome, kend, kpp, knp, kdch1, kbs)
(defun term-send-up () (interactive) (term-send-raw-string "\eOA"))
(defun term-send-down () (interactive) (term-send-raw-string "\eOB"))
(defun term-send-right () (interactive) (term-send-raw-string "\eOC"))
(defun term-send-left () (interactive) (term-send-raw-string "\eOD"))
(defun term-send-home () (interactive) (term-send-raw-string "\e[1~"))
+(defun term-send-insert() (interactive) (term-send-raw-string "\e[2~"))
(defun term-send-end () (interactive) (term-send-raw-string "\e[4~"))
(defun term-send-prior () (interactive) (term-send-raw-string "\e[5~"))
(defun term-send-next () (interactive) (term-send-raw-string "\e[6~"))
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
(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"
+name of one."
(let ((proc (get-buffer-process buffer)))
(and proc (memq (process-status proc) '(run stop)))))
"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.
;;; Using "emacs" loses, because bash disables editing if TERM == emacs.
-(defvar term-term-name "eterm")
+(defvar term-term-name "eterm-color")
; Format string, usage:
; (format term-termcap-string emacs-term-name "TERMCAP=" 24 80)
(defvar term-termcap-format
:UP=\\E[%%dA:DO=\\E[%%dB:LE=\\E[%%dD:RI=\\E[%%dC\
:kl=\\EOD:kd=\\EOB:kr=\\EOC:ku=\\EOA:kN=\\E[6~:kP=\\E[5~:@7=\\E[4~:kh=\\E[1~\
:mk=\\E[8m:cb=\\E[1K:op=\\E[39;49m:Co#8:pa#64:AB=\\E[4%%dm:AF=\\E[3%%dm:cr=^M\
-:bl=^G:do=^J:le=^H:ta=^I:se=\E[27m:ue=\E24m\
-:kb=^?:kD=^[[3~:sc=\E7:rc=\E8:"
+:bl=^G:do=^J:le=^H:ta=^I:se=\\E[27m:ue=\\E24m\
+: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))
(sit-for 0)
(message "Hit space to flush")
(let ((ch (read-event)))
- (if (eq ch ?\ )
+ (if (eq ch ?\s)
(set-window-configuration conf)
(setq unread-command-events (list ch)))))))
"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 ()
(defun term-simple-send (proc string)
"Default function for sending to PROC input STRING.
This just sends STRING plus a newline. To override this,
-set the hook TERM-INPUT-SENDER."
+set the hook `term-input-sender'."
(term-send-string proc string)
(term-send-string proc "\n"))
-- 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)))
If your process is choking on big inputs, try lowering the value.")
(defun term-send-string (proc str)
- "Send PROCESS the contents of STRING 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
+ "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
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))
(setq i next-i)))))
(defun term-send-region (proc start end)
- "Sends to PROC the region delimited by START and END.
-This is a replacement for process-send-region that tries to keep
-your process from hanging on long inputs. See term-send-string."
+ "Send to PROC the region delimited by START and END.
+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)))
\f
(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)
;;; This is pretty stupid about strings. It decides we're in a string
;;; if there's a quote on both sides of point on the current line.
(defun term-extract-string ()
- "Returns string around POINT that starts the current line or nil."
+ "Return string around `point' that starts the current line or nil."
(save-excursion
(let* ((point (point))
(bol (progn (beginning-of-line) (point)))
;; 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-horizontal-column ()
(- (term-current-column) (term-start-line-column)))
-;; Calls either vertical-motion or buffer-vertical-motion
+;; Calls either vertical-motion or term-buffer-vertical-motion
(defmacro term-vertical-motion (count)
(list 'funcall 'term-vertical-motion count))
;; An emulation of vertical-motion that is independent of having a window.
;; Instead, it uses the term-width variable as the logical window width.
-(defun buffer-vertical-motion (count)
+(defun term-buffer-vertical-motion (count)
(cond ((= count 0)
(move-to-column (* term-width (/ (current-column) term-width)))
0)
(defun term-move-columns (delta)
(setq term-current-column (max 0 (+ (term-current-column) delta)))
- (move-to-column term-current-column t))
+ (let (point-at-eol)
+ (save-excursion
+ (end-of-line)
+ (setq point-at-eol (point)))
+ (move-to-column term-current-column t)
+ ;; If move-to-column extends the current line it will use the face
+ ;; from the last character on the line, set the face for the chars
+ ;; to default.
+ (when (> (point) point-at-eol)
+ (put-text-property point-at-eol (point) 'face 'default))))
;; Insert COUNT copies of CHAR in the default face.
(defun term-insert-char (char count)
(defun term-adjust-current-row-cache (delta)
(when term-current-row
- (setq term-current-row
+ (setq term-current-row
(max 0 (+ term-current-row delta)))))
(defun term-terminal-pos ()
(buffer-undo-list t)
(selected (selected-window))
last-win
+ handled-ansi-message
(str-length (length str)))
(save-selected-window
;; Let's handle the messages. -mm
- (setq str (term-handle-ansi-terminal-messages str))
- (setq str-length (length str))
+ (let* ((newstr (term-handle-ansi-terminal-messages str)))
+ (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 term-vertical-motion (symbol-function 'vertical-motion))
(term-check-size proc))
(setq term-vertical-motion
- (symbol-function 'buffer-vertical-motion)))
+ (symbol-function 'term-buffer-vertical-motion)))
(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)
(cond ((eq term-terminal-state 1)
;; We are in state 1, we need to wrap
;; around. Go to the beginning of
;; the next line and switch to state
;; 0.
- (term-down 1)
+ (term-down 1 t)
(term-move-columns (- (term-current-column)))
(setq term-terminal-state 0)))
(setq count (- funny i))
(setq pos (point))
(term-move-columns columns)
(delete-region pos (point)))
- ;; In insert if the if the current line
+ ;; In insert mode if the current line
;; has become too long it needs to be
;; chopped off.
- (when term-insert-mode
+ (when term-insert-mode
(setq pos (point))
(end-of-line)
(when (> (current-column) term-width)
- (delete-region (- (point) (- (current-column) term-width))
+ (delete-region (- (point) (- (current-column) term-width))
(point)))
(goto-char pos)))
(setq term-current-column nil)
(setq count (term-current-column))
;; The line cannot exceed term-width. TAB at
;; the end of a line should not cause wrapping.
- (setq count (min term-width
+ (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
+ (term-move-columns
(1- (- term-width (term-current-column)))))
(when (= term-width (term-current-column))
(term-move-columns -1))))
- ((eq char ?\r)
- ;; Optimize CRLF at end of buffer:
- (cond ((and (< (setq temp (1+ i)) str-length)
- (eq (aref str temp) ?\n)
- (= (point) (point-max))
- (not (or term-pager-count
- term-kill-echo-list
- term-scroll-with-delete)))
- (insert ?\n)
- (term-adjust-current-row-cache 1)
- (setq term-start-line-column 0)
- (setq term-current-column 0)
- (setq i temp))
- (t ;; Not followed by LF or can't optimize:
- (term-vertical-motion 0)
- (setq term-current-column term-start-line-column))))
- ((eq char ?\n)
- (if (not (and term-kill-echo-list
- (term-check-kill-echo-list)))
- (term-down 1 t)))
+ ((eq char ?\r) ;; (terminfo: cr)
+ (term-vertical-motion 0)
+ (setq term-current-column term-start-line-column))
+ ((eq char ?\n) ;; (terminfo: cud1, ind)
+ (unless (and term-kill-echo-list
+ (term-check-kill-echo-list))
+ (term-down 1 t)))
((eq char ?\b) ;; (terminfo: cub1)
(term-move-columns -1))
((eq char ?\033) ; Escape
((eq char 0)) ; NUL: Do nothing
((eq char ?\016)) ; Shift Out - ignored
((eq char ?\017)) ; Shift In - ignored
- ((eq char ?\^G)
- (beep t)) ; Bell
- ((eq char ?\032)
+ ((eq char ?\^G) ;; (terminfo: bel)
+ (beep t))
+ ((and (eq char ?\032)
+ (not handled-ansi-message))
(let ((end (string-match "\r?$" str i)))
(if end
(funcall term-command-hook
(prog1 (substring str (1+ i) end)
(setq i (match-end 0))))
- (setq term-terminal-parameter
- (substring str i))
+ (setq term-terminal-parameter (substring str i))
(setq term-terminal-state 4)
(setq i str-length))))
(t ; insert char FIXME: Should never happen
;;; Note that now the init value of term-terminal-previous-parameter has
;;; been changed to -1
- (make-local-variable 'term-terminal-parameter)
- (make-local-variable 'term-terminal-previous-parameter)
- (make-local-variable 'term-terminal-previous-parameter-2)
- (make-local-variable 'term-terminal-previous-parameter-3)
- (make-local-variable 'term-terminal-previous-parameter-4)
- (make-local-variable 'term-terminal-more-parameters)
(setq term-terminal-parameter 0)
(setq term-terminal-previous-parameter -1)
(setq term-terminal-previous-parameter-2 -1)
;; (term-goto term-current-row 0)
;; (setq term-terminal-state 0))
((eq char ?M) ;; scroll reversed (terminfo: ri)
- (term-down -1)
+ (if (or (< (term-current-row) term-scroll-start)
+ (>= (1- (term-current-row))
+ term-scroll-start))
+ ;; Scrolling up will not move outside
+ ;; the scroll region.
+ (term-down -1)
+ ;; Scrolling the scroll region is needed.
+ (term-down -1 t))
(setq term-terminal-state 0))
((eq char ?7) ;; Save cursor (terminfo: sc)
(term-handle-deferred-scroll)
(setq term-saved-cursor
- (cons (term-current-row)
- (term-horizontal-column)))
+ (list (term-current-row)
+ (term-horizontal-column)
+ term-ansi-current-bg-color
+ term-ansi-current-bold
+ term-ansi-current-color
+ term-ansi-current-invisible
+ term-ansi-current-reverse
+ term-ansi-current-underline
+ term-current-face)
+ )
(setq term-terminal-state 0))
((eq char ?8) ;; Restore cursor (terminfo: rc)
- (if term-saved-cursor
- (term-goto (car term-saved-cursor)
- (cdr term-saved-cursor)))
+ (when term-saved-cursor
+ (term-goto (nth 0 term-saved-cursor)
+ (nth 1 term-saved-cursor))
+ (setq term-ansi-current-bg-color
+ (nth 2 term-saved-cursor)
+ term-ansi-current-bold
+ (nth 3 term-saved-cursor)
+ term-ansi-current-color
+ (nth 4 term-saved-cursor)
+ term-ansi-current-invisible
+ (nth 5 term-saved-cursor)
+ term-ansi-current-reverse
+ (nth 6 term-saved-cursor)
+ term-ansi-current-underline
+ (nth 7 term-saved-cursor)
+ term-current-face
+ (nth 8 term-saved-cursor)))
(setq term-terminal-state 0))
+ ((eq char ?c) ;; \Ec - Reset (terminfo: rs1)
+ ;; This is used by the "clear" program.
+ (setq term-terminal-state 0)
+ (term-reset-terminal))
;; The \E#8 reset sequence for xterm. We
;; probably don't need to handle it, but this
;; is the code to parse it.
;; ((eq char ?#)
;; (when (eq (aref str (1+ i)) ?8)
;; (setq i (1+ i))
+ ;; (setq term-scroll-start 0)
+ ;; (setq term-scroll-end term-height)
;; (setq term-terminal-state 0)))
((setq term-terminal-state 0))))
((eq term-terminal-state 3) ; Seen Esc [
(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))))
-;;;
-
+ (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)))))
(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.
+(defun term-reset-terminal ()
+ (erase-buffer)
+ (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 nil)
+ (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))
;;; New function to deal with ansi colorized output, as you can see you can
;;; have any bold/underline/fg/bg/reverse combination. -mm
(defun term-handle-colors-array (parameter)
(cond
-;;; Bold
+;;; Bold (terminfo: bold)
((eq parameter 1)
- (setq term-ansi-current-bold 1))
+ (setq term-ansi-current-bold t))
;;; Underline
((eq parameter 4)
- (setq term-ansi-current-underline 1))
+ (setq term-ansi-current-underline t))
;;; 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))
+ (setq term-ansi-current-bold t))
-;;; Reverse
+;;; Reverse (terminfo: smso)
((eq parameter 7)
- (setq term-ansi-current-reverse 1))
+ (setq term-ansi-current-reverse t))
;;; Invisible
((eq parameter 8)
- (setq term-ansi-current-invisible 1))
+ (setq term-ansi-current-invisible t))
-;;; Reset underline (i.e. terminfo rmul)
+;;; Reset underline (terminfo: rmul)
((eq parameter 24)
- (setq term-ansi-current-underline 0))
+ (setq term-ansi-current-underline nil))
-;;; Reset reverse (i.e. terminfo rmso)
+;;; Reset reverse (terminfo: rmso)
((eq parameter 27)
- (setq term-ansi-current-reverse 0))
+ (setq term-ansi-current-reverse nil))
;;; Foreground
((and (>= parameter 30) (<= parameter 37))
;;; 0 (Reset) or unknown (reset anyway)
(t
(setq term-current-face nil)
- (setq term-ansi-current-underline 0)
- (setq term-ansi-current-bold 0)
- (setq term-ansi-current-reverse 0)
+ (setq term-ansi-current-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 0)
- (setq term-ansi-face-already-done 1)
+ (setq term-ansi-current-invisible nil)
+ (setq term-ansi-face-already-done t)
(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-bg-color)
- (if (= term-ansi-face-already-done 0)
- (if (= term-ansi-current-reverse 1)
- (if (= term-ansi-current-invisible 1)
+ (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
(list :background
(if (= term-ansi-current-color 0)
(face-foreground 'default)
- (elt ansi-term-color-vector term-ansi-current-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))))
- (if (= term-ansi-current-bold 1)
- (setq term-current-face
- (append '(:weight bold) term-current-face)))
- (if (= term-ansi-current-underline 1)
- (setq term-current-face
- (append '(:underline t) term-current-face))))
- (if (= term-ansi-current-invisible 1)
+ (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
(elt ansi-term-color-vector term-ansi-current-color)
:background
(elt ansi-term-color-vector term-ansi-current-bg-color)))
- (if (= term-ansi-current-bold 1)
- (setq term-current-face
- (append '(:weight bold) term-current-face)))
- (if (= term-ansi-current-underline 1)
- (setq term-current-face
- (append '(:underline t) term-current-face))))))
+ (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))))))
;;; (message "Debug %S" term-current-face)
- (setq term-ansi-face-already-done 0))
+ (setq term-ansi-face-already-done nil))
;;; Handle a character assuming (eq terminal-state 2) -
(defun term-handle-ansi-escape (proc char)
(cond
- ((or (eq char ?H) ; cursor motion (terminfo: cup)
- ;; (eq char ?f) ; xterm seems to handle this sequence too, not
+ ((or (eq char ?H) ;; cursor motion (terminfo: cup,home)
+ ;; (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)))
;; \E[A - cursor up (terminfo: cuu, cuu1)
((eq char ?A)
(term-handle-deferred-scroll)
- (term-down (- (max 1 term-terminal-parameter)) t))
+ (let ((tcr (term-current-row)))
+ (term-down
+ (if (< (- tcr term-terminal-parameter) term-scroll-start)
+ ;; If the amount to move is before scroll start, move
+ ;; to scroll start.
+ (- term-scroll-start tcr)
+ (if (>= term-terminal-parameter tcr)
+ (- tcr)
+ (- (max 1 term-terminal-parameter)))) t)))
;; \E[B - cursor down (terminfo: cud)
((eq char ?B)
- (term-down (max 1 term-terminal-parameter) t))
- ;; \E[C - cursor right (terminfo: cuf)
+ (let ((tcr (term-current-row)))
+ (unless (= tcr (1- term-scroll-end))
+ (term-down
+ (if (> (+ tcr term-terminal-parameter) term-scroll-end)
+ (- term-scroll-end 1 tcr)
+ (max 1 term-terminal-parameter)) t))))
+ ;; \E[C - cursor right (terminfo: cuf, cuf1)
((eq char ?C)
- (term-move-columns
- (max 1
+ (term-move-columns
+ (max 1
(if (>= (+ term-terminal-parameter (term-current-column)) term-width)
(- term-width (term-current-column) 1)
term-terminal-parameter))))
;; \E[L - insert lines (terminfo: il, il1)
((eq char ?L)
(term-insert-lines (max 1 term-terminal-parameter)))
- ;; \E[M - delete lines
+ ;; \E[M - delete lines (terminfo: dl, dl1)
((eq char ?M)
(term-delete-lines (max 1 term-terminal-parameter)))
- ;; \E[P - delete chars
+ ;; \E[P - delete chars (terminfo: dch, dch1)
((eq char ?P)
(term-delete-chars (max 1 term-terminal-parameter)))
- ;; \E[@ - insert spaces
+ ;; \E[@ - insert spaces (terminfo: ich)
((eq char ?@)
(term-insert-spaces (max 1 term-terminal-parameter)))
;; \E[?h - DEC Private Mode Set
))
;;; Modified to allow ansi coloring -mm
- ;; \E[m - Set/reset modes, set bg/fg
+ ;; \E[m - Set/reset modes, set bg/fg
;;(terminfo: smso,rmso,smul,rmul,rev,bold,sgr0,invis,op,setab,setaf)
((eq char ?m)
(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))
+ (when (>= term-terminal-previous-parameter-4 0)
+ (term-handle-colors-array term-terminal-previous-parameter-4))
+ (when (>= term-terminal-previous-parameter-3 0)
+ (term-handle-colors-array term-terminal-previous-parameter-3))
+ (when (>= 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))
(format "\e[%s;%sR"
(1+ (term-current-row))
(1+ (term-horizontal-column)))))
- ;; \E[r - Set scrolling region
- ((eq char ?r) ;; (terminfo: csr)
- (term-scroll-region
+ ;; \E[r - Set scrolling region (terminfo: csr)
+ ((eq char ?r)
+ (term-set-scroll-region
(1- term-terminal-previous-parameter)
- term-terminal-parameter))
+ (1- term-terminal-parameter)))
(t)))
-(defun term-scroll-region (top bottom)
+(defun term-set-scroll-region (top bottom)
"Set scrolling region.
TOP is the top-most line (inclusive) of the new scrolling region,
while BOTTOM is the line following the new scrolling region (e.g. exclusive).
(not (and (= term-scroll-start 0)
(= term-scroll-end term-height)))))
(term-move-columns (- (term-current-column)))
- (term-goto
- term-scroll-start (term-current-column)))
+ (term-goto 0 0))
;; (defun term-switch-to-alternate-sub-buffer (set)
;; ;; If asked to switch to (from) the alternate sub-buffer, and already (not)
(second-colon
(string-match ":" string (1+ first-colon)))
(filename (substring string 1 first-colon))
- (fileline (string-to-int
+ (fileline (string-to-number
(substring string (1+ first-colon) second-colon))))
(setq term-pending-frame (cons filename fileline))))
((= (aref string 0) ?/)
; 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))
- ))
-
- (setq term-pager-break-map map)))
+ (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)))
; (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 1) term-scroll-end)))
- (if (> scroll-needed 0)
- (let ((save-point (copy-marker (point))) (save-top))
- (goto-char term-home-marker)
- (cond (term-scroll-with-delete
- ;; delete scroll-needed lines at term-scroll-start
+ (- (+ (term-current-row) down)
+ (if (< down 0) term-scroll-start term-scroll-end))))
+ (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)
(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 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))))
+ (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)
"Move down DOWN screen lines vertically."
(let ((start-column (term-horizontal-column)))
- (if (and check-for-scroll (or term-scroll-with-delete term-pager-count))
- (setq down (term-handle-scroll down)))
- (term-adjust-current-row-cache down)
- (if (or (/= (point) (point-max)) (< down 0))
- (setq down (- down (term-vertical-motion down))))
- ;; Extend buffer with extra blank lines if needed.
- (cond ((> down 0)
+ (when (and check-for-scroll (or term-scroll-with-delete term-pager-count))
+ (setq down (term-handle-scroll down)))
+ (unless (and (= term-current-row 0) (< down 0))
+ (term-adjust-current-row-cache down)
+ (when (or (/= (point) (point-max)) (< down 0))
+ (setq down (- down (term-vertical-motion down)))))
+ (cond ((>= down 0)
+ ;; Extend buffer with extra blank lines if needed.
(term-insert-char ?\n down)
(setq term-current-column 0)
(setq term-start-line-column 0))
(t
- (setq term-current-column nil)
+ (when (= term-current-row 0)
+ ;; Insert lines if at the beginning.
+ (save-excursion (term-insert-char ?\n (- down)))
+ (save-excursion
+ (let (p)
+ ;; Delete lines from the end.
+ (forward-line term-height)
+ (setq p (point))
+ (forward-line (- down))
+ (delete-region p (point)))))
+ (setq term-current-column 0)
(setq term-start-line-column (current-column))))
- (if start-column
- (term-move-columns start-column))))
+ (when start-column
+ (term-move-columns start-column))))
;; Assuming point is at the beginning of a screen line,
;; 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.
;;; Insert COUNT spaces after point, but do not change any of
;;; following screen lines. Hence we may have to delete characters
-;;; at teh end of this screen line to make room.
+;;; at the end of this screen line to make room.
(defun term-insert-spaces (count)
- (let ((save-point (point)) (save-eol))
+ (let ((save-point (point)) (save-eol) (pnt-at-eol))
(term-vertical-motion 1)
- (if (bolp)
- (backward-char))
+ (when (bolp)
+ (backward-char))
(setq save-eol (point))
+ (save-excursion
+ (end-of-line)
+ (setq pnt-at-eol (point)))
(move-to-column (+ (term-start-line-column) (- term-width count)) t)
- (if (> save-eol (point))
- (delete-region (point) save-eol))
+ ;; If move-to-column extends the current line it will use the face
+ ;; from the last character on the line, set the face for the chars
+ ;; to default.
+ (when (>= (point) pnt-at-eol)
+ (put-text-property pnt-at-eol (point) 'face 'default))
+ (when (> save-eol (point))
+ (delete-region (point) save-eol))
(goto-char save-point)
(term-insert-char ? count)
(goto-char save-point)))
(save-current-column term-current-column)
(save-start-line-column term-start-line-column)
(save-current-row (term-current-row)))
+ ;; 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-current-column term-current-column)
(save-start-line-column term-start-line-column)
(save-current-row (term-current-row)))
- (term-down (- term-scroll-end save-current-row lines))
+ ;; 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
+ (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) (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))
(defun term-word (word-chars)
- "Return the word of WORD-CHARS at point, or nil if non is found.
+ "Return the word of WORD-CHARS at point, or nil if none is found.
Word constituents are considered to be those in WORD-CHARS, which is like the
inside of a \"[...]\" (see `skip-chars-forward')."
(save-excursion
(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
(defun term-match-partial-filename ()
- "Return the filename at point, or nil if non is found.
+ "Return the filename at point, or nil if none is found.
Environment variables are substituted. See `term-word'."
(let ((filename (term-word "~/A-Za-z0-9+@:_.$#,={}-")))
(and filename (substitute-in-file-name filename))))
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))
(defun term-replace-by-expanded-filename ()
"Dynamically expand and complete the filename at point.
-Replace the filename with an expanded, canonicalised and completed replacement.
+Replace the filename with an expanded, canonicalized and completed replacement.
\"Expanded\" means environment variables (e.g., $HOME) and `~'s are replaced
-with the corresponding directories. \"Canonicalised\" means `..' and `.' are
+with the corresponding directories. \"Canonicalized\" means `..' and `.' are
removed, and the filename is made absolute instead of relative. For expansion
see `expand-file-name' and `substitute-in-file-name'. For completion see
`term-dynamic-complete-filename'."
(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)))
(progn
(mouse-choose-completion first)
(set-window-configuration conf))
- (if (eq first ?\ )
+ (if (eq first ?\s)
(set-window-configuration conf)
(setq unread-command-events (listify-key-sequence key)))))))
;;; (make-local-variable 'shell-directory-stack)
;;; (setq shell-directory-stack nil)
;;; (add-hook 'term-input-filter-functions 'shell-directory-tracker)
-;;; (run-hooks 'shell-mode-hook))
+;;; (run-mode-hooks 'shell-mode-hook))
;;;
;;;
;;; Completion for term-mode users