-;;; terminal.el --- terminal emulator for GNU Emacs.
+;;; terminal.el --- terminal emulator for GNU Emacs
-;; Copyright (C) 1986,87,88,89,93,94 Free Software Foundation, Inc.
+;; Copyright (C) 1986, 1987, 1988, 1989, 1993, 1994, 2001, 2002, 2003,
+;; 2004, 2005, 2006, 2007, 2008 Free Software Foundation, Inc.
;; Author: Richard Mlynarik <mly@eddie.mit.edu>
;; Maintainer: FSF
;; This file is part of GNU Emacs.
-;; GNU Emacs is free software; you can redistribute it and/or modify
+;; 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 2, or (at your option)
-;; any later version.
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
;; GNU Emacs is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; 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, Inc., 59 Temple Place - Suite 330,
-;; Boston, MA 02111-1307, USA.
+;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
;;; Commentary:
:type 'character
:group 'terminal)
-(defcustom 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.
(if terminal-map
nil
(let ((map (make-sparse-keymap)))
+ ;; Prevent defining [menu-bar] as te-pass-through
+ ;; so we allow the global menu bar to be visible.
+ (define-key map [menu-bar] (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)
;; 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/"
+(defconst te-terminfo-directory
+ (file-name-as-directory
+ (expand-file-name "emacs-terminfo" temporary-file-directory))
"Directory used for run-time terminal definition files for Terminfo.")
(defvar te-terminal-name nil)
\f
(use-local-map terminal-escape-map)
(setq s (read-key-sequence
(if current-prefix-arg
- (format "Emacs Terminal escape> %d "
+ (format "Emacs Terminal escape[%s for help]> %d "
+ (substitute-command-keys
+ "\\<terminal-escape-map>\\[te-escape-help]")
(prefix-numeric-value current-prefix-arg))
- "Emacs Terminal escape> "))))
+ (format "Emacs Terminal escape[%s for help]> "
+ (substitute-command-keys
+ "\\<terminal-escape-map>\\[te-escape-help]"))))))
(use-global-map global)
(use-local-map local))
(where-is-internal 'te-escape-extended-command
terminal-escape-map t)
'te-escape-extended-command))
- (let ((l (if (fboundp 'sortcar)
- (sortcar (copy-sequence te-escape-command-alist)
- 'string<)
- (sort (copy-sequence te-escape-command-alist)
- (function (lambda (a b)
- (string< (car a) (car b))))))))
+ (let ((l (sort (copy-sequence te-escape-command-alist)
+ (function (lambda (a b)
+ (string< (car a) (car b)))))))
(while l
(let ((doc (or (documentation (cdr (car l)))
"Not documented")))
(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))
+ (process-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))))))
(setq mode-name "Terminal Edit")
(setq mode-line-modified (default-value 'mode-line-modified))
(setq mode-line-process nil)
- (run-hooks 'terminal-edit-mode-hook))
+ (run-mode-hooks 'terminal-edit-mode-hook))
(defun te-edit ()
"Start editing the terminal emulator buffer with ordinary Emacs commands."
(let ((p (point)))
(cond ((search-forward "\n" (+ p width) 'move)
(forward-char -1)
- (insert-char ?\ (- width (- (point) p)))
+ (insert-char ?\s (- width (- (point) p)))
(forward-char 1))
((eobp)
- (insert-char ?\ (- width (- (point) p))))
+ (insert-char ?\s (- width (- (point) p))))
((= (following-char) ?\n)
(forward-char 1))
(t
(forward-char 1)
(delete-region (point)
(+ (point) (length terminal-more-break-insertion)))
- (insert-char ?\ te-width)
+ (insert-char ?\s te-width)
(goto-char te-more-old-point)))
(setq te-more-old-point nil)
(let ((te-more-count 259259))
(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)
(insert ?\n))))
(forward-char 1)
(delete-region (point) (+ (point) te-width)))
- (insert-char ?\ te-width)
+ (insert-char ?\s te-width)
(beginning-of-line)
(te-set-window-start))
(save-excursion
(let ((n (- (point) (progn (end-of-line) (point)))))
(delete-region (point) (+ (point) n))
- (insert-char ?\ (- n)))))
+ (insert-char ?\s (- n)))))
;; ^p C
(while (progn (end-of-line) (not (eobp)))
(forward-char 1) (end-of-line)
(delete-region (- (point) te-width) (point))
- (insert-char ?\ te-width))))
+ (insert-char ?\s te-width))))
;; ^p ^l
(let ((i 0))
(while (< i te-height)
(setq i (1+ i))
- (insert-char ?\ te-width)
+ (insert-char ?\s te-width)
(insert ?\n)))
(delete-region (1- (point-max)) (point-max))
(goto-char (point-min))
();(error "fooI")
(save-excursion
(let* ((line (- te-height (/ (- (point) (point-min)) (1+ te-width)) -1))
- (n (min (- (te-get-char) ?\ ) line))
+ (n (min (- (te-get-char) ?\s) 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))))))
+ (insert-char ?\s te-width)
+ (or (eq i line) (insert ?\n))))))
(setq te-more-count -1))
(if (not (bolp))
();(error "fooD")
(let* ((line (- te-height (/ (- (point) (point-min)) (1+ te-width)) -1))
- (n (min (- (te-get-char) ?\ ) line))
+ (n (min (- (te-get-char) ?\s) line))
(i 0))
(delete-region (point)
(min (+ (point) (* n (1+ te-width))) (point-max)))
(goto-char (point-max))
(while (< i n)
(setq i (1+ i))
- (insert-char ?\ te-width)
- (or (eql i line) (insert ?\n))))))
+ (insert-char ?\s te-width)
+ (or (eq i line) (insert ?\n))))))
(setq te-more-count -1))
;; ^p ^a
(if (bolp)
()
(delete-region (1- (point)) (point))
- (insert ?\ )
+ (insert ?\s)
(forward-char -1)))
;; ^p ^g
nil
(delete-char (- n))
(goto-char p)
- (insert-char ?\ n))
+ (insert-char ?\s n))
(goto-char p)))
;; ^p d count+32 (should be ^p ^d but cretinous un*x won't send ^d chars!!!)
(- (progn (end-of-line) (point)) p))))
(if (<= n 0)
nil
- (insert-char ?\ n)
+ (insert-char ?\s n)
(goto-char p)
(delete-char n))
(goto-char p)))
(delete-char 1)
(goto-char (point-max))
(insert ?\n)
- (insert-char ?\ te-width)
+ (insert-char ?\s te-width)
(beginning-of-line))
(forward-line 1))
(move-to-column column))
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)
;; preemptible output! Oh my!!
(throw 'te-process-output t)))))
;; We must update window-point in every window displaying our buffer
- (let* ((s (selected-window))
- (w s))
- (while (not (eq s (setq w (next-window w))))
- (if (eq (window-buffer w) (current-buffer))
- (set-window-point w (point))))))
+ (walk-windows (lambda (w)
+ (when (and (not (eq w (selected-window)))
+ (eq (window-buffer w) (current-buffer)))
+ (set-window-point w (point))))))
(defun te-get-char ()
(if (cdr te-pending-output)
(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))
ARGS is a list of argument-strings. Remaining arguments are WIDTH and HEIGHT.
BUFFER's contents are made an image of the display generated by that program,
and any input typed when BUFFER is the current Emacs buffer is sent to that
-program an keyboard input.
+program as keyboard input.
Interactively, BUFFER defaults to \"*terminal*\" and PROGRAM and ARGS
are parsed from an input-string using your usual shell.
`Meta' characters may not currently be sent through the terminal emulator.
-Here is a list of some of the variables which control the behaviour
+Here is a list of some of the variables which control the behavior
of the emulator -- see their documentation for more information:
terminal-escape-char, terminal-scrolling, terminal-more-processing,
terminal-redisplay-interval.
(getenv "SHELL")
"/bin/sh"))
(s (read-string
- (format "Run program in emulator: (default %s) "
+ (format "Run program in emulator (default %s): "
default-s))))
(if (equal s "")
(list default-s '())
(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 te-terminal-name (concat te-terminal-name-prefix
+ (number-to-string te-width)
+ (number-to-string te-height)))
(setq mode-line-buffer-identification
(list (format "Emacs terminal %dx%d: %%b " te-width te-height)
'te-pending-output-info))
(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"
+ (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 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)))
(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))))
+ (when (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.
"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,"
+ ;; The last newline avoids trouble with ncurses.
"il1=^P^O!, ind=^P\\n, nel=\\n,\n"))
- ;; The last newline avoids trouble with ncurses.
+ ;; This is the desired name for the source file.
(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)) )
+ (let ((temp-file
+ (make-temp-file (expand-file-name "tif" te-terminfo-directory))))
+ ;; Store the source file under a random temp name.
+ (with-temp-file temp-file
+ (insert terminfo))
+ ;; Rename it to the desired name.
+ ;; We use this roundabout approach
+ ;; to avoid any risk of writing a name that
+ ;; was michievouslyt set up as a symlink.
+ (rename-file temp-file file-name))
+ ;; Now compile that source to make the binary that the
+ ;; programs actually use.
+ (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)
-)
+ (directory-file-name te-terminfo-directory))
(defun te-create-termcap ()
"Create a termcap entry for the virtual terminal"
(provide 'terminal)
+;; arch-tag: 0ae1d7d7-90ef-4566-a531-6e7ff8c79b2f
;;; terminal.el ends here