-;;; terminal.el --- terminal emulator for GNU Emacs.
+;;; terminal.el --- terminal emulator for GNU Emacs
-;; Copyright (C) 1986,87,88,89,93,94 Free Software Foundation, Inc.
+;; Copyright (C) 1986, 1987, 1988, 1989, 1993, 1994, 2001, 2002, 2003,
+;; 2004, 2005, 2006, 2007, 2008 Free Software Foundation, Inc.
;; Author: Richard Mlynarik <mly@eddie.mit.edu>
;; Maintainer: FSF
;; This file is part of GNU Emacs.
-;; GNU Emacs is free software; you can redistribute it and/or modify
+;; GNU Emacs is free software: you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
-;; the Free Software Foundation; either version 2, or (at your option)
-;; any later version.
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
;; GNU Emacs is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; GNU General Public License for more details.
;; You should have received a copy of the GNU General Public License
-;; along with GNU Emacs; see the file COPYING. If not, write to the
-;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
-;; Boston, MA 02111-1307, USA.
+;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
;;; Commentary:
(require 'ehelp)
-(defvar terminal-escape-char ?\C-^
+(defgroup terminal nil
+ "Terminal emulator for Emacs."
+ :group 'terminals)
+
+
+(defcustom terminal-escape-char ?\C-^
"*All characters except for this are passed verbatim through the
terminal-emulator. This character acts as a prefix for commands
to the emulator program itself. Type this character twice to send
it through the emulator. Type ? after typing it for a list of
possible commands.
-This variable is local to each terminal-emulator buffer.")
+This variable is local to each terminal-emulator buffer."
+ :type 'character
+ :group 'terminal)
-(defvar terminal-scrolling t ;;>> Setting this to T sort-of defeats my whole aim in writing this package...
+(defcustom terminal-scrolling t ;;>> Setting this to t sort-of defeats my whole aim in writing this package...
"*If non-nil, the terminal-emulator will losingly `scroll' when output occurs
past the bottom of the screen. If nil, output will win and `wrap' to the top
of the screen.
-This variable is local to each terminal-emulator buffer.")
+This variable is local to each terminal-emulator buffer."
+ :type 'boolean
+ :group 'terminal)
-(defvar terminal-more-processing t
+(defcustom terminal-more-processing t
"*If non-nil, do more-processing.
-This variable is local to each terminal-emulator buffer.")
+This variable is local to each terminal-emulator buffer."
+ :type 'boolean
+ :group 'terminal)
;; If you are the sort of loser who uses scrolling without more breaks
;; and expects to actually see anything, you should probably set this to
;; around 400
-(defvar terminal-redisplay-interval 5000
+(defcustom terminal-redisplay-interval 5000
"*Maximum number of characters which will be processed by the
terminal-emulator before a screen redisplay is forced.
Set this to a large value for greater throughput,
set it smaller for more frequent updates but overall slower
-performance.")
+performance."
+ :type 'integer
+ :group 'terminal)
(defvar terminal-more-break-insertion
"*** More break -- Press space to continue ***")
(if terminal-map
nil
(let ((map (make-sparse-keymap)))
+ ;; Prevent defining [menu-bar] as te-pass-through
+ ;; so we allow the global menu bar to be visible.
+ (define-key map [menu-bar] (make-sparse-keymap))
(define-key map [t] 'te-pass-through)
(define-key map [switch-frame] 'handle-switch-frame)
(define-key map "\e" terminal-meta-map)
(defvar te-pending-output-info nil)
;; Required to support terminfo systems
-(defconst te-terminal-name-prefix "emacs-virtual")
+(defconst te-terminal-name-prefix "emacs-em"
+ "Prefix used for terminal type names for Terminfo.")
+(defconst te-terminfo-directory
+ (file-name-as-directory
+ (expand-file-name "emacs-terminfo" temporary-file-directory))
+ "Directory used for run-time terminal definition files for Terminfo.")
(defvar te-terminal-name nil)
\f
;;;; escape map
(use-local-map terminal-escape-map)
(setq s (read-key-sequence
(if current-prefix-arg
- (format "Emacs Terminal escape> %d "
+ (format "Emacs Terminal escape[%s for help]> %d "
+ (substitute-command-keys
+ "\\<terminal-escape-map>\\[te-escape-help]")
(prefix-numeric-value current-prefix-arg))
- "Emacs Terminal escape> "))))
+ (format "Emacs Terminal escape[%s for help]> "
+ (substitute-command-keys
+ "\\<terminal-escape-map>\\[te-escape-help]"))))))
(use-global-map global)
(use-local-map local))
(where-is-internal 'te-escape-extended-command
terminal-escape-map t)
'te-escape-extended-command))
- (let ((l (if (fboundp 'sortcar)
- (sortcar (copy-sequence te-escape-command-alist)
- 'string<)
- (sort (copy-sequence te-escape-command-alist)
- (function (lambda (a b)
- (string< (car a) (car b))))))))
+ (let ((l (sort (copy-sequence te-escape-command-alist)
+ (function (lambda (a b)
+ (string< (car a) (car b)))))))
(while l
(let ((doc (or (documentation (cdr (car l)))
"Not documented")))
(progn
(and terminal-more-processing (null (cdr te-pending-output))
(te-set-more-count nil))
- (send-string te-process (make-string 1 last-input-char))
+ (process-send-string te-process (make-string 1 last-input-char))
(te-process-output t))
(message "Function key `%s' ignored"
(single-key-description last-input-char))))))
(setq mode-name "Terminal Edit")
(setq mode-line-modified (default-value 'mode-line-modified))
(setq mode-line-process nil)
- (run-hooks 'terminal-edit-mode-hook))
+ (run-mode-hooks 'terminal-edit-mode-hook))
(defun te-edit ()
"Start editing the terminal emulator buffer with ordinary Emacs commands."
(let ((p (point)))
(cond ((search-forward "\n" (+ p width) 'move)
(forward-char -1)
- (insert-char ?\ (- width (- (point) p)))
+ (insert-char ?\s (- width (- (point) p)))
(forward-char 1))
((eobp)
- (insert-char ?\ (- width (- (point) p))))
+ (insert-char ?\s (- width (- (point) p))))
((= (following-char) ?\n)
(forward-char 1))
(t
(forward-char 1)
(delete-region (point)
(+ (point) (length terminal-more-break-insertion)))
- (insert-char ?\ te-width)
+ (insert-char ?\s te-width)
(goto-char te-more-old-point)))
(setq te-more-old-point nil)
(let ((te-more-count 259259))
(cond ((not terminal-more-processing))
((< (setq te-more-count (1- te-more-count)) 0)
(te-set-more-count t))
- ((eql te-more-count 0)
+ ((eq te-more-count 0)
;; this doesn't return
(te-more-break)))
(if (eobp)
(insert ?\n))))
(forward-char 1)
(delete-region (point) (+ (point) te-width)))
- (insert-char ?\ te-width)
+ (insert-char ?\s te-width)
(beginning-of-line)
(te-set-window-start))
(save-excursion
(let ((n (- (point) (progn (end-of-line) (point)))))
(delete-region (point) (+ (point) n))
- (insert-char ?\ (- n)))))
+ (insert-char ?\s (- n)))))
;; ^p C
(while (progn (end-of-line) (not (eobp)))
(forward-char 1) (end-of-line)
(delete-region (- (point) te-width) (point))
- (insert-char ?\ te-width))))
+ (insert-char ?\s te-width))))
;; ^p ^l
(let ((i 0))
(while (< i te-height)
(setq i (1+ i))
- (insert-char ?\ te-width)
+ (insert-char ?\s te-width)
(insert ?\n)))
(delete-region (1- (point-max)) (point-max))
(goto-char (point-min))
();(error "fooI")
(save-excursion
(let* ((line (- te-height (/ (- (point) (point-min)) (1+ te-width)) -1))
- (n (min (- (te-get-char) ?\ ) line))
+ (n (min (- (te-get-char) ?\s) line))
(i 0))
(delete-region (- (point-max) (* n (1+ te-width))) (point-max))
- (if (eql (point) (point-max)) (insert ?\n))
+ (if (eq (point) (point-max)) (insert ?\n))
(while (< i n)
(setq i (1+ i))
- (insert-char ?\ te-width)
- (or (eql i line) (insert ?\n))))))
+ (insert-char ?\s te-width)
+ (or (eq i line) (insert ?\n))))))
(setq te-more-count -1))
(if (not (bolp))
();(error "fooD")
(let* ((line (- te-height (/ (- (point) (point-min)) (1+ te-width)) -1))
- (n (min (- (te-get-char) ?\ ) line))
+ (n (min (- (te-get-char) ?\s) line))
(i 0))
(delete-region (point)
(min (+ (point) (* n (1+ te-width))) (point-max)))
(goto-char (point-max))
(while (< i n)
(setq i (1+ i))
- (insert-char ?\ te-width)
- (or (eql i line) (insert ?\n))))))
+ (insert-char ?\s te-width)
+ (or (eq i line) (insert ?\n))))))
(setq te-more-count -1))
;; ^p ^a
(if (bolp)
()
(delete-region (1- (point)) (point))
- (insert ?\ )
+ (insert ?\s)
(forward-char -1)))
;; ^p ^g
nil
(delete-char (- n))
(goto-char p)
- (insert-char ?\ n))
+ (insert-char ?\s n))
(goto-char p)))
;; ^p d count+32 (should be ^p ^d but cretinous un*x won't send ^d chars!!!)
(- (progn (end-of-line) (point)) p))))
(if (<= n 0)
nil
- (insert-char ?\ n)
+ (insert-char ?\s n)
(goto-char p)
(delete-char n))
(goto-char p)))
(delete-char 1)
(goto-char (point-max))
(insert ?\n)
- (insert-char ?\ te-width)
+ (insert-char ?\s te-width)
(beginning-of-line))
(forward-line 1))
(move-to-column column))
start (car te-pending-output)
string (car (cdr te-pending-output))
char (aref string start))
- (if (eql (setq start (1+ start)) (length string))
+ (if (eq (setq start (1+ start)) (length string))
(progn (setq te-pending-output
(cons 0 (cdr (cdr te-pending-output)))
start 0
(if (and (> char ?\037) (< char ?\377))
(cond ((eolp)
;; unread char
- (if (eql start 0)
+ (if (eq start 0)
(setq te-pending-output
(cons 0 (cons (make-string 1 char)
(cdr te-pending-output))))
(setq char (point)) (end-of-line)
(setq end (min end (+ start (- (point) char))))
(goto-char char)
- (if (eql end matchpos) (setq matchpos nil))
+ (if (eq end matchpos) (setq matchpos nil))
(delete-region (point) (+ (point) (- end start)))
- (insert (if (and (eql start 0)
- (eql end (length string)))
+ (insert (if (and (eq start 0)
+ (eq end (length string)))
string
(substring string start end)))
- (if (eql end (length string))
+ (if (eq end (length string))
(setq te-pending-output
(cons 0 (cdr (cdr te-pending-output))))
(setcar te-pending-output end))
;; function we could trivially emulate different terminals
;; Who cares in any case? (Apart from stupid losers using rlogin)
(funcall
- (if (eql char ?\^p)
+ (if (eq char ?\^p)
(or (cdr (assq (te-get-char)
'((?= . te-move-to-position)
(?c . te-clear-rest-of-line)
;; preemptible output! Oh my!!
(throw 'te-process-output t)))))
;; We must update window-point in every window displaying our buffer
- (let* ((s (selected-window))
- (w s))
- (while (not (eq s (setq w (next-window w))))
- (if (eq (window-buffer w) (current-buffer))
- (set-window-point w (point))))))
+ (walk-windows (lambda (w)
+ (when (and (not (eq w (selected-window)))
+ (eq (window-buffer w) (current-buffer)))
+ (set-window-point w (point))))))
(defun te-get-char ()
(if (cdr te-pending-output)
(let ((start (car te-pending-output))
(string (car (cdr te-pending-output))))
(prog1 (aref string start)
- (if (eql (setq start (1+ start)) (length string))
+ (if (eq (setq start (1+ start)) (length string))
(setq te-pending-output (cons 0 (cdr (cdr te-pending-output))))
(setcar te-pending-output start))))
(catch 'char
(progn
(set-process-filter te-process
(function (lambda (p s)
- (or (eql (length s) 1)
+ (or (eq (length s) 1)
(setq te-pending-output (list 1 s)))
(throw 'char (aref s 0)))))
(accept-process-output te-process))
;; This used to have `new' in it, but that loses outside BSD
;; and it's apparently not needed in BSD.
-(defvar explicit-shell-file-name nil
- "*If non-nil, is file name to use for explicitly requested inferior shell.")
+(defcustom explicit-shell-file-name nil
+ "*If non-nil, is file name to use for explicitly requested inferior shell."
+ :type '(choice (const :tag "None" nil)
+ file)
+ :group 'terminal)
;;;###autoload
(defun terminal-emulator (buffer program args &optional width height)
ARGS is a list of argument-strings. Remaining arguments are WIDTH and HEIGHT.
BUFFER's contents are made an image of the display generated by that program,
and any input typed when BUFFER is the current Emacs buffer is sent to that
-program an keyboard input.
+program as keyboard input.
Interactively, BUFFER defaults to \"*terminal*\" and PROGRAM and ARGS
are parsed from an input-string using your usual shell.
`Meta' characters may not currently be sent through the terminal emulator.
-Here is a list of some of the variables which control the behaviour
+Here is a list of some of the variables which control the behavior
of the emulator -- see their documentation for more information:
terminal-escape-char, terminal-scrolling, terminal-more-processing,
terminal-redisplay-interval.
(getenv "SHELL")
"/bin/sh"))
(s (read-string
- (format "Run program in emulator: (default %s) "
+ (format "Run program in emulator (default %s): "
default-s))))
(if (equal s "")
(list default-s '())
(if (null height) (setq height (- (window-height (selected-window)) 1)))
(terminal-mode)
(setq te-width width te-height height)
- (setq te-terminal-name (concat te-terminal-name-prefix "-" te-width
- te-height))
+ (setq te-terminal-name (concat te-terminal-name-prefix
+ (number-to-string te-width)
+ (number-to-string te-height)))
(setq mode-line-buffer-identification
(list (format "Emacs terminal %dx%d: %%b " te-width te-height)
'te-pending-output-info))
(setq inhibit-quit t) ;sport death
(use-local-map terminal-map)
(run-hooks 'terminal-mode-hook)
- (message "Entering emacs terminal-emulator... Type %s %s for help"
+ (message "Entering Emacs terminal-emulator... Type %s %s for help"
(single-key-description terminal-escape-char)
(mapconcat 'single-key-description
(where-is-internal 'te-escape-help terminal-escape-map t)
s p)
(prog1 (substring s p (match-end 1))
(setq p (match-end 0))
- (if (eql p (length s)) (setq p nil)))
+ (if (eq p (length s)) (setq p nil)))
(prog1 (substring s p)
(setq p nil)))
l)))
(defun te-create-terminfo ()
"Create and compile a terminfo entry for the virtual terminal. This is kept
-in the /tmp directory"
- (if (and system-uses-terminfo
- (not (file-exists-p (concat "/tmp/"
- (substring te-terminal-name-prefix 0 1)
- "/" te-terminal-name))))
+in the directory specified by `te-terminfo-directory'."
+ (when (and system-uses-terminfo
+ (not (file-exists-p (concat te-terminfo-directory
+ (substring te-terminal-name-prefix 0 1)
+ "/" te-terminal-name))))
(let ( (terminfo
(concat
- (format "%s,mir, xon,cols#%d, lines#%d,"
+ ;; The first newline avoids trouble with ncurses.
+ (format "%s,\n\tmir, xon,cols#%d, lines#%d,"
te-terminal-name te-width te-height)
"bel=^P^G, clear=^P\\f, cr=^P^A, cub1=^P^B, cud1=^P\\n,"
"cuf1=^P^F, cup=^P=%p1%'\\s'%+%c%p2%'\\s'%+%c,"
"dch=^Pd%p1%'\\s'%+%c, dch1=^Pd!, dl=^P^K%p1%'\\s'%+%c,"
"dl1=^P^K!, ed=^PC, el=^Pc, home=^P=\\s\\s,"
"ich=^P_%p1%'\\s'%+%c, ich1=^P_!, il=^P^O%p1%'\\s'%+%c,"
- "il1=^P^O!, ind=^P\\n, nel=\\n,"))
- (file-name (concat "/tmp/" te-terminal-name ".tif")) )
- (save-excursion
- (set-buffer (create-file-buffer file-name))
- (insert terminfo)
- (write-file file-name)
- (kill-buffer nil)
- )
- (let ( (process-environment
- (cons (concat "TERMINFO=" "/tmp")
- process-environment)) )
+ ;; The last newline avoids trouble with ncurses.
+ "il1=^P^O!, ind=^P\\n, nel=\\n,\n"))
+ ;; This is the desired name for the source file.
+ (file-name (concat te-terminfo-directory te-terminal-name ".tif")) )
+ (make-directory te-terminfo-directory t)
+ (let ((temp-file
+ (make-temp-file (expand-file-name "tif" te-terminfo-directory))))
+ ;; Store the source file under a random temp name.
+ (with-temp-file temp-file
+ (insert terminfo))
+ ;; Rename it to the desired name.
+ ;; We use this roundabout approach
+ ;; to avoid any risk of writing a name that
+ ;; was michievouslyt set up as a symlink.
+ (rename-file temp-file file-name))
+ ;; Now compile that source to make the binary that the
+ ;; programs actually use.
+ (let ((process-environment
+ (cons (concat "TERMINFO="
+ (directory-file-name te-terminfo-directory))
+ process-environment)))
(set-process-sentinel (start-process "tic" nil "tic" file-name)
'te-tic-sentinel))))
- "/tmp"
-)
+ (directory-file-name te-terminfo-directory))
(defun te-create-termcap ()
"Create a termcap entry for the virtual terminal"
"If tic has finished, delete the .tif file"
(if (equal state-change "finished
")
- (delete-file (concat "/tmp/" te-terminal-name ".tif"))))
+ (delete-file (concat te-terminfo-directory te-terminal-name ".tif"))))
(provide 'terminal)
+;; arch-tag: 0ae1d7d7-90ef-4566-a531-6e7ff8c79b2f
;;; terminal.el ends here