X-Git-Url: https://code.delx.au/gnu-emacs/blobdiff_plain/e516799970be4553edae8ca46d5f64852befec77..8e735883f4696be337577300537480fe64f11fdf:/lisp/terminal.el diff --git a/lisp/terminal.el b/lisp/terminal.el index 6e9d954ae3..6ce6824281 100644 --- a/lisp/terminal.el +++ b/lisp/terminal.el @@ -1,10 +1,10 @@ ;;; terminal.el --- terminal emulator for GNU Emacs. +;; Copyright (C) 1986,87,88,89,93,94 Free Software Foundation, Inc. + ;; Author: Richard Mlynarik ;; Maintainer: FSF -;; Last-Modified: 05 May 1992 - -;; Copyright (C) 1986, 1987, 1988, 1989 Free Software Foundation, Inc. +;; Keywords: comm, terminals ;; This file is part of GNU Emacs. @@ -25,7 +25,6 @@ ;;; Code: ;;>>TODO -;;>> terminfo? ;;>> ** Nothing can be done about emacs' meta-lossage ** ;;>> (without redoing keymaps `sanely' -- ask Mly for details) @@ -65,23 +64,29 @@ performance.") (defvar terminal-more-break-insertion "*** More break -- Press space to continue ***") -(defvar terminal-escape-map nil) +(defvar terminal-meta-map nil) +(if terminal-meta-map + nil + (let ((map (make-sparse-keymap))) + (define-key map [t] 'te-pass-through) + (setq terminal-meta-map map))) + (defvar terminal-map nil) -(defvar terminal-more-break-map nil) (if terminal-map nil - (let ((map (make-keymap))) - (fillarray map 'te-pass-through) + (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))) (setq terminal-map map))) -;(setq terminal-escape-map nil) +(defvar terminal-escape-map nil) (if terminal-escape-map nil - (let ((map (make-keymap))) - ;(fillarray map 'te-escape-extended-command-unread) - (fillarray map 'undefined) + (let ((map (make-sparse-keymap))) + (define-key map [t] 'undefined) (let ((s "0")) (while (<= (aref s 0) ?9) (define-key map s 'digit-argument) @@ -99,8 +104,7 @@ performance.") (define-key map (char-to-string help-char) 'te-escape-help) (setq terminal-escape-map map))) -(defvar te-escape-command-alist ()) -;(setq te-escape-command-alist ()) +(defvar te-escape-command-alist nil) (if te-escape-command-alist nil (setq te-escape-command-alist @@ -124,11 +128,11 @@ performance.") ("Set Redisplay Interval" . te-set-redisplay-interval) ))) -;(setq terminal-more-break-map nil) +(defvar terminal-more-break-map nil) (if terminal-more-break-map nil - (let ((map (make-keymap))) - (fillarray map 'te-more-break-unread) + (let ((map (make-sparse-keymap))) + (define-key map [t] 'te-more-break-unread) (define-key map (char-to-string help-char) 'te-more-break-help) (define-key map " " 'te-more-break-resume) (define-key map "\C-l" 'redraw-display) @@ -138,33 +142,62 @@ 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) +(defvar te-log-buffer nil) +(defvar te-height nil) +(defvar te-width nil) +(defvar te-more-count nil) +(defvar te-redisplay-count nil) +(defvar te-pending-output nil) +(defvar te-saved-point) +(defvar te-more-old-point nil) +(defvar te-more-old-local-map nil) +(defvar te-more-old-filter 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-virtual") +(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 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." @@ -182,7 +215,7 @@ Other chars following \"%s\" are interpreted as follows:\n" (princ (substitute-command-keys "\\{terminal-escape-map}\n")) (princ (format "\nSubcommands of \"%s\" (%s)\n" (where-is-internal 'te-escape-extended-command - terminal-escape-map nil t) + terminal-escape-map t) 'te-escape-extended-command)) (let ((l (if (fboundp 'sortcar) (sortcar (copy-sequence te-escape-command-alist) @@ -204,7 +237,7 @@ Other chars following \"%s\" are interpreted as follows:\n" (setq l (cdr l)))) nil))))) - + (defun te-escape-extended-command () (interactive) @@ -224,7 +257,7 @@ Other chars following \"%s\" are interpreted as follows:\n" ;; not used. (defun te-escape-extended-command-unread () (interactive) - (setq unread-command-char last-input-char) + (setq unread-command-events (listify-key-sequence (this-command-keys))) (te-escape-extended-command)) (defun te-set-escape-char (c) @@ -273,7 +306,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) @@ -330,7 +363,7 @@ set it smaller for more frequent updates (but overall slower performance." (put 'te-more-break-unread 'suppress-keymap t) (defun te-more-break-unread () (interactive) - (if (= last-input-char terminal-escape-char) + (if (eq last-input-char terminal-escape-char) (call-interactively 'te-escape) (message "Continuing from more break (\"%s\" typed, %d chars output pending...)" (single-key-description last-input-char) @@ -357,7 +390,7 @@ allowing the next page of output to appear" (princ "Terminal-emulator more break.\n\n") (princ (format "Type \"%s\" (te-more-break-resume)\n%s\n" (where-is-internal 'te-more-break-resume - terminal-more-break-map nil t) + terminal-more-break-map t) (documentation 'te-more-break-resume))) (princ (substitute-command-keys "\\{terminal-more-break-map}\n")) (princ "Any other key is passed through to the program @@ -374,7 +407,7 @@ all pending output has been dealt with.") (defun te-more-break-flush-pending-output () "Discard any output which has been received by the terminal emulator but -not yet proceesed and then proceed from the more break." +not yet processed and then proceed from the more break." (interactive) (te-more-break-unwind) (te-flush-pending-output)) @@ -403,13 +436,29 @@ One characters is treated specially: the terminal escape character (normally C-^) lets you type a terminal emulator command." (interactive) - (cond ((= last-input-char terminal-escape-char) + (cond ((eq last-input-char terminal-escape-char) (call-interactively 'te-escape)) (t - (and terminal-more-processing (null (cdr te-pending-output)) - (te-set-more-count nil)) - (send-string te-process (make-string 1 last-input-char)) - (te-process-output t)))) + ;; 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 ?\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 + ;; keys as character sequences if we add a description + ;; to our termcap entry of what they should look like.) + (if (integerp last-input-char) + (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)) + (te-process-output t)) + (message "Function key `%s' ignored" + (single-key-description last-input-char)))))) (defun te-set-window-start () @@ -448,7 +497,7 @@ lets you type a terminal emulator command." (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 \\to return to terminal emulation: \\[terminal-cease-edit]." +together with a command \\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") @@ -460,7 +509,7 @@ together with a command \\to return to terminal emulatio "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") @@ -504,9 +553,10 @@ together with a command \\to return to terminal emulatio (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"))) ;;;; more break hair @@ -549,7 +599,7 @@ together with a command \\to return to terminal emulatio (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 @@ -642,7 +692,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 () @@ -790,8 +840,7 @@ move to start of new line, clear to end of line." (defun te-filter (process string) - (let* ((obuf (current-buffer)) - (m meta-flag)) + (let* ((obuf (current-buffer))) ;; can't use save-excursion, as that preserves point, which we don't want (unwind-protect (progn @@ -807,13 +856,8 @@ move to start of new line, clear to end of line." (set-buffer (process-buffer process)))) (setq te-pending-output (nconc te-pending-output (list string))) (te-update-pending-output-display) - ;; this binding is needed because emacs looks at meta-flag when - ;; the keystroke is read from the keyboard, not when it is about - ;; to be fed into a keymap (or returned by read-char) - ;; There still could be some screws, though. - (let ((meta-flag m)) - (te-process-output (eq (current-buffer) - (window-buffer (selected-window))))) + (te-process-output (eq (current-buffer) + (window-buffer (selected-window)))) (set-buffer (process-buffer process)) (setq te-saved-point (point))) (set-buffer obuf)))) @@ -821,9 +865,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)) @@ -906,14 +950,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)) @@ -953,14 +997,13 @@ 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 "") (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)) (defun te-sentinel (process message) @@ -980,7 +1023,7 @@ move to start of new line, clear to end of line." (progn (goto-char (point-max)) (recenter -1))))))) -(defvar te-stty-string "stty -nl dec echo" +(defvar te-stty-string "stty -nl erase '^?' kill '^u' intr '^c' echo pass8" "Shell command to set terminal modes for terminal emulator.") ;; This used to have `new' in it, but that loses outside BSD ;; and it's apparently not needed in BSD. @@ -1016,10 +1059,7 @@ terminal-redisplay-interval. 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*")) @@ -1047,6 +1087,8 @@ work with `terminfo' we will try to use it." (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)) @@ -1058,75 +1100,42 @@ work with `terminfo' we will try to use it." (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) (signal (car err) (cdr err)))) - ;; sigh - (if (default-value 'meta-flag) - (progn (message - "Note: Meta key disabled due to maybe-eventually-reparable braindamage") - (sit-for 1))) (setq inhibit-quit t) ;sport death (use-local-map terminal-map) (run-hooks 'terminal-mode-hook) (message "Entering emacs terminal-emulator... Type %s %s for help" (single-key-description terminal-escape-char) (mapconcat 'single-key-description - (where-is-internal 'te-escape-help - terminal-escape-map - nil t) + (where-is-internal 'te-escape-help terminal-escape-map t) " "))) (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)) @@ -1142,9 +1151,9 @@ work with `terminfo' we will try to use it." (put 'terminal-mode 'mode-class 'special) ;; This is only separated out from function terminal-emulator -;; to keep the latter a little more managable. +;; to keep the latter a little more manageable. (defun terminal-mode () - "Set up variables for use f the terminal-emualtor. + "Set up variables for use with the terminal-emulator. One should not call this -- it is an internal function of the terminal-emulator" (kill-all-local-variables) @@ -1153,7 +1162,7 @@ of the terminal-emulator" (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) @@ -1181,10 +1190,6 @@ of the terminal-emulator" (setq te-more-count -1) (make-local-variable 'te-redisplay-count) (setq te-redisplay-count terminal-redisplay-interval) - ;;>> Nothing can be done about this without decruftifying - ;;>> emacs keymaps. - (make-local-variable 'meta-flag) ;sigh - (setq meta-flag nil) ;(use-local-map terminal-mode-map) ;; terminal-mode-hook is called above in function terminal-emulator ) @@ -1192,7 +1197,7 @@ of the terminal-emulator" ;;;; 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)) @@ -1222,6 +1227,74 @@ of the terminal-emulator" start (1+ end))) (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," + 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)) ) + (set-process-sentinel (start-process "tic" nil "tic" file-name) + 'te-tic-sentinel)))) + "/tmp" +) + +(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 "/tmp/" te-terminal-name ".tif")))) + (provide 'terminal) ;;; terminal.el ends here