X-Git-Url: https://code.delx.au/gnu-emacs/blobdiff_plain/d3a4a9867717ddd6daeb6ab576a600c628c9f040..d18a808f42266d6a1873373e6fef9ca6e74a5226:/lisp/terminal.el diff --git a/lisp/terminal.el b/lisp/terminal.el index 6dbd10a2a8..04f98302ec 100644 --- a/lisp/terminal.el +++ b/lisp/terminal.el @@ -19,8 +19,20 @@ ;; 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: @@ -33,33 +45,46 @@ (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 ***") @@ -142,7 +167,7 @@ performance.") (define-key map "\r" 'te-more-break-advance-one-line) (setq terminal-more-break-map map))) - + ;;; Pacify the byte compiler (defvar te-process nil) @@ -160,34 +185,47 @@ performance.") (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) ;;;; 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." @@ -227,7 +265,7 @@ Other chars following \"%s\" are interpreted as follows:\n" (setq l (cdr l)))) nil))))) - + (defun te-escape-extended-command () (interactive) @@ -296,7 +334,7 @@ Very poor man's file transfer protocol." "Discontinue output log." (interactive) (te-set-output-log nil)) - + (defun te-toggle (sym arg) (set sym (cond ((not (numberp arg)) arg) @@ -429,7 +467,7 @@ lets you type a terminal emulator command." (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))) @@ -503,7 +541,8 @@ together with a command \\to return to terminal emulation: \\ ;; 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 () @@ -634,7 +673,7 @@ move to start of new line, clear to end of line." (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) @@ -682,7 +721,7 @@ move to start of new line, clear to end of line." (forward-char 1) (end-of-line) (delete-region (- (point) te-width) (point)) (insert-char ?\ te-width)))) - + ;; ^p ^l (defun te-clear-screen () @@ -707,11 +746,11 @@ move to start of new line, clear to end of line." (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)) @@ -729,7 +768,7 @@ move to start of new line, clear to end of line." (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 @@ -786,7 +825,7 @@ move to start of new line, clear to end of line." -;; disgusting unix-required shit +;; disgusting unix-required excrement ;; Are we living twenty years in the past yet? (defun te-losing-unix () @@ -855,9 +894,9 @@ move to start of new line, clear to end of line." ;; (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)) @@ -866,7 +905,7 @@ move to start of new line, clear to end of line." 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 @@ -876,7 +915,7 @@ move to start of new line, clear to end of line." (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)))) @@ -895,13 +934,13 @@ move to start of new line, clear to end of line." (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)) @@ -910,7 +949,7 @@ move to start of new line, clear to end of line." ;; 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) @@ -940,14 +979,14 @@ move to start of new line, clear to end 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)) @@ -961,7 +1000,7 @@ move to start of new line, clear to end of line." (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 @@ -970,7 +1009,7 @@ move to start of new line, clear to end of line." (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)) @@ -987,7 +1026,7 @@ move to start of new line, clear to end of line." (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 "") @@ -1018,8 +1057,11 @@ move to start of new line, clear to end of line." ;; 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) @@ -1077,7 +1119,7 @@ subprocess started." (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) @@ -1105,7 +1147,7 @@ subprocess started." (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) @@ -1129,7 +1171,7 @@ subprocess started." 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))) @@ -1218,35 +1260,39 @@ of the terminal-emulator" (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 () @@ -1283,7 +1329,7 @@ in the /tmp directory" "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)