;; 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., 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:
(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 ***")
(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 "/tmp/emacs-terminfo/"
+ "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> %d "
+ (prefix-numeric-value current-prefix-arg))
+ "Emacs Terminal escape> "))))
(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."
(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)))
;; 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)
(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))
(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 "")
;; 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)
(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
+ (setq te-terminal-name (concat te-terminal-name-prefix te-width
te-height))
(setq mode-line-buffer-identification
(list (format "Emacs terminal %dx%d: %%b " te-width te-height)
(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"
+ "Create and compile a terminfo entry for the virtual terminal. This is kept
+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,"
+ (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")) )
+ "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)
(write-file file-name)
(kill-buffer nil)
)
- (let ( (process-environment
- (cons (concat "TERMINFO=" "/tmp")
+ (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 ()
"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)