term.el 127 KB
Newer Older
Richard M. Stallman's avatar
Richard M. Stallman committed
1 2
;;; term.el --- general command interpreter in a window stuff

3
;; Copyright (C) 1988, 1990, 1992, 1994, 1995 Free Software Foundation, Inc.
Richard M. Stallman's avatar
Richard M. Stallman committed
4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21

;; Author: Per Bothner <bothner@cygnus.com>
;; Based on comint mode written by: Olin Shivers <shivers@cs.cmu.edu>
;; Keyword: processes

;; This file is part of GNU Emacs.

;; 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.

;; GNU Emacs is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
;; GNU General Public License for more details.

;; You should have received a copy of the GNU General Public License
Erik Naggum's avatar
Erik Naggum committed
22 23 24
;; 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.
Richard M. Stallman's avatar
Richard M. Stallman committed
25 26 27

;;; Commentary:

Erik Naggum's avatar
Erik Naggum committed
28
;; The changelog is at the end of this file.
Richard M. Stallman's avatar
Richard M. Stallman committed
29

Erik Naggum's avatar
Erik Naggum committed
30 31 32
;; Please send me bug reports, bug fixes, and extensions, so that I can
;; merge them into the master source.
;;     - Per Bothner (bothner@cygnus.com)
Richard M. Stallman's avatar
Richard M. Stallman committed
33

Erik Naggum's avatar
Erik Naggum committed
34 35 36 37 38 39
;; This file defines a general command-interpreter-in-a-buffer package
;; (term mode). The idea is that you can build specific process-in-a-buffer
;; modes on top of term mode -- e.g., lisp, shell, scheme, T, soar, ....
;; This way, all these specific packages share a common base functionality, 
;; and a common set of bindings, which makes them easier to use (and
;; saves code, implementation time, etc., etc.).
Richard M. Stallman's avatar
Richard M. Stallman committed
40

Erik Naggum's avatar
Erik Naggum committed
41 42 43
;; For hints on converting existing process modes (e.g., tex-mode,
;; background, dbx, gdb, kermit, prolog, telnet) to use term-mode
;; instead of shell-mode, see the notes at the end of this file.
Richard M. Stallman's avatar
Richard M. Stallman committed
44 45


Erik Naggum's avatar
Erik Naggum committed
46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86
;; Brief Command Documentation:
;;============================================================================
;; Term Mode Commands: (common to all derived modes, like cmushell & cmulisp
;; mode)
;;
;; m-p	    term-previous-input    	  Cycle backwards in input history
;; m-n	    term-next-input  	    	  Cycle forwards
;; m-r     term-previous-matching-input  Previous input matching a regexp
;; m-s     comint-next-matching-input      Next input that matches
;; return  term-send-input
;; c-c c-a term-bol                      Beginning of line; skip prompt.
;; c-d	    term-delchar-or-maybe-eof     Delete char unless at end of buff.
;; c-c c-u term-kill-input	    	    ^u
;; c-c c-w backward-kill-word    	    ^w
;; c-c c-c term-interrupt-subjob 	    ^c
;; c-c c-z term-stop-subjob	    	    ^z
;; c-c c-\ term-quit-subjob	    	    ^\
;; c-c c-o term-kill-output		    Delete last batch of process output
;; c-c c-r term-show-output		    Show last batch of process output
;; c-c c-h term-dynamic-list-input-ring  List input history
;;
;; Not bound by default in term-mode
;; term-send-invisible			Read a line w/o echo, and send to proc
;; (These are bound in shell-mode)
;; term-dynamic-complete		Complete filename at point.
;; term-dynamic-list-completions	List completions in help buffer.
;; term-replace-by-expanded-filename	Expand and complete filename at point;
;;					replace with expanded/completed name.
;; term-kill-subjob			No mercy.
;; term-show-maximum-output            Show as much output as possible.
;; term-continue-subjob		Send CONT signal to buffer's process
;;					group. Useful if you accidentally
;;					suspend your process (with C-c C-z).

;; term-mode-hook is the term mode hook. Basically for your keybindings.
;; term-load-hook is run after loading in this package.

;; Code:

;; This is passed to the inferior in the EMACS environment variable,
;; so it is important to increase it if there are protocol-relevant changes.
87
(defconst term-protocol-version "0.95")
Richard M. Stallman's avatar
Richard M. Stallman committed
88 89 90 91 92 93 94 95 96 97 98

