X-Git-Url: https://code.delx.au/gnu-emacs/blobdiff_plain/b11e15262d4716b08a77c32596f426464f1a3fa7..8e735883f4696be337577300537480fe64f11fdf:/lisp/terminal.el diff --git a/lisp/terminal.el b/lisp/terminal.el index d635f96453..6ce6824281 100644 --- a/lisp/terminal.el +++ b/lisp/terminal.el @@ -1,6 +1,6 @@ ;;; 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 ;; Maintainer: FSF @@ -25,7 +25,6 @@ ;;; Code: ;;>>TODO -;;>> terminfo? ;;>> ** Nothing can be done about emacs' meta-lossage ** ;;>> (without redoing keymaps `sanely' -- ask Mly for details) @@ -77,6 +76,7 @@ performance.") 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))) @@ -142,7 +142,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) @@ -159,32 +159,45 @@ performance.") (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." @@ -224,7 +237,7 @@ Other chars following \"%s\" are interpreted as follows:\n" (setq l (cdr l)))) nil))))) - + (defun te-escape-extended-command () (interactive) @@ -293,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) @@ -426,13 +439,13 @@ 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))) ;; 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 @@ -484,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") @@ -496,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") @@ -540,6 +553,7 @@ 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"))) @@ -585,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 @@ -678,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 () @@ -851,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)) @@ -936,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)) @@ -983,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) @@ -1046,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*")) @@ -1077,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)) @@ -1088,44 +1100,22 @@ 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" - (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) @@ -1237,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