X-Git-Url: https://code.delx.au/gnu-emacs/blobdiff_plain/0d30b33766e277a5bff6eabc9da5afdaebd8b32a..220d91b834f7f7252b9953460422151b86b3520c:/lisp/terminal.el diff --git a/lisp/terminal.el b/lisp/terminal.el index 75d0c7acbd..84915764c7 100644 --- a/lisp/terminal.el +++ b/lisp/terminal.el @@ -1,7 +1,7 @@ ;;; terminal.el --- terminal emulator for GNU Emacs -;; Copyright (C) 1986, 1987, 1988, 1989, 1993, 1994, 2002, 2003, -;; 2004, 2005 Free Software Foundation, Inc. +;; Copyright (C) 1986, 1987, 1988, 1989, 1993, 1994, 2001, 2002, 2003, +;; 2004, 2005, 2006, 2007, 2008, 2009, 2010 Free Software Foundation, Inc. ;; Author: Richard Mlynarik ;; Maintainer: FSF @@ -9,10 +9,10 @@ ;; 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 @@ -20,9 +20,7 @@ ;; 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., 51 Franklin Street, Fifth Floor, -;; Boston, MA 02110-1301, USA. +;; along with GNU Emacs. If not, see . ;;; Commentary: @@ -52,7 +50,7 @@ (defcustom terminal-escape-char ?\C-^ - "*All characters except for this are passed verbatim through the + "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 @@ -62,7 +60,7 @@ This variable is local to each terminal-emulator buffer." :group 'terminal) (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 + "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." @@ -70,7 +68,7 @@ This variable is local to each terminal-emulator buffer." :group 'terminal) (defcustom terminal-more-processing t - "*If non-nil, do more-processing. + "If non-nil, do more-processing. This variable is local to each terminal-emulator buffer." :type 'boolean :group 'terminal) @@ -79,7 +77,7 @@ This variable is local to each terminal-emulator buffer." ;; and expects to actually see anything, you should probably set this to ;; around 400 (defcustom terminal-redisplay-interval 5000 - "*Maximum number of characters which will be processed by the + "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 @@ -227,7 +225,7 @@ performance." ;; you hit esc key... ((and (stringp s) (string= s (make-string 1 terminal-escape-char))) - (setq last-command-char terminal-escape-char) + (setq last-command-event terminal-escape-char) (let ((terminal-escape-char -259)) (te-pass-through))) @@ -328,8 +326,7 @@ Very poor man's file transfer protocol." (message "Output logging off.")) (if (get-buffer name) nil - (save-excursion - (set-buffer (get-buffer-create name)) + (with-current-buffer (get-buffer-create name) (fundamental-mode) (buffer-disable-undo (current-buffer)) (erase-buffer))) @@ -398,10 +395,10 @@ 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 (eq last-input-char terminal-escape-char) + (if (eq last-input-event terminal-escape-char) (call-interactively 'te-escape) (message "Continuing from more break (\"%s\" typed, %d chars output pending...)" - (single-key-description last-input-char) + (single-key-description last-input-event) (te-pending-output-length)) (setq te-more-count 259259) (te-more-break-unwind) @@ -471,29 +468,29 @@ One characters is treated specially: the terminal escape character (normally C-^) lets you type a terminal emulator command." (interactive) - (cond ((eq last-input-char terminal-escape-char) + (cond ((eq last-input-event terminal-escape-char) (call-interactively 'te-escape)) (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))) + (if (and (symbolp last-input-event) + (get last-input-event 'ascii-character)) + (setq last-input-event (get last-input-event '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)))) + (if (and (integerp last-input-event) + (not (zerop (logand last-input-event ?\M-\^@)))) + (setq last-input-event (+ 128 (logand last-input-event 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) + (if (integerp last-input-event) (progn (and terminal-more-processing (null (cdr te-pending-output)) (te-set-more-count nil)) - (process-send-string te-process (make-string 1 last-input-char)) + (process-send-string te-process (make-string 1 last-input-event)) (te-process-output t)) (message "Function key `%s' ignored" - (single-key-description last-input-char)))))) + (single-key-description last-input-event)))))) (defun te-set-window-start () @@ -567,10 +564,10 @@ together with a command \\to return to terminal emulation: \\ (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 @@ -612,8 +609,7 @@ together with a command \\to return to terminal emulation: \\ "%-")) (set-process-filter te-process (function (lambda (process string) - (save-excursion - (set-buffer (process-buffer process)) + (with-current-buffer (process-buffer process) (setq te-pending-output (nconc te-pending-output (list string)))) (te-update-pending-output-display)))) @@ -642,7 +638,7 @@ together with a command \\to return to terminal emulation: \\ (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)) @@ -693,7 +689,7 @@ move to start of new line, clear to end of line." (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)) @@ -717,7 +713,7 @@ move to start of new line, clear to end of line." (save-excursion (let ((n (- (point) (progn (end-of-line) (point))))) (delete-region (point) (+ (point) n)) - (insert-char ?\ (- n))))) + (insert-char ?\s (- n))))) ;; ^p C @@ -727,7 +723,7 @@ move to start of new line, clear to end of line." (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 @@ -737,7 +733,7 @@ move to start of new line, clear to end of line." (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)) @@ -750,13 +746,13 @@ move to start of new line, clear to end of line." ();(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 (eq (point) (point-max)) (insert ?\n)) (while (< i n) (setq i (1+ i)) - (insert-char ?\ te-width) + (insert-char ?\s te-width) (or (eq i line) (insert ?\n)))))) (setq te-more-count -1)) @@ -766,7 +762,7 @@ move to start of new line, clear to end of line." (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))) @@ -774,7 +770,7 @@ move to start of new line, clear to end of line." (goto-char (point-max)) (while (< i n) (setq i (1+ i)) - (insert-char ?\ te-width) + (insert-char ?\s te-width) (or (eq i line) (insert ?\n)))))) (setq te-more-count -1)) @@ -798,7 +794,7 @@ move to start of new line, clear to end of line." (if (bolp) () (delete-region (1- (point)) (point)) - (insert ?\ ) + (insert ?\s) (forward-char -1))) ;; ^p ^g @@ -815,7 +811,7 @@ move to start of new line, clear to end of line." 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!!!) @@ -825,7 +821,7 @@ move to start of new line, clear to end of line." (- (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))) @@ -862,7 +858,7 @@ move to start of new line, clear to end of line." (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)) @@ -876,27 +872,22 @@ move to start of new line, clear to end of line." (defun te-filter (process string) - (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)) - (goto-char te-saved-point) - (and (bufferp te-log-buffer) - (if (null (buffer-name te-log-buffer)) - ;; killed - (setq te-log-buffer nil) - (set-buffer te-log-buffer) - (goto-char (point-max)) - (insert-before-markers string) - (set-buffer (process-buffer process)))) - (setq te-pending-output (nconc te-pending-output (list string))) - (te-update-pending-output-display) - (te-process-output (eq (current-buffer) - (window-buffer (selected-window)))) - (set-buffer (process-buffer process)) - (setq te-saved-point (point))) - (set-buffer obuf)))) + (with-current-buffer (process-buffer process) + (goto-char te-saved-point) + (and (bufferp te-log-buffer) + (if (null (buffer-name te-log-buffer)) + ;; killed + (setq te-log-buffer nil) + (set-buffer te-log-buffer) + (goto-char (point-max)) + (insert-before-markers string) + (set-buffer (process-buffer process)))) + (setq te-pending-output (nconc te-pending-output (list string))) + (te-update-pending-output-display) + (te-process-output (eq (current-buffer) + (window-buffer (selected-window)))) + (set-buffer (process-buffer process)) + (setq te-saved-point (point)))) ;; (A version of the following comment which might be distractingly offensive ;; to some readers has been moved to term-nasty.el.) @@ -1045,8 +1036,7 @@ move to start of new line, clear to end of line." (cond ((eq (process-status process) 'run)) ((null (buffer-name (process-buffer process)))) ;deleted (t (let ((b (current-buffer))) - (save-excursion - (set-buffer (process-buffer process)) + (with-current-buffer (process-buffer process) (setq buffer-read-only nil) (fundamental-mode) (goto-char (point-max)) @@ -1064,7 +1054,7 @@ move to start of new line, clear to end of line." ;; and it's apparently not needed in BSD. (defcustom explicit-shell-file-name nil - "*If non-nil, is file name to use for explicitly requested inferior shell." + "If non-nil, is file name to use for explicitly requested inferior shell." :type '(choice (const :tag "None" nil) file) :group 'terminal) @@ -1099,27 +1089,26 @@ 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." (interactive - (cons (save-excursion - (set-buffer (get-buffer-create "*terminal*")) - (buffer-name (if (or (not (boundp 'te-process)) - (null te-process) - (not (eq (process-status te-process) - 'run))) - (current-buffer) - (generate-new-buffer "*terminal*")))) - (append - (let* ((default-s - ;; Default shell is same thing M-x shell uses. - (or explicit-shell-file-name - (getenv "ESHELL") - (getenv "SHELL") - "/bin/sh")) - (s (read-string - (format "Run program in emulator: (default %s) " - default-s)))) - (if (equal s "") - (list default-s '()) - (te-parse-program-and-args s)))))) + (cons (with-current-buffer (get-buffer-create "*terminal*") + (buffer-name (if (or (not (boundp 'te-process)) + (null te-process) + (not (eq (process-status te-process) + 'run))) + (current-buffer) + (generate-new-buffer "*terminal*")))) + (append + (let* ((default-s + ;; Default shell is same thing M-x shell uses. + (or explicit-shell-file-name + (getenv "ESHELL") + (getenv "SHELL") + "/bin/sh")) + (s (read-string + (format "Run program in emulator (default %s): " + default-s)))) + (if (equal s "") + (list default-s '()) + (te-parse-program-and-args s)))))) (switch-to-buffer buffer) (if (null width) (setq width (- (window-width (selected-window)) 1))) (if (null height) (setq height (- (window-height (selected-window)) 1))) @@ -1162,7 +1151,7 @@ subprocess started." (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) @@ -1346,5 +1335,5 @@ in the directory specified by `te-terminfo-directory'." (provide 'terminal) -;;; arch-tag: 0ae1d7d7-90ef-4566-a531-6e7ff8c79b2f +;; arch-tag: 0ae1d7d7-90ef-4566-a531-6e7ff8c79b2f ;;; terminal.el ends here