(require 'ring)
(require 'ehelp)

;;; Buffer Local Variables:
;;;============================================================================
;;; Term mode buffer local variables:
;;;     term-prompt-regexp    - string       term-bol uses to match prompt.
;;;     term-delimiter-argument-list - list  For delimiters and arguments
;;;     term-last-input-start - marker       Handy if inferior always echoes
;;;     term-last-input-end   - marker       For term-kill-output command
99 100 101 102
;; For the input history mechanism:
(defvar term-input-ring-size 32 "Size of input history ring.")
;;;     term-input-ring-size  - integer
;;;     term-input-ring       - ring
Richard M. Stallman's avatar
Richard M. Stallman committed
103 104 105 106 107 108 109 110 111 112 113 114
;;;     term-input-ring-index - number           ...
;;;     term-input-autoexpand - symbol           ...
;;;     term-input-ignoredups - boolean          ...
;;;     term-last-input-match - string           ...
;;;     term-dynamic-complete-functions - hook   For the completion mechanism
;;;     term-completion-fignore - list           ...
;;;     term-get-old-input    - function     Hooks for specific 
;;;     term-input-filter-functions - hook     process-in-a-buffer
;;;     term-input-filter     - function         modes.
;;;     term-input-send	- function
;;;     term-scroll-to-bottom-on-output - symbol ...
;;;     term-scroll-show-maximum-output - boolean...
115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152
(defvar term-height) ;; Number of lines in window.
(defvar term-width) ;; Number of columns in window.
(defvar term-home-marker) ;; Marks the "home" position for cursor addressing.
(defvar term-saved-home-marker nil) ;; When using alternate sub-buffer,
;;		contains saved term-home-marker from original sub-buffer .
(defvar term-start-line-column 0) ;; (current-column) at start of screen line,
;;		or nil if unknown.
(defvar term-current-column 0) ;; If non-nil, is cache for (current-column).
(defvar term-current-row 0) ;; Current vertical row (relative to home-marker)
;;		or nil if unknown.
(defvar term-insert-mode nil)
(defvar term-vertical-motion)
(defvar term-terminal-state 0) ;; State of the terminal emulator:
;;		state 0: Normal state
;;		state 1: Last character was a graphic in the last column.
;;		If next char is graphic, first move one column right
;;		(and line warp) before displaying it.
;;		This emulates (more or less) the behavior of xterm.
;;		state 2: seen ESC
;;		state 3: seen ESC [ (or ESC [ ?)
;;		state 4: term-terminal-parameter contains pending output.
(defvar term-kill-echo-list nil) ;; A queue of strings whose echo
;;		we want suppressed.
(defvar term-terminal-parameter)
(defvar term-terminal-previous-parameter)
(defvar term-current-face 'default)
(defvar term-scroll-start 0) ;; Top-most line (inclusive) of scrolling region.
(defvar term-scroll-end) ;; Number of line (zero-based) after scrolling region.
(defvar term-pager-count nil) ;; If nil, paging is disabled.
;;		Otherwise, number of lines before we need to page.
(defvar term-saved-cursor nil)
(defvar term-command-hook)
(defvar term-log-buffer nil)
(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
;;		(non-default) scroll-region OR the alternate buffer is used.
153 154 155
(defvar term-pending-delete-marker) ;; New user input in line mode needs to
;;		be deleted, because it gets echoed by the inferior.
;;		To reduce flicker, we defer the delete until the next output.
156 157 158 159
(defvar term-old-mode-map nil) ;; Saves the old keymap when in char mode.
(defvar term-old-mode-line-format) ;; Saves old mode-line-format while paging.
(defvar term-pager-old-local-map nil) ;; Saves old keymap while paging.
(defvar term-pager-old-filter) ;; Saved process-filter while paging.
Richard M. Stallman's avatar
Richard M. Stallman committed
160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179 180 181 182 183 184 185 186 187 188 189 190 191 192 193 194 195 196 197 198 199 200 201 202 203 204 205 206 207 208 209 210 211 212 213 214 215 216 217 218 219 220 221 222 223 224 225 226 227 228 229 230 231 232 233 234 235 236 237 238 239 240 241 242 243 244 245 246 247 248 249 250 251 252 253 254 255 256 257 258 259 260 261 262 263 264 265 266 267 268 269

(defvar explicit-shell-file-name nil
  "*If non-nil, is file name to use for explicitly requested inferior shell.")

(defvar term-prompt-regexp "^"
  "Regexp to recognise prompts in the inferior process.
Defaults to \"^\", the null string at BOL.

Good choices:
  Canonical Lisp: \"^[^> \\n]*>+:? *\" (Lucid, franz, kcl, T, cscheme, oaklisp)
  Lucid Common Lisp: \"^\\\\(>\\\\|\\\\(->\\\\)+\\\\) *\"
  franz: \"^\\\\(->\\\\|<[0-9]*>:\\\\) *\"
  kcl: \"^>+ *\"
  shell: \"^[^#$%>\\n]*[#$%>] *\"
  T: \"^>+ *\"

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.
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'.
Defaults to the empty list.

For shells, a good value is (?\\| ?& ?< ?> ?\\( ?\\) ?;).

This is a good thing to set in mode hooks.")

(defvar term-input-autoexpand nil
  "*If non-nil, expand input command history references on completion.
This mirrors the optional behavior of tcsh (its autoexpand and histlit).

If the value is `input', then the expansion is seen on input.
If the value is `history', then the expansion is only when inserting
into the buffer's input ring.  See also `term-magic-space' and
`term-dynamic-complete'.

This variable is buffer-local.")

(defvar term-input-ignoredups nil
  "*If non-nil, don't add input matching the last on the input ring.
This mirrors the optional behavior of bash.

This variable is buffer-local.")

(defvar term-input-ring-file-name nil
  "*If non-nil, name of the file to read/write input history.
See also `term-read-input-ring' and `term-write-input-ring'.

This variable is buffer-local, and is a good thing to set in mode hooks.")

(defvar term-scroll-to-bottom-on-output nil
  "*Controls whether interpreter output causes window to scroll.
If nil, then do not scroll.  If t or `all', scroll all windows showing buffer.
If `this', scroll only the selected window.
If `others', scroll only those that are not the selected window.

The default is nil.

See variable `term-scroll-show-maximum-output'.
This variable is buffer-local.")

(defvar term-scroll-show-maximum-output nil
  "*Controls how interpreter output causes window to scroll.
If non-nil, then show the maximum output when the window is scrolled.

See variable `term-scroll-to-bottom-on-output'.
This variable is buffer-local.")

;; Where gud-display-frame should put the debugging arrow.  This is
;; set by the marker-filter, which scans the debugger's output for
;; indications of the current pc.
(defvar term-pending-frame nil)

;;; Here are the per-interpreter hooks.
(defvar term-get-old-input (function term-get-old-input-default)
  "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")

(defvar term-dynamic-complete-functions
  '(term-replace-by-expanded-history term-dynamic-complete-filename)
  "List of functions called to perform completion.
Functions should return non-nil if completion was performed.
See also `term-dynamic-complete'.

This is a good thing to set in mode hooks.")

(defvar term-input-filter
  (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")

(defvar term-input-filter-functions '()
  "Functions to call before input is sent to the process.
These functions get one argument, a string containing the text to send.

This variable is buffer-local.")

(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 
massage the input string, this is your hook. This is called from
the user command term-send-input. term-simple-send just sends
the string plus a newline.")

270 271 272 273
(defvar term-eol-on-send t
  "*Non-nil means go to the end of the line before sending input.
See `term-send-input'.")

Richard M. Stallman's avatar
Richard M. Stallman committed
274 275 276 277 278 279 280 281
(defvar term-mode-hook '()
  "Called upon entry into term-mode
This is run before the process is cranked up.")

(defvar term-exec-hook '()
  "Called each time a process is exec'd by term-exec.
This is called after the process is cranked up.  It is useful for things that
must be done each time a process is executed in a term-mode buffer (e.g.,
Erik Naggum's avatar
Erik Naggum committed
282
\(process-kill-without-query)). In contrast, the term-mode-hook is only
Richard M. Stallman's avatar
Richard M. Stallman committed
283 284 285 286 287
executed once when the buffer is created.")

(defvar term-mode-map nil)
(defvar term-raw-map nil
  "Keyboard map for sending characters directly to the inferior process.")
288 289 290
(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.")
Richard M. Stallman's avatar
Richard M. Stallman committed
291 292 293 294 295 296
(defvar term-raw-escape-map nil)

(defvar term-pager-break-map nil)

(defvar term-ptyp t
  "True if communications via pty; false if by pipe.  Buffer local.
297
This is to work around a bug in emacs process signaling.")
Richard M. Stallman's avatar
Richard M. Stallman committed
298 299 300 301 302 303 304 305 306 307 308 309 310 311 312 313 314 315 316 317 318 319 320 321 322

(defvar term-last-input-match ""
  "Last string searched for by term input history search, for defaulting.
Buffer local variable.") 

(defvar term-input-ring nil)
(defvar term-last-input-start)
(defvar term-last-input-end)
(defvar term-input-ring-index nil
  "Index of last matched history element.")
(defvar term-matching-input-from-input-string ""
  "Input previously used to match input history.")
; This argument to set-process-filter disables reading from the process,
; assuming this is emacs-19.20 or newer.
(defvar term-pager-filter t)

(put 'term-replace-by-expanded-history 'menu-enable 'term-input-autoexpand)
(put 'term-input-ring 'permanent-local t)
(put 'term-input-ring-index 'permanent-local t)
(put 'term-input-autoexpand 'permanent-local t)
(put 'term-input-filter-functions 'permanent-local t)
(put 'term-scroll-to-bottom-on-output 'permanent-local t)
(put 'term-scroll-show-maximum-output 'permanent-local t)
(put 'term-ptyp 'permanent-local t)

323 324 325 326
;; Do FORMS if running under Emacs-19.
(defmacro term-if-emacs19 (&rest forms)
  (if (string-match "^19" emacs-version) (cons 'progn forms)))
;; True if running under XEmacs (previously Lucid emacs).
Richard M. Stallman's avatar
Richard M. Stallman committed
327
(defmacro term-is-xemacs ()  '(string-match "Lucid" emacs-version))
328 329 330 331 332 333
;; Do FORM if running under XEmacs (previously Lucid emacs).
(defmacro term-if-xemacs (&rest forms)
  (if (term-is-xemacs) (cons 'progn forms)))
;; Do FORM if NOT running under XEmacs (previously Lucid emacs).
(defmacro term-ifnot-xemacs (&rest forms)
  (if (not (term-is-xemacs)) (cons 'progn forms)))
Richard M. Stallman's avatar
Richard M. Stallman committed
334 335 336

(defmacro term-in-char-mode () '(eq (current-local-map) term-raw-map))
(defmacro term-in-line-mode () '(not (term-in-char-mode)))
337 338 339 340 341 342 343
;; True if currently doing PAGER handling.
(defmacro term-pager-enabled () 'term-pager-count)
(defmacro term-handling-pager () 'term-pager-old-local-map)
(defmacro term-using-alternate-sub-buffer () 'term-saved-home-marker)

(defvar term-signals-menu)
(defvar term-terminal-menu)
Richard M. Stallman's avatar
Richard M. Stallman committed
344

345 346 347 348 349 350 351
(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])))
Richard M. Stallman's avatar
Richard M. Stallman committed
352 353 354 355 356 357 358 359 360 361 362 363 364 365 366 367 368 369 370 371 372 373 374 375 376 377 378 379 380 381 382 383 384 385 386 387 388 389 390 391 392 393 394 395 396 397 398 399 400 401 402 403 404 405 406 407 408 409 410 411 412 413 414 415 416 417 418 419 420 421 422 423 424 425 426 427 428 429 430 431 432 433 434 435 436 437 438 439 440 441

(defun term-mode ()
  "Major mode for interacting with an inferior interpreter.
Interpreter name is same as buffer name, sans the asterisks.
In line sub-mode, return at end of buffer sends line as input,
while return not at end copies rest of line to end and sends it.
In char sub-mode, each character (except `term-escape-char`) is
set immediately.

This mode is typically customised to create inferior-lisp-mode,
shell-mode, etc.. This can be done by setting the hooks
term-input-filter-functions, term-input-filter, term-input-sender and
term-get-old-input to appropriate functions, and the variable
term-prompt-regexp to the appropriate regular expression.

An input history is maintained of size `term-input-ring-size', and
can be accessed with the commands \\[term-next-input], \\[term-previous-input], and \\[term-dynamic-list-input-ring].
Input ring history expansion can be achieved with the commands
\\[term-replace-by-expanded-history] or \\[term-magic-space].
Input ring expansion is controlled by the variable `term-input-autoexpand',
and addition is controlled by the variable `term-input-ignoredups'.

Input to, and output from, the subprocess can cause the window to scroll to
the end of the buffer.  See variables `term-scroll-to-bottom-on-input',
and `term-scroll-to-bottom-on-output'.

If you accidentally suspend your process, use \\[term-continue-subjob]
to continue it.

\\{term-mode-map}

Entry to this mode runs the hooks on term-mode-hook"
  (interactive)
    ;; Do not remove this.  All major modes must do this.
    (kill-all-local-variables)
    (setq major-mode 'term-mode)
    (setq mode-name "Term")
    (use-local-map term-mode-map)
    (make-local-variable 'term-home-marker)
    (setq term-home-marker (copy-marker 0))
    (make-local-variable 'term-saved-home-marker)
    (make-local-variable 'term-height)
    (make-local-variable 'term-width)
    (setq term-width (1- (window-width)))
    (setq term-height (1- (window-height)))
    (make-local-variable 'term-terminal-parameter)
    (make-local-variable 'term-saved-cursor)
    (make-local-variable 'term-last-input-start)
    (setq term-last-input-start (make-marker))
    (make-local-variable 'term-last-input-end)
    (setq term-last-input-end (make-marker))
    (make-local-variable 'term-last-input-match)
    (setq term-last-input-match "")
    (make-local-variable 'term-prompt-regexp)        ; Don't set; default
    (make-local-variable 'term-input-ring-size)      ; ...to global val.
    (make-local-variable 'term-input-ring)
    (make-local-variable 'term-input-ring-file-name)
    (or (and (boundp 'term-input-ring) term-input-ring)
	(setq term-input-ring (make-ring term-input-ring-size)))
    (make-local-variable 'term-input-ring-index)
    (or (and (boundp 'term-input-ring-index) term-input-ring-index)
	(setq term-input-ring-index nil))

    (make-local-variable 'term-command-hook)
    (setq term-command-hook (symbol-function 'term-command-hook))

    (make-local-variable 'term-terminal-state)
    (make-local-variable 'term-kill-echo-list)
    (make-local-variable 'term-start-line-column)
    (make-local-variable 'term-current-column)
    (make-local-variable 'term-current-row)
    (make-local-variable 'term-log-buffer)
    (make-local-variable 'term-scroll-start)
    (make-local-variable 'term-scroll-end)
    (setq term-scroll-end term-height)
    (make-local-variable 'term-scroll-with-delete)
    (make-local-variable 'term-pager-count)
    (make-local-variable 'term-pager-old-local-map)
    (make-local-variable 'term-old-mode-map)
    (make-local-variable 'term-insert-mode)
    (make-local-variable 'term-dynamic-complete-functions)
    (make-local-variable 'term-completion-fignore)
    (make-local-variable 'term-get-old-input)
    (make-local-variable 'term-matching-input-from-input-string)
    (make-local-variable 'term-input-autoexpand)
    (make-local-variable 'term-input-ignoredups)
    (make-local-variable 'term-delimiter-argument-list)
    (make-local-variable 'term-input-filter-functions)
    (make-local-variable 'term-input-filter)  
    (make-local-variable 'term-input-sender)
442
    (make-local-variable 'term-eol-on-send)
Richard M. Stallman's avatar
Richard M. Stallman committed
443 444 445 446 447 448 449 450 451 452 453
    (make-local-variable 'term-scroll-to-bottom-on-output)
    (make-local-variable 'term-scroll-show-maximum-output)
    (make-local-variable 'term-ptyp)
    (make-local-variable 'term-exec-hook)
    (make-local-variable 'term-vertical-motion)
    (make-local-variable 'term-pending-delete-marker)
    (setq term-pending-delete-marker (make-marker))
    (make-local-variable 'term-current-face)
    (make-local-variable 'term-pending-frame)
    (setq term-pending-frame nil)
    (run-hooks 'term-mode-hook)
454 455 456
    (term-if-xemacs
     (set-buffer-menubar
      (append current-menubar (list term-terminal-menu))))
Richard M. Stallman's avatar
Richard M. Stallman committed
457
    (or term-input-ring
458 459
	(setq term-input-ring (make-ring term-input-ring-size)))
    (term-update-mode-line))
Richard M. Stallman's avatar
Richard M. Stallman committed
460 461 462 463 464 465 466 467

(if term-mode-map
    nil
  (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)
468 469 470
  (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))
Richard M. Stallman's avatar
Richard M. Stallman committed
471 472 473 474 475 476 477 478 479 480 481 482 483 484 485 486 487
  (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)
488 489 490
  (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)
Richard M. Stallman's avatar
Richard M. Stallman committed
491 492 493 494 495 496 497 498 499 500 501 502 503 504 505 506 507 508 509 510 511

  (copy-face 'default 'term-underline-face)
  (set-face-underline-p 'term-underline-face t)

;  ;; 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))
  )

;; Menu bars:
512 513
(term-ifnot-xemacs
 (term-if-emacs19
514 515 516 517 518 519 520 521 522 523 524 525

  ;; terminal:
  (let (newmap)
    (setq newmap (make-sparse-keymap "Terminal"))
    (define-key newmap [terminal-pager-enable]
      '("Enable paging" . term-fake-pager-enable))
    (define-key newmap [terminal-pager-disable]
      '("Disable paging" . term-fake-pager-disable))
    (define-key newmap [terminal-char-mode]
      '("Character mode" . term-char-mode))
    (define-key newmap [terminal-line-mode]
      '("Line mode" . term-line-mode))
526
    (setq term-terminal-menu (cons "Terminal" newmap))
527 528 529 530 531 532 533 534 535 536 537 538 539 540 541 542 543 544 545 546 547 548 549 550 551 552 553 554 555 556 557 558 559 560 561 562 563 564 565 566 567 568 569 570 571 572 573 574 575 576 577 578 579 580 581 582 583 584 585 586 587 588 589 590

    ;; completion:  (line mode only)
    (defvar term-completion-menu (make-sparse-keymap "Complete"))
    (define-key term-mode-map [menu-bar completion] 
      (cons "Complete" term-completion-menu))
    (define-key term-completion-menu [complete-expand]
      '("Expand File Name" . term-replace-by-expanded-filename))
    (define-key term-completion-menu [complete-listing]
      '("File Completion Listing" . term-dynamic-list-filename-completions))
    (define-key term-completion-menu [menu-bar completion complete-file]
      '("Complete File Name" . term-dynamic-complete-filename))
    (define-key term-completion-menu [menu-bar completion complete]
      '("Complete Before Point" . term-dynamic-complete))

    ;; Input history: (line mode only)
    (defvar term-inout-menu (make-sparse-keymap "In/Out"))
    (define-key term-mode-map [menu-bar inout] 
      (cons "In/Out" term-inout-menu))
    (define-key term-inout-menu [kill-output]
      '("Kill Current Output Group" . term-kill-output))
    (define-key term-inout-menu [next-prompt]
      '("Forward Output Group" . term-next-prompt))
    (define-key term-inout-menu [previous-prompt]
      '("Backward Output Group" . term-previous-prompt))
    (define-key term-inout-menu [show-maximum-output]
      '("Show Maximum Output" . term-show-maximum-output))
    (define-key term-inout-menu [show-output]
      '("Show Current Output Group" . term-show-output))
    (define-key term-inout-menu [kill-input]
      '("Kill Current Input" . term-kill-input))
    (define-key term-inout-menu [copy-input]
      '("Copy Old Input" . term-copy-old-input))
    (define-key term-inout-menu [forward-matching-history]
      '("Forward Matching Input..." . term-forward-matching-input))
    (define-key term-inout-menu [backward-matching-history]
      '("Backward Matching Input..." . term-backward-matching-input))
    (define-key term-inout-menu [next-matching-history]
      '("Next Matching Input..." . term-next-matching-input))
    (define-key term-inout-menu [previous-matching-history]
      '("Previous Matching Input..." . term-previous-matching-input))
    (define-key term-inout-menu [next-matching-history-from-input]
      '("Next Matching Current Input" . term-next-matching-input-from-input))
    (define-key term-inout-menu [previous-matching-history-from-input]
      '("Previous Matching Current Input" . term-previous-matching-input-from-input))
    (define-key term-inout-menu [next-history]
      '("Next Input" . term-next-input))
    (define-key term-inout-menu [previous-history]
      '("Previous Input" . term-previous-input))
    (define-key term-inout-menu [list-history]
      '("List Input History" . term-dynamic-list-input-ring))
    (define-key term-inout-menu [expand-history]
      '("Expand History Before Point" . term-replace-by-expanded-history))

    ;; 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)))
    )))
Richard M. Stallman's avatar
Richard M. Stallman committed
591 592 593 594 595 596 597 598 599 600 601 602 603 604 605 606 607 608 609 610 611 612 613 614 615 616 617 618 619 620 621 622 623 624 625 626 627 628 629 630 631 632 633 634 635 636 637 638 639 640 641

(defun term-reset-size (height width)
  (setq term-height height)
  (setq term-width width)
  (setq term-start-line-column nil)
  (setq term-current-row nil)
  (setq term-current-column nil)
  (term-scroll-region 0 height))

;; Recursive routine used to check if any string in term-kill-echo-list
;; matches part of the buffer before point.
;; If so, delete that matched part of the buffer - this suppresses echo.
;; Also, remove that string from the term-kill-echo-list.
;; We *also* remove any older string on the list, as a sanity measure,
;; in case something gets out of sync.  (Except for type-ahead, there
;; should only be one element in the list.)

(defun term-check-kill-echo-list ()
  (let ((cur term-kill-echo-list) (found nil) (save-point (point)))
    (unwind-protect
	(progn
	  (end-of-line)
	  (while cur
	    (let* ((str (car cur)) (len (length str)) (start (- (point) len)))
	      (if (and (>= start (point-min))
		       (string= str (buffer-substring start (point))))
		  (progn (delete-backward-char len)
			 (setq term-kill-echo-list (cdr cur))
			 (setq term-current-column nil)
			 (setq term-current-row nil)
			 (setq term-start-line-column nil)
			 (setq cur nil found t))
		(setq cur (cdr cur))))))
      (if (not found)
	  (goto-char save-point)))
    found))

(defun term-check-size (process)
  (if (or (/= term-height (1- (window-height)))
	  (/= term-width (1- (window-width))))
      (progn
	(term-reset-size (1- (window-height)) (1- (window-width)))
	(set-process-window-size process term-height term-width))))

(defun term-send-raw-string (chars)
  (let ((proc (get-buffer-process (current-buffer))))
    (if (not proc)
	(error "Current buffer has no process")
      ;; Note that (term-current-row) must be called *after*
      ;; (point) has been updated to (process-mark proc).
      (goto-char (process-mark proc))
642
      (if (term-pager-enabled)
Richard M. Stallman's avatar
Richard M. Stallman committed
643
	  (setq term-pager-count (term-current-row)))
644
      (process-send-string proc chars))))
Richard M. Stallman's avatar
Richard M. Stallman committed
645 646 647 648 649 650 651 652 653 654 655 656 657

(defun term-send-raw ()
  "Send the last character typed through the terminal-emulator
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)))
  (term-send-raw-string (make-string 1 last-input-char)))

(defun term-send-raw-meta ()
  (interactive)
658 659 660 661 662 663 664 665 666 667 668 669
  (if (symbolp last-input-char)
      ;; Convert `return' to C-m, etc.
      (let ((tmp (get last-input-char 'event-symbol-elements)))
	(if tmp
	    (setq last-input-char (car tmp)))
	(if (symbolp last-input-char)
	    (progn
	      (setq tmp (get last-input-char 'ascii-character))
	      (if tmp (setq last-input-char tmp))))))
  (term-send-raw-string (if (and (numberp last-input-char)
				 (> last-input-char 127)
				 (< last-input-char 256))
Richard M. Stallman's avatar
Richard M. Stallman committed
670 671 672 673 674 675
			    (make-string 1 last-input-char)
			  (format "\e%c" last-input-char))))

(defun term-mouse-paste (click arg)
  "Insert the last stretch of killed text at the position clicked on."
  (interactive "e\nP")
676 677 678 679 680 681 682 683 684 685 686 687
  (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)
   (term-send-raw-string (current-kill (cond
					((listp arg) 0)
					((eq arg '-) -1)
					(t (1- arg)))))))
Richard M. Stallman's avatar
Richard M. Stallman committed
688 689 690 691 692 693 694 695

;; Which would be better:  "\e[A" or "\eOA"? readline accepts either.
(defun term-send-up    () (interactive) (term-send-raw-string "\e[A"))
(defun term-send-down  () (interactive) (term-send-raw-string "\e[B"))
(defun term-send-right () (interactive) (term-send-raw-string "\e[C"))
(defun term-send-left  () (interactive) (term-send-raw-string "\e[D"))

(defun term-set-escape-char (c)
696
  "Change term-escape-char and keymaps that depend on it."
Richard M. Stallman's avatar
Richard M. Stallman committed
697 698 699 700
  (if term-escape-char
      (define-key term-raw-map term-escape-char 'term-send-raw))
  (setq c (make-string 1 c))
  (define-key term-raw-map c term-raw-escape-map)
701
  ;; Define standard bindings in term-raw-escape-map
Richard M. Stallman's avatar
Richard M. Stallman committed
702 703 704 705 706 707 708
  (define-key term-raw-escape-map "\C-x"
    (lookup-key (current-global-map) "\C-x"))
  (define-key term-raw-escape-map "\C-v"
    (lookup-key (current-global-map) "\C-v"))
  (define-key term-raw-escape-map "\C-u"
    (lookup-key (current-global-map) "\C-u"))
  (define-key term-raw-escape-map c 'term-send-raw)
709 710 711 712
  (define-key term-raw-escape-map "\C-q" 'term-pager-toggle)
  ;; The keybinding for term-char-mode is needed by the menubar code.
  (define-key term-raw-escape-map "\C-k" 'term-char-mode)
  (define-key term-raw-escape-map "\C-j" 'term-line-mode))
Richard M. Stallman's avatar
Richard M. Stallman committed
713 714
    
(defun term-char-mode ()
715 716 717
  "Switch to char (\"raw\") sub-mode of term mode.
Each character you type is sent directly to the inferior without
intervention from emacs, except for the escape character (usually C-c)."
Richard M. Stallman's avatar
Richard M. Stallman committed
718 719 720 721 722 723 724 725 726 727 728 729 730
  (interactive)
  (if (not term-raw-map)
      (let* ((map (make-keymap))
	     (esc-map (make-keymap))
	     (i 0))
	(while (< i 128)
	  (define-key map (make-string 1 i) 'term-send-raw)
	  (define-key esc-map (make-string 1 i) 'term-send-raw-meta)
	  (setq i (1+ i)))
	(define-key map "\e" esc-map)
	(setq term-raw-map map)
	(setq term-raw-escape-map
	      (copy-keymap (lookup-key (current-global-map) "\C-x")))
731 732
	(term-if-emacs19
	 (term-if-xemacs
733
	  (define-key term-raw-map [button2] 'term-mouse-paste))
734 735 736
	 (term-ifnot-xemacs
	  (define-key term-raw-map [mouse-2] 'term-mouse-paste)
	  (define-key term-raw-map [menu-bar terminal] term-terminal-menu)
737
	  (define-key term-raw-map [menu-bar signals] term-signals-menu))
738 739 740 741
	 (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))
742
	(term-set-escape-char ?\C-c)))
Richard M. Stallman's avatar
Richard M. Stallman committed
743
  ;; FIXME: Emit message? Cfr ilisp-raw-message
744 745 746 747 748 749 750 751 752 753 754 755 756 757 758 759
  (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))))
760
	(term-update-mode-line))))
Richard M. Stallman's avatar
Richard M. Stallman committed
761 762

(defun term-line-mode  ()
763 764 765
  "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."
Richard M. Stallman's avatar
Richard M. Stallman committed
766
  (interactive)
767 768 769
  (if (term-in-char-mode)
      (progn
	(use-local-map term-old-mode-map)
770 771 772 773 774 775 776
	(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"))))
777
  (force-mode-line-update))
Richard M. Stallman's avatar
Richard M. Stallman committed
778 779 780 781 782 783 784 785 786 787 788 789 790 791 792 793 794 795 796 797 798 799 800 801 802 803 804 805 806 807 808 809 810 811 812 813 814 815 816 817 818 819 820 821 822 823 824 825 826 827 828 829 830 831 832 833 834 835 836 837 838 839 840 841 842 843 844 845 846 847 848 849 850 851 852 853 854 855

(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"
  (let ((proc (get-buffer-process buffer)))
    (and proc (memq (process-status proc) '(run stop)))))

;;; Note that this guy, unlike shell.el's make-shell, barfs if you pass it ()
;;; for the second argument (program).
;;;###autoload
(defun make-term (name program &optional startfile &rest switches)
"Make a term process NAME in a buffer, running PROGRAM.
The name of the buffer is made by surrounding NAME with `*'s.
If there is already a running process in that buffer, it is not restarted.
Optional third arg STARTFILE is the name of a file to send the contents of to 
the process.  Any more args are arguments to PROGRAM."
  (let ((buffer (get-buffer-create (concat "*" name "*"))))
    ;; If no process, or nuked process, crank up a new one and put buffer in
    ;; term mode. Otherwise, leave buffer and existing process alone.
    (cond ((not (term-check-proc buffer))
	   (save-excursion
	     (set-buffer buffer)
	     (term-mode)) ; Install local vars, mode, keymap, ...
	   (term-exec buffer name program startfile switches)))
    buffer))

;;;###autoload
(defun term (program)
  "Start a terminal-emulator in a new buffer."
  (interactive (list (read-from-minibuffer "Run program: "
					   (or explicit-shell-file-name
					       (getenv "ESHELL")
					       (getenv "SHELL")
					       "/bin/sh"))))
  (set-buffer (make-term "terminal" program))
  (term-mode)
  (term-char-mode)
  (switch-to-buffer "*terminal*"))

(defun term-exec (buffer name command startfile 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."
  (save-excursion
    (set-buffer buffer)
    (let ((proc (get-buffer-process buffer)))	; Blast any old process.
      (if proc (delete-process proc)))
    ;; Crank up a new process
    (let ((proc (term-exec-1 name buffer command switches)))
      (make-local-variable 'term-ptyp)
      (setq term-ptyp process-connection-type) ; T if pty, NIL if pipe.
      ;; Jump to the end, and set the process mark.
      (goto-char (point-max))
      (set-marker (process-mark proc) (point))
      (set-process-filter proc 'term-emulate-terminal)
      ;; Feed it the startfile.
      (cond (startfile
	     ;;This is guaranteed to wait long enough
	     ;;but has bad results if the term does not prompt at all
	     ;;	     (while (= size (buffer-size))
	     ;;	       (sleep-for 1))
	     ;;I hope 1 second is enough!
	     (sleep-for 1)
	     (goto-char (point-max))
	     (insert-file-contents startfile)
	     (setq startfile (buffer-substring (point) (point-max)))
	     (delete-region (point) (point-max))
	     (term-send-string proc startfile)))
    (run-hooks 'term-exec-hook)
    buffer)))

;;; Name to use for TERM.
;;; Using "emacs" loses, because bash disables editing if TERM == emacs.
(defvar term-term-name "eterm")
; Format string, usage: (format term-termcap-string emacs-term-name "TERMCAP=" 24 80)
(defvar term-termcap-format
Richard M. Stallman's avatar
Richard M. Stallman committed
856
  "%s%s:li#%d:co#%d:cl=\\E[H\\E[J:cd=\\E[J:bs:am:xn:cm=\\E[%%i%%d;%%dH\
Richard M. Stallman's avatar
Richard M. Stallman committed
857 858 859
:nd=\\E[C:up=\\E[A:ce=\\E[K:ho=\\E[H:pt\
:al=\\E[L:dl=\\E[M:DL=\\E[%%dM:AL=\\E[%%dL:cs=\\E[%%i%%d;%%dr:sf=\\n\
:te=\\E[2J\\E[?47l\\E8:ti=\\E7\\E[?47h\
Richard M. Stallman's avatar
Richard M. Stallman committed
860
:dc=\\E[P:DC=\\E[%%dP:IC=\\E[%%d@:im=\\E[4h:ei=\\E[4l:mi:\
Richard M. Stallman's avatar
Richard M. Stallman committed
861 862 863
:so=\\E[7m:se=\\E[m:us=\\E[4m:ue=\\E[m:md=\\E[1m:mr=\\E[7m:me=\\E[m\
:UP=\\E[%%dA:DO=\\E[%%dB:LE=\\E[%%dD:RI=\\E[%%dC"
;;; : -undefine ic
864
  "termcap capabilities supported")
Richard M. Stallman's avatar
Richard M. Stallman committed
865 866 867 868 869

;;; This auxiliary function cranks up the process for term-exec in
;;; the appropriate environment.

(defun term-exec-1 (name buffer command switches)
Richard M. Stallman's avatar
Richard M. Stallman committed
870 871 872 873 874 875 876 877 878 879 880 881 882
  ;; We need to do an extra (fork-less) exec to run stty.
  ;; (This would not be needed if we had suitable emacs primitives.)
  ;; The 'if ...; then shift; fi' hack is because Bourne shell
  ;; loses one arg when called with -c, and newer shells (bash,  ksh) don't.
  ;; Thus we add an extra dummy argument "..", and then remove it.
  (let ((process-environment
	 (nconc
	  (list
	   (format "TERM=%s" term-term-name)
	   (if (and (boundp 'system-uses-terminfo) system-uses-terminfo)
	       (format "TERMINFO=%s" data-directory)
	    (format term-termcap-format "TERMCAP="
		    term-term-name term-height term-width))
883
	   (format "EMACS=%s (term:%s)" emacs-version term-protocol-version)
Richard M. Stallman's avatar
Richard M. Stallman committed
884 885
	   (format "LINES=%d" term-height)
	   (format "COLUMNS=%d" term-width))
886 887
	  process-environment))
	(process-connection-type t))
Richard M. Stallman's avatar
Richard M. Stallman committed
888 889 890 891 892 893 894
    (apply 'start-process name buffer
	   "/bin/sh" "-c"
	   (format "stty -nl echo rows %d columns %d sane 2>/dev/null;\
if [ $1 = .. ]; then shift; fi; exec \"$@\""
		   term-height term-width)
	   ".."
	   command switches)))
Richard M. Stallman's avatar
Richard M. Stallman committed
895 896 897 898 899 900 901 902 903 904 905 906 907 908 909 910 911 912 913 914 915 916 917 918 919 920 921 922 923 924 925 926 927 928 929 930 931 932 933 934 935 936 937 938 939 940 941 942 943 944 945 946 947 948 949 950 951 952 953 954 955 956 957 958 959 960 961 962 963 964 965 966 967 968 969 970 971 972 973 974 975 976 977 978 979 980 981 982 983 984 985 986 987 988 989 990 991 992 993 994 995 996 997 998 999 1000 1001 1002 1003 1004 1005 1006 1007 1008 1009 1010 1011 1012 1013 1014 1015 1016 1017 1018 1019 1020 1021 1022 1023 1024 1025 1026 1027 1028 1029 1030 1031 1032 1033 1034 1035 1036 1037 1038 1039 1040 1041 1042 1043 1044 1045 1046 1047 1048 1049 1050 1051 1052 1053 1054 1055 1056 1057 1058 1059 1060 1061 1062 1063 1064 1065 1066 1067 1068 1069 1070 1071 1072 1073 1074 1075 1076 1077 1078 1079 1080 1081 1082 1083 1084 1085 1086 1087 1088 1089 1090 1091 1092 1093 1094 1095 1096 1097 1098 1099 1100 1101 1102 1103 1104 1105 1106 1107 1108 1109 1110 1111 1112 1113 1114 1115 1116 1117 1118 1119 1120 1121 1122 1123 1124 1125 1126 1127 1128 1129 1130 1131 1132 1133 1134 1135 1136 1137 1138 1139 1140 1141 1142 1143 1144 1145 1146 1147 1148 1149 1150 1151 1152 1153 1154 1155 1156 1157 1158 1159 1160 1161 1162 1163 1164 1165 1166 1167 1168 1169 1170 1171 1172 1173 1174 1175 1176 1177 1178 1179 1180 1181 1182 1183 1184 1185 1186 1187 1188 1189 1190 1191 1192 1193 1194 1195 1196 1197 1198 1199 1200 1201 1202 1203 1204 1205 1206 1207 1208 1209 1210 1211 1212 1213 1214 1215 1216 1217 1218 1219 1220 1221 1222 1223 1224 1225 1226 1227 1228 1229 1230 1231 1232 1233 1234 1235 1236 1237 1238 1239 1240 1241 1242 1243 1244 1245 1246 1247 1248 1249 1250 1251 1252 1253 1254 1255 1256 1257 1258 1259 1260 1261 1262 1263 1264 1265 1266 1267 1268 1269 1270 1271 1272 1273 1274 1275 1276 1277 1278 1279 1280 1281 1282 1283 1284 1285 1286 1287 1288 1289 1290 1291 1292 1293 1294 1295 1296 1297 1298 1299 1300 1301 1302 1303 1304 1305 1306 1307 1308 1309 1310 1311 1312 1313 1314 1315 1316 1317 1318 1319 1320 1321 1322 1323 1324 1325 1326 1327 1328 1329 1330 1331 1332 1333 1334 1335 1336 1337 1338 1339 1340 1341 1342 1343 1344 1345 1346 1347 1348 1349 1350 1351 1352 1353 1354 1355 1356 1357 1358 1359 1360 1361 1362 1363 1364 1365 1366 1367 1368 1369 1370 1371 1372 1373 1374 1375 1376 1377 1378

;;; This should be in emacs, but it isn't.
(defun term-mem (item list &optional elt=)
  "Test to see if ITEM is equal to an item in LIST.
Option comparison function ELT= defaults to equal."
  (let ((elt= (or elt= (function equal)))
	(done nil))
    (while (and list (not done))
      (if (funcall elt= item (car list))
	  (setq done list)
	  (setq list (cdr list))))
    done))


;;; Input history processing in a buffer
;;; ===========================================================================
;;; Useful input history functions, courtesy of the Ergo group.

;;; Eleven commands:
;;; term-dynamic-list-input-ring	List history in help buffer.
;;; term-previous-input		Previous input...
;;; term-previous-matching-input	...matching a string.
;;; term-previous-matching-input-from-input ... matching the current input.
;;; term-next-input			Next input...
;;; term-next-matching-input		...matching a string.
;;; term-next-matching-input-from-input     ... matching the current input.
;;; term-backward-matching-input      Backwards input...
;;; term-forward-matching-input       ...matching a string.
;;; term-replace-by-expanded-history	Expand history at point;
;;;					replace with expanded history.
;;; term-magic-space			Expand history and insert space.
;;;
;;; Three functions:
;;; term-read-input-ring              Read into term-input-ring...
;;; term-write-input-ring             Write to term-input-ring-file-name.
;;; term-replace-by-expanded-history-before-point Workhorse function.

(defun term-read-input-ring (&optional silent)
  "Sets the buffer's `term-input-ring' from a history file.
The name of the file is given by the variable `term-input-ring-file-name'.
The history ring is of size `term-input-ring-size', regardless of file size.
If `term-input-ring-file-name' is nil this function does nothing.

If the optional argument SILENT is non-nil, we say nothing about a
failure to read the history file.

This function is useful for major mode commands and mode hooks.

The structure of the history file should be one input command per line,
with the most recent command last.
See also `term-input-ignoredups' and `term-write-input-ring'."
  (cond ((or (null term-input-ring-file-name)
	     (equal term-input-ring-file-name ""))
	 nil)
	((not (file-readable-p term-input-ring-file-name))
	 (or silent
	     (message "Cannot read history file %s"
		      term-input-ring-file-name)))
	(t
	 (let ((history-buf (get-buffer-create " *temp*"))
	       (file term-input-ring-file-name)
	       (count 0)
	       (ring (make-ring term-input-ring-size)))
	   (unwind-protect
	       (save-excursion
		 (set-buffer history-buf)
		 (widen)
		 (erase-buffer)
		 (insert-file-contents file)
		 ;; Save restriction in case file is already visited...
		 ;; Watch for those date stamps in history files!
		 (goto-char (point-max))
		 (while (and (< count term-input-ring-size)
			     (re-search-backward "^[ \t]*\\([^#\n].*\\)[ \t]*$"
						 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)))
			 (ring-insert-at-beginning ring history)))
		   (setq count (1+ count))))
	     (kill-buffer history-buf))
	   (setq term-input-ring ring
		 term-input-ring-index nil)))))

(defun term-write-input-ring ()
  "Writes the buffer's `term-input-ring' to a history file.
The name of the file is given by the variable `term-input-ring-file-name'.
The original contents of the file are lost if `term-input-ring' is not empty.
If `term-input-ring-file-name' is nil this function does nothing.

Useful within process sentinels.

See also `term-read-input-ring'."
  (cond ((or (null term-input-ring-file-name)
	     (equal term-input-ring-file-name "")
	     (null term-input-ring) (ring-empty-p term-input-ring))
	 nil)
	((not (file-writable-p term-input-ring-file-name))
	 (message "Cannot write history file %s" term-input-ring-file-name))
	(t
	 (let* ((history-buf (get-buffer-create " *Temp Input History*"))
		(ring term-input-ring)
		(file term-input-ring-file-name)
		(index (ring-length ring)))
	   ;; Write it all out into a buffer first.  Much faster, but messier,
	   ;; than writing it one line at a time.
	   (save-excursion
	     (set-buffer history-buf)
	     (erase-buffer)
	     (while (> index 0)
	       (setq index (1- index))
	       (insert (ring-ref ring index) ?\n))
	     (write-region (buffer-string) nil file nil 'no-message)
	     (kill-buffer nil))))))


(defun term-dynamic-list-input-ring ()
  "List in help buffer the buffer's input history."
  (interactive)
  (if (or (not (ring-p term-input-ring))
	  (ring-empty-p term-input-ring))
      (message "No history")
    (let ((history nil)
	  (history-buffer " *Input History*")
	  (index (1- (ring-length term-input-ring)))
	  (conf (current-window-configuration)))
      ;; We have to build up a list ourselves from the ring vector.
      (while (>= index 0)
	(setq history (cons (ring-ref term-input-ring index) history)
	      index (1- index)))
      ;; Change "completion" to "history reference"
      ;; to make the display accurate.
      (with-output-to-temp-buffer history-buffer
	(display-completion-list history)
	(set-buffer history-buffer)
	(forward-line 3)
	(while (search-backward "completion" nil 'move)
	  (replace-match "history reference")))
      (sit-for 0)
      (message "Hit space to flush")
      (let ((ch (read-event)))
	(if (eq ch ?\ )
	    (set-window-configuration conf)
	  (setq unread-command-events (list ch)))))))


(defun term-regexp-arg (prompt)
  ;; Return list of regexp and prefix arg using PROMPT.
  (let* ((minibuffer-history-sexp-flag nil)
	 ;; Don't clobber this.
	 (last-command last-command)
	 (regexp (read-from-minibuffer prompt nil nil nil
				       'minibuffer-history-search-history)))
    (list (if (string-equal regexp "")
	      (setcar minibuffer-history-search-history
		      (nth 1 minibuffer-history-search-history))
	    regexp)
	  (prefix-numeric-value current-prefix-arg))))

(defun term-search-arg (arg)
  ;; First make sure there is a ring and that we are after the process mark
  (cond ((not (term-after-pmark-p))
	 (error "Not at command line"))
	((or (null term-input-ring)
	     (ring-empty-p term-input-ring))
	 (error "Empty input ring"))
	((zerop arg)
	 ;; arg of zero resets search from beginning, and uses arg of 1
	 (setq term-input-ring-index nil)
	 1)
	(t
	 arg)))

(defun term-search-start (arg)
  ;; Index to start a directional search, starting at term-input-ring-index
  (if term-input-ring-index
      ;; If a search is running, offset by 1 in direction of arg
      (mod (+ term-input-ring-index (if (> arg 0) 1 -1))
	   (ring-length term-input-ring))
    ;; For a new search, start from beginning or end, as appropriate
    (if (>= arg 0)
	0				       ; First elt for forward search
      (1- (ring-length term-input-ring)))))  ; Last elt for backward search

(defun term-previous-input-string (arg)
  "Return the string ARG places along the input ring.
Moves relative to `term-input-ring-index'."
  (ring-ref term-input-ring (if term-input-ring-index
				  (mod (+ arg term-input-ring-index) 
				       (ring-length term-input-ring))
				arg)))

(defun term-previous-input (arg)
  "Cycle backwards through input history."
  (interactive "*p")
  (term-previous-matching-input "." arg))

(defun term-next-input (arg)
  "Cycle forwards through input history."
  (interactive "*p")
  (term-previous-input (- arg)))

(defun term-previous-matching-input-string (regexp arg)
  "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))))

(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"))
  (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 nil)
	 (prev nil))
    ;; Do the whole search as many times as the argument says.
    (while (and (/= arg 0) (not tried-each-ring-item))
      ;; Step once.
      (setq prev n
	    n (mod (+ n motion) len))
      ;; If we haven't reached a match, step some more.
      (while (and (< n len) (not tried-each-ring-item)
		  (not (string-match regexp (ring-ref term-input-ring n))))
	(setq n (mod (+ n motion) len)
	      ;; If we have gone all the way around in this search.
	      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)))

(defun term-previous-matching-input (regexp arg)
  "Search backwards through input history for match for REGEXP.
\(Previous history elements are earlier commands.)
With prefix argument N, search for Nth previous match.
If N is negative, find the next or Nth next match."
  (interactive (term-regexp-arg "Previous input matching (regexp): "))
  (setq arg (term-search-arg arg))
  (let ((pos (term-previous-matching-input-string-position regexp arg)))
    ;; Has a match been found?
    (if (null pos)
	(error "Not found")
      (setq term-input-ring-index pos)
      (message "History item: %d" (1+ pos))
      (delete-region 
       ;; Can't use kill-region as it sets this-command
       (process-mark (get-buffer-process (current-buffer))) (point))
      (insert (ring-ref term-input-ring pos)))))

(defun term-next-matching-input (regexp arg)
  "Search forwards through input history for match for REGEXP.
\(Later history elements are more recent commands.)
With prefix argument N, search for Nth following match.
If N is negative, find the previous or Nth previous match."
  (interactive (term-regexp-arg "Next input matching (regexp): "))
  (term-previous-matching-input regexp (- arg)))

(defun term-previous-matching-input-from-input (arg)
  "Search backwards through input history for match for current input.
\(Previous history elements are earlier commands.)
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
				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))
  (term-previous-matching-input
   (concat "^" (regexp-quote term-matching-input-from-input-string))
   arg))

(defun term-next-matching-input-from-input (arg)
  "Search forwards through input history for match for current input.
\(Following history elements are more recent commands.)
With prefix argument N, search for Nth following match.
If N is negative, search backwards for the -Nth previous match."
  (interactive "p")
  (term-previous-matching-input-from-input (- arg)))


(defun term-replace-by-expanded-history (&optional silent)
  "Expand input command history references before point.
Expansion is dependent on the value of `term-input-autoexpand'.

This function depends on the buffer's idea of the input history, which may not
match the command interpreter's idea, assuming it has one.

Assumes history syntax is like typical Un*x shells'.  However, since emacs
cannot know the interpreter's idea of input line numbers, assuming it has one,
it cannot expand absolute input line number references.

If the optional argument SILENT is non-nil, never complain
even if history reference seems erroneous.

See `term-magic-space' and `term-replace-by-expanded-history-before-point'.

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)))))


(defun term-replace-by-expanded-history-before-point (silent)
  "Expand directory stack reference before point.
See `term-replace-by-expanded-history'.  Returns t if successful."
  (save-excursion
    (let ((toend (- (save-excursion (end-of-line nil) (point)) (point)))
	  (start (progn (term-bol nil) (point))))
      (while (progn
	       (skip-chars-forward "^!^"
				   (save-excursion
				     (end-of-line nil) (- (point) toend)))
	       (< (point)
		  (save-excursion
		    (end-of-line nil) (- (point) toend))))
	;; This seems a bit complex.  We look for references such as !!, !-num,
	;; !foo, !?foo, !{bar}, !?{bar}, ^oh, ^my^, ^god^it, ^never^ends^.
	;; If that wasn't enough, the plings can be suffixed with argument
	;; range specifiers.
	;; Argument ranges are complex too, so we hive off the input line,
	;; referenced with plings, with the range string to `term-args'.
	(setq term-input-ring-index nil)
	(cond ((or (= (preceding-char) ?\\)
		   (term-within-quotes start (point)))
	       ;; The history is quoted, or we're in quotes.
	       (goto-char (1+ (point))))
	      ((looking-at "![0-9]+\\($\\|[^-]\\)")
	       ;; We cannot know the interpreter's idea of input line numbers.
	       (goto-char (match-end 0))
	       (message "Absolute reference cannot be expanded"))
	      ((looking-at "!-\\([0-9]+\\)\\(:?[0-9^$*-]+\\)?")
	       ;; Just a number of args from `number' lines backward.
	       (let ((number (1- (string-to-number
				  (buffer-substring (match-beginning 1)
						    (match-end 1))))))
		 (if (<= number (ring-length term-input-ring))
		     (progn
		       (replace-match
			(term-args (term-previous-input-string number)
				     (match-beginning 2) (match-end 2))
			t t)
		       (setq term-input-ring-index number)
		       (message "History item: %d" (1+ number)))
		   (goto-char (match-end 0))
		   (message "Relative reference exceeds input history size"))))
	      ((or (looking-at "!!?:?\\([0-9^$*-]+\\)") (looking-at "!!"))
	       ;; Just a number of args from the previous input line.
	       (replace-match
		(term-args (term-previous-input-string 0)
			     (match-beginning 1) (match-end 1))
		t t)
	       (message "History item: previous"))
	      ((looking-at
		"!\\??\\({\\(.+\\)}\\|\\(\\sw+\\)\\)\\(:?[0-9^$*-]+\\)?")
	       ;; Most recent input starting with or containing (possibly
	       ;; protected) string, maybe just a number of args.  Phew.
	       (let* ((mb1 (match-beginning 1)) (me1 (match-end 1))
		      (mb2 (match-beginning 2)) (me2 (match-end 2))
		      (exp (buffer-substring (or mb2 mb1) (or me2 me1)))
		      (pref (if (save-match-data (looking-at "!\\?")) "" "^"))
		      (pos (save-match-data
			     (term-previous-matching-input-string-position
			      (concat pref (regexp-quote exp)) 1))))
		 (if (null pos)
		     (progn
		       (goto-char (match-end 0))
		       (or silent
			   (progn (message "Not found")
				  (ding))))
		   (setq term-input-ring-index pos)
		   (replace-match
		    (term-args (ring-ref term-input-ring pos)
				 (match-beginning 4) (match-end 4))
		    t t)
		   (message "History item: %d" (1+ pos)))))
	      ((looking-at "\\^\\([^^]+\\)\\^?\\([^^]*\\)\\^?")
	       ;; Quick substitution on the previous input line.
	       (let ((old (buffer-substring (match-beginning 1) (match-end 1)))
		     (new (buffer-substring (match-beginning 2) (match-end 2)))
		     (pos nil))
		 (replace-match (term-previous-input-string 0) t t)
		 (setq pos (point))
		 (goto-char (match-beginning 0))
		 (if (not (search-forward old pos t))
		     (or silent
			 (error "Not found"))
		   (replace-match new t t)
		   (message "History item: substituted"))))
	      (t
	       (goto-char (match-end 0))))))))


(defun term-magic-space (arg)
  "Expand input history references before point and insert ARG spaces.
A useful command to bind to SPC.  See `term-replace-by-expanded-history'."
  (interactive "p")
  (term-replace-by-expanded-history)
  (self-insert-command arg))

(defun term-within-quotes (beg end)
  "Return t if the number of quotes between BEG and END is odd.
Quotes are single and double."
  (let ((countsq (term-how-many-region "\\(^\\|[^\\\\]\\)\'" beg end))
	(countdq (term-how-many-region "\\(^\\|[^\\\\]\\)\"" beg end)))
    (or (= (mod countsq 2) 1) (= (mod countdq 2) 1))))

(defun term-how-many-region (regexp beg end)
  "Return number of matches for REGEXP from BEG to END."
  (let ((count 0))
    (save-excursion
      (save-match-data
	(goto-char beg)
	(while (re-search-forward regexp end t)
	  (setq count (1+ count)))))
    count))

(defun term-args (string begin end)
  ;; From STRING, return the args depending on the range specified in the text
  ;; from BEGIN to END.  If BEGIN is nil, assume all args.  Ignore leading `:'.
  ;; Range can be x-y, x-, -y, where x/y can be [0-9], *, ^, $.
  (save-match-data
    (if (null begin)
	(term-arguments string 0 nil)
      (let* ((range (buffer-substring
		     (if (eq (char-after begin) ?:) (1+ begin) begin) end))
	     (nth (cond ((string-match "^[*^]" range) 1)
			((string-match "^-" range) 0)
			((string-equal range "$") nil)
			(t (string-to-number range))))
	     (mth (cond ((string-match "[-*$]$" range) nil)
			((string-match "-" range)
			 (string-to-number (substring range (match-end 0))))
			(t nth))))
	(term-arguments string nth mth)))))

;; Return a list of arguments from ARG.  Break it up at the
;; delimiters in term-delimiter-argument-list.  Returned list is backwards.
(defun term-delim-arg (arg)
  (if (null term-delimiter-argument-list)
      (list arg)
    (let ((args nil)
	  (pos 0)
	  (len (length arg)))
      (while (< pos len)
	(let ((char (aref arg pos))
	      (start pos))
	  (if (memq char term-delimiter-argument-list)
	      (while (and (< pos len) (eq (aref arg pos) char))
		(setq pos (1+ pos)))
	    (while (and (< pos len)
			(not (memq (aref arg pos)
				   term-delimiter-argument-list)))
	      (setq pos (1+ pos))))
	  (setq args (cons (substring arg start pos) args))))
      args)))

(defun term-arguments (string nth mth)
  "Return from STRING the NTH to MTH arguments.
NTH and/or MTH can be nil, which means the last argument.
Returned arguments are separated by single spaces.
We assume whitespace separates arguments, except within quotes.
Also, a run of one or more of a single character
in `term-delimiter-argument-list' is a separate argument.
Argument 0 is the command name."
  (let ((argpart "[^ \n\t\"'`]+\\|\\(\"[^\"]*\"\\|'[^']*'\\|`[^`]*`\\)")
	(args ()) (pos 0)
	(count 0)
1379
	beg str quotes)
Richard M. Stallman's avatar
Richard M. Stallman committed
1380 1381 1382 1383 1384 1385 1386 1387 1388 1389 1390 1391 1392 1393 1394 1395 1396 1397 1398 1399 1400 1401 1402 1403 1404 1405 1406 1407 1408 1409 1410 1411 1412 1413 1414 1415 1416 1417 1418 1419 1420 1421 1422 1423 1424 1425 1426 1427
    ;; Build a list of all the args until we have as many as we want.
    (while (and (or (null mth) (<= count mth))
		(string-match argpart string pos))
      (if (and beg (= pos (match-beginning 0)))
	  ;; It's contiguous, part of the same arg.
	  (setq pos (match-end 0)
		quotes (or quotes (match-beginning 1)))
	;; It's a new separate arg.
	(if beg
	    ;; Put the previous arg, if there was one, onto ARGS.
	    (setq str (substring string beg pos)
		  args (if quotes (cons str args)
			 (nconc (term-delim-arg str) args))
		  count (1+ count)))
	(setq quotes (match-beginning 1))
	(setq beg (match-beginning 0))
	(setq pos (match-end 0))))
    (if beg
	(setq str (substring string beg pos)
	      args (if quotes (cons str args)
		     (nconc (term-delim-arg str) args))
	      count (1+ count)))
    (let ((n (or nth (1- count)))
	  (m (if mth (1- (- count mth)) 0)))
      (mapconcat
       (function (lambda (a) a)) (nthcdr n (nreverse (nthcdr m args))) " "))))

;;;
;;; Input processing stuff [line mode]
;;;

(defun term-send-input () 
  "Send input to process.
After the process output mark, sends all text from the process mark to
point as input to the process.  Before the process output mark, calls value
of variable term-get-old-input to retrieve old input, copies it to the
process mark, and sends it.  A terminal newline is also inserted into the
buffer and sent to the process.  The list of function names contained in the
value of `term-input-filter-functions' is called on the input before sending
it.  The input is entered into the input history ring, if the value of variable
term-input-filter returns non-nil when called on the input.

Any history reference may be expanded depending on the value of the variable
`term-input-autoexpand'.  The list of function names contained in the value
of `term-input-filter-functions' is called on the input before sending it.
The input is entered into the input history ring, if the value of variable
`term-input-filter' returns non-nil when called on the input.

1428 1429 1430
If variable `term-eol-on-send' is non-nil, then point is moved to the
end of line before sending the input.

Richard M. Stallman's avatar
Richard M. Stallman committed
1431 1432 1433 1434 1435 1436 1437 1438 1439 1440 1441 1442 1443 1444 1445 1446 1447 1448 1449 1450 1451 1452 1453 1454 1455
The values of `term-get-old-input', `term-input-filter-functions', and
`term-input-filter' are chosen according to the command interpreter running
in the buffer.  E.g.,

If the interpreter is the csh,
    term-get-old-input is the default: take the current line, discard any
        initial string matching regexp term-prompt-regexp.
    term-input-filter-functions monitors input for \"cd\", \"pushd\", and
	\"popd\" commands. When it sees one, it cd's the buffer.
    term-input-filter is the default: returns T if the input isn't all white
	space.

If the term is Lucid Common Lisp, 
    term-get-old-input snarfs the sexp ending at point.
    term-input-filter-functions does nothing.
    term-input-filter returns NIL if the input matches input-filter-regexp,
        which matches (1) all whitespace (2) :a, :c, etc.

Similarly for Soar, Scheme, etc."
  (interactive)
  ;; Note that the input string does not include its terminal newline.
  (let ((proc (get-buffer-process (current-buffer))))
    (if (not proc) (error "Current buffer has no process")
      (let* ((pmark (process-mark proc))
	     (pmark-val (marker-position pmark))
1456 1457 1458 1459
	     (input-is-new (>= (point) pmark-val))
	     (intxt (if input-is-new
			(progn (if term-eol-on-send (end-of-line))
			       (buffer-substring pmark (point)))
Richard M. Stallman's avatar
Richard M. Stallman committed
1460 1461 1462 1463 1464 1465 1466 1467 1468 1469 1470 1471 1472 1473 1474 1475 1476
		      (funcall term-get-old-input)))
	     (input (if (not (eq term-input-autoexpand 'input))
			;; Just whatever's already there
			intxt
		      ;; Expand and leave it visible in buffer
		      (term-replace-by-expanded-history t)
		      (buffer-substring pmark (point))))
	     (history (if (not (eq term-input-autoexpand 'history))
			  input
			;; This is messy 'cos ultimately the original
			;; functions used do insertion, rather than return
			;; strings.  We have to expand, then insert back.
			(term-replace-by-expanded-history t)
			(let ((copy (buffer-substring pmark (point))))
			  (delete-region pmark (point))
			  (insert input)
			  copy))))
1477
	(if (term-pager-enabled)
Richard M. Stallman's avatar
Richard M. Stallman committed
1478 1479 1480 1481 1482 1483 1484 1485 1486 1487 1488 1489 1490 1491 1492
	    (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))
	(let ((functions term-input-filter-functions))
	  (while functions
	    (funcall (car functions) (concat input "\n"))
	    (setq functions (cdr functions))))
	(setq term-input-ring-index nil)
1493

Richard M. Stallman's avatar
Richard M. Stallman committed
1494 1495 1496 1497
	;; Update the markers before we send the input
	;; in case we get output amidst sending the input.
	(set-marker term-last-input-start pmark)
	(set-marker term-last-input-end (point))
1498 1499 1500 1501 1502 1503 1504 1505
	(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))))
	(goto-char pmark)
Richard M. Stallman's avatar
Richard M. Stallman committed
1506 1507 1508 1509 1510 1511 1512 1513 1514 1515 1516 1517 1518 1519 1520 1521 1522 1523 1524 1525 1526 1527 1528 1529 1530 1531 1532 1533 1534 1535 1536 1537 1538 1539 1540 1541 1542 1543 1544 1545 1546 1547 1548 1549 1550 1551 1552 1553 1554 1555 1556 1557 1558 1559 1560 1561 1562 1563 1564 1565 1566 1567 1568 1569 1570 1571 1572 1573 1574 1575 1576 1577 1578 1579 1580 1581 1582 1583 1584 1585 1586 1587 1588 1589
	(funcall term-input-sender proc input)))))

(defun term-get-old-input-default ()
  "Default for term-get-old-input.
Take the current line, and discard any initial text matching
term-prompt-regexp."
  (save-excursion
    (beginning-of-line)
    (term-skip-prompt)
    (let ((beg (point)))
      (end-of-line)
      (buffer-substring beg (point)))))

(defun term-copy-old-input ()
  "Insert after prompt old input at point as new input to be edited.
Calls `term-get-old-input' to get old input."
  (interactive)
  (let ((input (funcall term-get-old-input))
 	(process (get-buffer-process (current-buffer))))
    (if (not process)
	(error "Current buffer has no process")
      (goto-char (process-mark process))
      (insert input))))

(defun term-skip-prompt ()
  "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)))))


(defun term-after-pmark-p ()
  "Is point after the process output marker?"
  ;; Since output could come into the buffer after we looked at the point
  ;; but before we looked at the process marker's value, we explicitly 
  ;; serialise. This is just because I don't know whether or not emacs
  ;; services input during execution of lisp commands.
  (let ((proc-pos (marker-position
		   (process-mark (get-buffer-process (current-buffer))))))
    (<= proc-pos (point))))

(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."
  (term-send-string proc string)
  (term-send-string proc "\n"))

(defun term-bol (arg)
  "Goes to the beginning of line, then skips past the prompt, if any.
If a prefix argument is given (\\[universal-argument]), then no prompt skip 
-- go straight to column 0.

The prompt skip is done by skipping text matching the regular expression
term-prompt-regexp, a buffer local variable."
  (interactive "P")
  (beginning-of-line)
  (if (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.
;;; Just enter m-x term-send-invisible and type in your line.

(defun term-read-noecho (prompt &optional stars)
  "Read a single line of text from user without echoing, and return it. 
Prompt with argument PROMPT, a string.  Optional argument STARS causes
input to be echoed with '*' characters on the prompt line.  Input ends with
RET, LFD, or ESC.  DEL or C-h rubs out.  C-u kills line.  C-g aborts (if
`inhibit-quit' is set because e.g. this function was called from a process
filter and C-g is pressed, this function returns nil rather than a string).

Note that the keystrokes comprising the text can still be recovered
\(temporarily) with \\[view-lossage].  This may be a security bug for some
applications."
  (let ((ans "")
	(c 0)
	(echo-keystrokes 0)
	(cursor-in-echo-area t)
        (done nil))
    (while (not done)
      (if stars
          (message "%s%s" prompt (make-string (length ans) ?*))
1590
        (message "%s" prompt))
Richard M. Stallman's avatar
Richard M. Stallman committed
1591 1592 1593 1594 1595 1596 1597 1598 1599 1600 1601 1602 1603 1604 1605 1606 1607 1608 1609 1610 1611 1612 1613 1614 1615 1616 1617 1618 1619 1620 1621 1622 1623 1624 1625 1626 1627 1628 1629 1630 1631 1632 1633 1634 1635 1636 1637 1638 1639 1640 1641 1642 1643 1644 1645 1646 1647 1648 1649 1650 1651 1652 1653 1654 1655 1656 1657 1658 1659 1660 1661 1662 1663 1664 1665 1666 1667 1668 1669 1670 1671 1672 1673 1674 1675 1676 1677 1678 1679 1680 1681 1682 1683 1684 1685 1686 1687 1688 1689 1690 1691 1692 1693 1694 1695 1696 1697 1698 1699 1700 1701 1702 1703 1704 1705 1706 1707 1708 1709 1710 1711 1712 1713 1714 1715 1716 1717 1718 1719 1720 1721 1722 1723 1724 1725 1726 1727 1728 1729 1730 1731 1732 1733 1734 1735 1736 1737 1738 1739 1740 1741 1742 1743 1744 1745 1746 1747 1748 1749 1750 1751 1752 1753 1754 1755 1756 1757 1758 1759 1760 1761 1762 1763 1764 1765 1766 1767 1768 1769 1770 1771 1772 1773 1774 1775 1776 1777 1778 1779 1780 1781 1782 1783 1784 1785 1786 1787 1788 1789 1790 1791 1792 1793 1794 1795 1796 1797 1798 1799 1800 1801 1802 1803 1804 1805 1806 1807 1808 1809 1810 1811 1812 1813 1814 1815 1816 1817 1818 1819 1820 1821 1822 1823 1824 1825 1826 1827 1828 1829 1830 1831 1832 1833 1834 1835 1836 1837 1838 1839 1840 1841 1842 1843 1844 1845 1846 1847 1848 1849 1850 1851 1852 1853 1854 1855 1856 1857 1858 1859 1860 1861