-;;; 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, 2002, 2003,
+;; 2004, 2005, 2006 Free Software Foundation, Inc.
;; Author: Richard Mlynarik <mly@eddie.mit.edu>
;; Maintainer: FSF
;; 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, 675 Mass Ave, Cambridge, MA 02139, USA.
+;; along with GNU Emacs; see the file COPYING. If not, write to the
+;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
+;; Boston, MA 02110-1301, USA.
+
+;;; 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:
(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)
(define-key map "\r" 'te-more-break-advance-one-line)
(setq terminal-more-break-map map)))
-
+
\f
;;; Pacify the byte compiler
(defvar te-process nil)
(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
(defun te-escape ()
(interactive)
- (let (s
- (local (current-local-map))
- (global (current-global-map)))
+ (let (s
+ (local (current-local-map))
+ (global (current-global-map)))
(unwind-protect
- (progn
- (use-global-map terminal-escape-map)
- (use-local-map terminal-escape-map)
- (setq s (read-key-sequence
- (if current-prefix-arg
- (format "Emacs Terminal escape> %d "
- (prefix-numeric-value current-prefix-arg))
- "Emacs Terminal escape> "))))
+ (progn
+ (use-global-map terminal-escape-map)
+ (use-local-map terminal-escape-map)
+ (setq s (read-key-sequence
+ (if current-prefix-arg
+ (format "Emacs Terminal escape[%s for help]> %d "
+ (substitute-command-keys
+ "\\<terminal-escape-map>\\[te-escape-help]")
+ (prefix-numeric-value current-prefix-arg))
+ (format "Emacs Terminal escape[%s for help]> "
+ (substitute-command-keys
+ "\\<terminal-escape-map>\\[te-escape-help]"))))))
(use-global-map global)
(use-local-map local))
+
(message "")
- (cond ((string= s (make-string 1 terminal-escape-char))
- (setq last-command-char terminal-escape-char)
- (let ((terminal-escape-char -259))
- (te-pass-through)))
- ((setq s (lookup-key terminal-escape-map s))
- (call-interactively s)))))
+
+ (cond
+ ;; Certain keys give vector notation, like [escape] when
+ ;; you hit esc key...
+ ((and (stringp s)
+ (string= s (make-string 1 terminal-escape-char)))
+ (setq last-command-char terminal-escape-char)
+ (let ((terminal-escape-char -259))
+ (te-pass-through)))
+
+ ((setq s (lookup-key terminal-escape-map s))
+ (call-interactively s)))
+
+ ))
+
(defun te-escape-help ()
"Provide help on commands available after terminal-escape-char is typed."
(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")))
(setq l (cdr l))))
nil)))))
-
+
(defun te-escape-extended-command ()
(interactive)
"Discontinue output log."
(interactive)
(te-set-output-log nil))
-
+
(defun te-toggle (sym arg)
(set sym (cond ((not (numberp arg)) arg)
(cond ((eq last-input-char terminal-escape-char)
(call-interactively 'te-escape))
(t
- ;; Convert `return' to C-m, etc.
+ ;; 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)))
(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."
(interactive)
(terminal-edit-mode)
- (set-buffer-modified-p (buffer-modified-p))
+ (force-mode-line-update)
;; 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 ()
(set-process-filter te-process te-more-old-filter)
(goto-char te-more-old-point)
(setq mode-line-format te-more-old-mode-line-format)
- (set-buffer-modified-p (buffer-modified-p))
+ (force-mode-line-update)
(let ((buffer-read-only nil))
(cond ((eobp))
(terminal-more-break-insertion
(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)
(forward-char 1) (end-of-line)
(delete-region (- (point) te-width) (point))
(insert-char ?\ te-width))))
-
+
;; ^p ^l
(defun te-clear-screen ()
(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 ()
;; (A version of the following comment which might be distractingly offensive
;; to some readers has been moved to term-nasty.el.)
;; unix lacks ITS-style tty control...
-(defun te-process-output (preemptable)
+(defun te-process-output (preemptible)
;;>> There seems no good reason to ever disallow preemption
- (setq preemptable t)
+ (setq preemptible t)
(catch 'te-process-output
(let ((buffer-read-only nil)
(string nil) ostring start char (matchpos nil))
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)
;; (Perhaps some operating system or
;; other is completely incompetent...)
(?\C-m . te-beginning-of-line)
- (?\C-g . te-beep)
- (?\C-h . te-backward-char)
- (?\C-i . te-output-tab))))
+ (?\C-g . te-beep)
+ (?\C-h . te-backward-char)
+ (?\C-i . te-output-tab))))
'te-losing-unix)))
(te-redisplay-if-necessary 1))
- (and preemptable
+ (and preemptible
(input-pending-p)
- ;; preemptable output! Oh my!!
+ ;; 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))
(defun te-update-pending-output-display ()
(if (null (cdr te-pending-output))
- (setq te-pending-output-info "")
+ (setq te-pending-output-info "")
(let ((length (te-pending-output-length)))
(if (< length 1500)
(setq te-pending-output-info "")
(setq te-pending-output-info (format "(%dK chars output pending) "
(/ (+ length 512) 1024))))))
- ;; update mode line
- (set-buffer-modified-p (buffer-modified-p)))
+ (force-mode-line-update))
\f
(defun te-sentinel (process message)
;; 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))
(format "%s; exec %s"
te-stty-string
(mapconcat 'te-quote-arg-for-sh
- (cons program args) " "))))
+ (cons program args) " "))))
(set-process-filter te-process 'te-filter)
(set-process-sentinel te-process 'te-sentinel))
(error (fundamental-mode)
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)))
(concat "\"" harder "\"")))))
(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))))
- (let ( (terminfo
- (concat
- (format "%s,mir, xon,cols#%d, lines#%d,"
+ "Create and compile a terminfo entry for the virtual terminal. This is kept
+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
+ ;; 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