;;; terminal.el --- terminal emulator for GNU Emacs.
-;; Copyright (C) 1986, 1987, 1988, 1989, 1993 Free Software Foundation, Inc.
+;; Copyright (C) 1986,87,88,89,93,94 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., 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
-;;>> terminfo?
;;>> ** Nothing can be done about emacs' meta-lossage **
;;>> (without redoing keymaps `sanely' -- ask Mly for details)
(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 ***")
nil
(let ((map (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 "\C-l"
; '(lambda () (interactive) (te-pass-through) (redraw-display)))
(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-more-old-mode-line-format nil)
(defvar te-pending-output-info nil)
+;; Required to support terminfo systems
+(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 prefix-arg
- (format "Emacs Terminal escape> %d "
- (prefix-numeric-value 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)))
;; Convert meta characters to 8-bit form for transmission.
(if (and (integerp last-input-char)
- (not (zerop (logand last-input-char (lsh 1 23)))))
+ (not (zerop (logand last-input-char ?\M-\^@))))
(setq last-input-char (+ 128 (logand last-input-char 127))))
;; Now ignore all but actual characters.
;; (It ought to be possible to send through function
(defun terminal-edit-mode ()
"Major mode for editing the contents of a terminal-emulator buffer.
The editing commands are the same as in Fundamental mode,
-together with a command \\<terminal-edit-mode-map>to return to terminal emulation: \\[terminal-cease-edit]."
+together with a command \\<terminal-edit-map>to return to terminal emulation: \\[terminal-cease-edit]."
(use-local-map terminal-edit-map)
(setq major-mode 'terminal-edit-mode)
(setq mode-name "Terminal 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 ()
(setq te-more-count -1)))
(setq mode-line-modified (default-value 'mode-line-modified))
+ (use-local-map terminal-map)
(setq major-mode 'terminal-mode)
(setq mode-name "terminal")
- (setq mode-line-process '(": %s")))
+ (setq mode-line-process '(":%s")))
\f
;;;; more break hair
(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))
(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)
This function calls the value of terminal-mode-hook if that exists
and is non-nil after the terminal buffer has been set up and the
-subprocess started.
-
-Presently with `termcap' only; if somebody sends us code to make this
-work with `terminfo' we will try to use it."
+subprocess started."
(interactive
(cons (save-excursion
(set-buffer (get-buffer-create "*terminal*"))
(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 mode-line-buffer-identification
(list (format "Emacs terminal %dx%d: %%b " te-width te-height)
'te-pending-output-info))
(delete-process process)
(error "Process %s not killed" (process-name process)))))
(condition-case err
- (let ((termcap
- ;; Because of Unix Brain Death(tm), we can't change
- ;; the terminal type of a running process, and so
- ;; terminal size and scrollability are wired-down
- ;; at this point. ("Detach? What's that?")
- (concat (format "emacs-virtual:co#%d:li#%d:%s"
- ;; Sigh. These can't be dynamically changed.
- te-width te-height (if terminal-scrolling
- "" "ns:"))
- ;;-- Basic things
- ;; cursor-motion, bol, forward/backward char
- "cm=^p=%+ %+ :cr=^p^a:le=^p^b:nd=^p^f:"
- ;; newline, clear eof/eof, audible bell
- "nw=^j:ce=^pc:cd=^pC:cl=^p^l:bl=^p^g:"
- ;; insert/delete char/line
- "IC=^p_%+ :DC=^pd%+ :AL=^p^o%+ :DL=^p^k%+ :"
- ;;-- Not-widely-known (ie nonstandard) flags, which mean
- ;; o writing in the last column of the last line
- ;; doesn't cause idiotic scrolling, and
- ;; o don't use idiotische c-s/c-q sogenannte
- ;; ``flow control'' auf keinen Fall.
- "LP:NF:"
- ;;-- For stupid or obsolete programs
- "ic=^p_!:dc=^pd!:al=^p^o!:dl=^p^k!:ho=^p= :"
- ;;-- For disgusting programs.
- ;; (VI? What losers need these, I wonder?)
- "im=:ei=:dm=:ed=:mi:do=^p^j:nl=^p^j:bs:")))
- (let ((process-environment
- (cons "TERM=emacs-virtual"
- (cons (concat "TERMCAP=" termcap)
- process-environment))))
- (setq te-process
- (start-process "terminal-emulator" (current-buffer)
- "/bin/sh" "-c"
- ;; Yuck!!! Start a shell to set some terminal
- ;; control characteristics. Then start the
- ;; "env" program to setup the terminal type
- ;; Then finally start the program we wanted.
- (format "%s; exec %s"
- te-stty-string
- (mapconcat 'te-quote-arg-for-sh
- (cons program args) " ")))))
+ (let ((process-environment
+ (cons (concat "TERM=" te-terminal-name)
+ (cons (concat "TERMCAP=" (te-create-termcap))
+ (cons (concat "TERMINFO=" (te-create-terminfo))
+ process-environment)))))
+ (setq te-process
+ (start-process "terminal-emulator" (current-buffer)
+ "/bin/sh" "-c"
+ ;; Yuck!!! Start a shell to set some terminal
+ ;; control characteristics. Then start the
+ ;; "env" program to setup the terminal type
+ ;; Then finally start the program we wanted.
+ (format "%s; exec %s"
+ te-stty-string
+ (mapconcat 'te-quote-arg-for-sh
+ (cons program args) " "))))
(set-process-filter te-process 'te-filter)
(set-process-sentinel te-process 'te-sentinel))
(error (fundamental-mode)
(defun te-parse-program-and-args (s)
- (cond ((string-match "\\`\\([a-zA-Z0-9-+=_.@/:]+[ \t]*\\)+\\'" s)
+ (cond ((string-match "\\`\\([-a-zA-Z0-9+=_.@/:]+[ \t]*\\)+\\'" s)
(let ((l ()) (p 0))
(while p
(setq l (cons (if (string-match
- "\\([a-zA-Z0-9-+=_.@/:]+\\)\\([ \t]+\\)*"
+ "\\([-a-zA-Z0-9+=_.@/:]+\\)\\([ \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)))
(setq mode-name "terminal")
; (make-local-variable 'Helper-return-blurb)
; (setq Helper-return-blurb "return to terminal simulator")
- (setq mode-line-process '(": %s"))
+ (setq mode-line-process '(":%s"))
(setq buffer-read-only t)
(setq truncate-lines t)
(make-local-variable 'terminal-escape-char)
;;;; what a complete loss
(defun te-quote-arg-for-sh (string)
- (cond ((string-match "\\`[a-zA-Z0-9-+=_.@/:]+\\'"
+ (cond ((string-match "\\`[-a-zA-Z0-9+=_.@/:]+\\'"
string)
string)
((not (string-match "[$]" string))
start (1+ end)))
(concat "\"" harder "\"")))))
+(defun te-create-terminfo ()
+ "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 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,\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="
+ (directory-file-name te-terminfo-directory))
+ process-environment)) )
+ (set-process-sentinel (start-process "tic" nil "tic" file-name)
+ 'te-tic-sentinel))))
+ (directory-file-name te-terminfo-directory)
+)
+
+(defun te-create-termcap ()
+ "Create a termcap entry for the virtual terminal"
+ ;; Because of Unix Brain Death(tm), we can't change
+ ;; the terminal type of a running process, and so
+ ;; terminal size and scrollability are wired-down
+ ;; at this point. ("Detach? What's that?")
+ (concat (format "%s:co#%d:li#%d:%s"
+ ;; Sigh. These can't be dynamically changed.
+ te-terminal-name te-width te-height (if terminal-scrolling
+ "" "ns:"))
+ ;;-- Basic things
+ ;; cursor-motion, bol, forward/backward char
+ "cm=^p=%+ %+ :cr=^p^a:le=^p^b:nd=^p^f:"
+ ;; newline, clear eof/eof, audible bell
+ "nw=^j:ce=^pc:cd=^pC:cl=^p^l:bl=^p^g:"
+ ;; insert/delete char/line
+ "IC=^p_%+ :DC=^pd%+ :AL=^p^o%+ :DL=^p^k%+ :"
+ ;;-- Not-widely-known (ie nonstandard) flags, which mean
+ ;; o writing in the last column of the last line
+ ;; doesn't cause idiotic scrolling, and
+ ;; o don't use idiotische c-s/c-q sogenannte
+ ;; ``flow control'' auf keinen Fall.
+ "LP:NF:"
+ ;;-- For stupid or obsolete programs
+ "ic=^p_!:dc=^pd!:al=^p^o!:dl=^p^k!:ho=^p= :"
+ ;;-- For disgusting programs.
+ ;; (VI? What losers need these, I wonder?)
+ "im=:ei=:dm=:ed=:mi:do=^p^j:nl=^p^j:bs:")
+)
+
+(defun te-tic-sentinel (proc state-change)
+ "If tic has finished, delete the .tif file"
+ (if (equal state-change "finished
+")
+ (delete-file (concat te-terminfo-directory te-terminal-name ".tif"))))
+
(provide 'terminal)
;;; terminal.el ends here
HCoop / bpt / emacs.git / blobdiff