-;; Terminal emulator for GNU Emacs.
-;; Copyright (C) 1986, 1987, 1988, 1989 Free Software Foundation, Inc.
-;; Written by Richard Mlynarik, November 1986.
+;;; terminal.el --- terminal emulator for GNU Emacs.
+
+;; Copyright (C) 1986,87,88,89,93,94 Free Software Foundation, Inc.
+
+;; Author: Richard Mlynarik <mly@eddie.mit.edu>
+;; Maintainer: FSF
+;; Keywords: comm, terminals
;; This file is part of GNU Emacs.
;; GNU Emacs is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
-;; the Free Software Foundation; either version 1, or (at your option)
+;; the Free Software Foundation; either version 2, or (at your option)
;; any later version.
;; GNU Emacs is distributed in the hope that it will be useful,
;; along with GNU Emacs; see the file COPYING. If not, write to
;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
+;;; Code:
+
;;>>TODO
-;;>> terminfo?
;;>> ** Nothing can be done about emacs' meta-lossage **
;;>> (without redoing keymaps `sanely' -- ask Mly for details)
;;>> One probably wants to do setenv MORE -c when running with
;;>> more-processing enabled.
-(provide 'terminal)
(require 'ehelp)
(defvar terminal-escape-char ?\C-^
(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)
(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
("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)
(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-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)
\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."
(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)
(setq l (cdr l))))
nil)))))
-
+
(defun te-escape-extended-command ()
(interactive)
;; 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)
(interactive "cSet escape character to: ")
(let ((o terminal-escape-char))
(message (if (= o c)
- "\"%s\" is escape char"
- "\"%s\" is now escape; \"%s\" passes though")
+ "\"%s\" is the escape char"
+ "\"%s\" is now the escape; \"%s\" passes through")
(single-key-description c)
(single-key-description o))
(setq terminal-escape-char c)))
"Discontinue output log."
(interactive)
(te-set-output-log nil))
-
+
(defun te-toggle (sym arg)
(set sym (cond ((not (numberp arg)) arg)
(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)
(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
(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))
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 ()
(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")
(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
(forward-char 1) (end-of-line)
(delete-region (- (point) te-width) (point))
(insert-char ?\ te-width))))
-
+
;; ^p ^l
(defun te-clear-screen ()
\f
(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
(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))))
;; (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))
;; (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))
(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)
(progn (goto-char (point-max))
(recenter -1)))))))
\f
-(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.
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:")))
- (if (fboundp 'start-subprocess)
- ;; this winning function would do everything, except that
- ;; rms doesn't want it.
- (setq te-process (start-subprocess "terminal-emulator"
- program args
- 'channel-type 'terminal
- 'filter 'te-filter
- 'buffer (current-buffer)
- 'sentinel 'te-sentinel
- 'modify-environment
- (list (cons "TERM" "emacs-virtual")
- (cons "TERMCAP" termcap))))
- ;; so instead we resort to this...
- (setq te-process (start-process "terminal-emulator" (current-buffer)
+ (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 TERM=emacs-virtual %s %s"
- te-stty-string
- (te-quote-arg-for-sh
- (concat exec-directory "env"))
- (te-quote-arg-for-sh
- (concat "TERMCAP=" termcap))
+ (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)))
+ (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))
(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)
(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)
(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
)
;;;; 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))
(1+ end)))
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
HCoop / bpt / emacs.git / blobdiff