-;;; 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.
;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
;; Boston, MA 02111-1307, USA.
+;;; Commentary:
+
+;;; This file has been censored by the Communications Decency Act.
+;;; That law was passed under the guise of a ban on pornography, but
+;;; it bans far more than that. This file did not contain pornography,
+;;; but it was censored nonetheless.
+
+;;; For information on US government censorship of the Internet, and
+;;; what you can do to bring back freedom of the press, see the web
+;;; site http://www.vtw.org/
+
;;; Code:
;;>>TODO
(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 ***")
(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
;; Make mode line update.
(if (eq (key-binding "\C-c\C-c") 'terminal-cease-edit)
(message "Editing: Type C-c C-c to return to Terminal")
- (message (substitute-command-keys
+ (message "%s"
+ (substitute-command-keys
"Editing: Type \\[terminal-cease-edit] to return to Terminal"))))
(defun terminal-cease-edit ()
(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)
(n (min (- (te-get-char) ?\ ) 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))))))
+ (or (eq i line) (insert ?\n))))))
(setq te-more-count -1))
(while (< i n)
(setq i (1+ i))
(insert-char ?\ te-width)
- (or (eql i line) (insert ?\n))))))
+ (or (eq i line) (insert ?\n))))))
(setq te-more-count -1))
;; ^p ^a
\f
-;; disgusting unix-required shit
+;; disgusting unix-required excrement
;; Are we living twenty years in the past yet?
(defun te-losing-unix ()
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.
(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))
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"
+in the directory specified by `te-terminfo-directory'."
(if (and system-uses-terminfo
- (not (file-exists-p (concat "/tmp/"
+ (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")) )
+ "il1=^P^O!, ind=^P\\n, nel=\\n,\n"))
+ ;; The last newline avoids trouble with ncurses.
+ (file-name (concat te-terminfo-directory te-terminal-name ".tif")) )
+ (make-directory te-terminfo-directory t)
(save-excursion
(set-buffer (create-file-buffer file-name))
(insert terminfo)
(kill-buffer nil)
)
(let ( (process-environment
- (cons (concat "TERMINFO=" "/tmp")
+ (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 ()
"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)
HCoop / bpt / emacs.git / blobdiff