Initial revision

1 files changed, 1228 insertions, 0 deletions

diff --git a/lisp/terminal.el b/lisp/terminal.el
new file mode 100644
index 00000000000..d2a514048cb
--- /dev/null
+++ b/lisp/terminal.el
@@ -0,0 +1,1228 @@
+;; Terminal emulator for GNU Emacs.
+;; Copyright (C) 1986, 1987, 1988, 1989 Free Software Foundation, Inc.
+;; Written by Richard Mlynarik, November 1986.
+
+;; 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)
+;; 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
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;; 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, 675 Mass Ave, Cambridge, MA 02139, USA.
+
+;;>>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-^
+  "*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
+possible commands.
+This variable is local to each terminal-emulator buffer.")
+
+(defvar 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.
+This variable is local to each terminal-emulator buffer.")
+
+(defvar terminal-more-processing t
+  "*If non-nil, do more-processing.
+This variable is local to each terminal-emulator buffer.")
+
+;; If you are the sort of loser who uses scrolling without more breaks
+;; and expects to actually see anything, you should probably set this to
+;; around 400
+(defvar terminal-redisplay-interval 5000
+  "*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
+performance.")
+
+(defvar terminal-more-break-insertion
+  "*** More break -- Press space to continue ***")
+
+(defvar terminal-escape-map nil)
+(defvar terminal-map nil)
+(defvar terminal-more-break-map nil)
+(if terminal-map
+    nil
+  (let ((map (make-keymap)))
+    (fillarray map 'te-pass-through)
+    ;(define-key map "\C-l"
+    ;  '(lambda () (interactive) (te-pass-through) (redraw-display)))
+    (setq terminal-map map)))
+
+;(setq terminal-escape-map nil)
+(if terminal-escape-map
+    nil
+  (let ((map (make-keymap)))
+    ;(fillarray map 'te-escape-extended-command-unread)
+    (fillarray map 'undefined)
+    (let ((s "0"))
+      (while (<= (aref s 0) ?9)
+        (define-key map s 'digit-argument)
+        (aset s 0 (1+ (aref s 0)))))
+    (define-key map "b" 'switch-to-buffer)
+    (define-key map "o" 'other-window)
+    (define-key map "e" 'te-set-escape-char)
+    (define-key map "\C-l" 'redraw-display)
+    (define-key map "\C-o" 'te-flush-pending-output)
+    (define-key map "m" 'te-toggle-more-processing)
+    (define-key map "x" 'te-escape-extended-command)
+    ;;>> What use is this?  Why is it in the default terminal-emulator map?
+    (define-key map "w" 'te-edit)
+    (define-key map "?" 'te-escape-help)
+    (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 ())
+(if te-escape-command-alist
+    nil
+  (setq te-escape-command-alist
+        '(("Set Escape Character" . te-set-escape-char)
+          ;;>> What use is this?  Why is it in the default terminal-emulator map?
+          ("Edit" . te-edit)
+          ("Refresh" . redraw-display)
+          ("Record Output" . te-set-output-log)
+          ("Photo" . te-set-output-log)
+          ("Tofu" . te-tofu) ;; confuse the uninitiated
+          ("Stuff Input" . te-stuff-string)
+          ("Flush Pending Output" . te-flush-pending-output)
+          ("Enable More Processing" . te-enable-more-processing)
+          ("Disable More Processing" . te-disable-more-processing)
+          ("Scroll at end of page" . te-do-scrolling)
+          ("Wrap at end of page" . te-do-wrapping)
+          ("Switch To Buffer" . switch-to-buffer)
+          ("Other Window" . other-window)
+          ("Kill Buffer" . kill-buffer)
+          ("Help" . te-escape-help)
+          ("Set Redisplay Interval" . te-set-redisplay-interval)
+          )))
+
+;(setq terminal-more-break-map nil)
+(if terminal-more-break-map
+    nil
+  (let ((map (make-keymap)))
+    (fillarray map '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 "\C-o" 'te-more-break-flush-pending-output)
+    ;;>>> this isn't right
+    ;(define-key map "\^?" 'te-more-break-flush-pending-output) ;DEL
+    (define-key map "\r" 'te-more-break-advance-one-line)
+
+    (setq terminal-more-break-map map)))
+  
+
+;;;;  escape map
+
+(defun te-escape ()
+  (interactive)
+  (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> "))))
+      (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)))))
+
+(defun te-escape-help ()
+  "Provide help on commands available after terminal-escape-char is typed."
+  (interactive)
+  (message "Terminal emulator escape help...")
+  (let ((char (single-key-description terminal-escape-char)))
+    (with-electric-help
+      (function (lambda ()
+         (princ (format "Terminal-emulator escape, invoked by \"%s\"
+Type \"%s\" twice to send a single \"%s\" through.
+
+Other chars following \"%s\" are interpreted as follows:\n"
+                        char char char char))
+
+         (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)
+                        '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))))))))
+           (while l
+             (let ((doc (or (documentation (cdr (car l)))
+                            "Not documented")))
+               (if (string-match "\n" doc)
+                   ;; just use first line of documentation
+                   (setq doc (substring doc 0 (match-beginning 0))))
+               (princ "  \"")
+               (princ (car (car l)))
+               (princ "\":\n     ")
+               (princ doc)
+               (write-char ?\n))
+             (setq l (cdr l))))
+         nil)))))
+
+                        
+
+(defun te-escape-extended-command ()
+  (interactive)
+  (let ((c (let ((completion-ignore-case t))
+             (completing-read "terminal command: "
+                              te-escape-command-alist
+                              nil t))))
+    (if c
+        (catch 'foo
+          (setq c (downcase c))
+          (let ((l te-escape-command-alist))
+            (while l
+              (if (string= c (downcase (car (car l))))
+                  (throw 'foo (call-interactively (cdr (car l))))
+                (setq l (cdr l)))))))))
+
+;; not used.
+(defun te-escape-extended-command-unread ()
+  (interactive)
+  (setq unread-command-char last-input-char)
+  (te-escape-extended-command))
+
+(defun te-set-escape-char (c)
+  "Change the terminal-emulator escape character."
+  (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")
+             (single-key-description c)
+             (single-key-description o))
+    (setq terminal-escape-char c)))
+
+
+(defun te-stuff-string (string)
+  "Read a string to send to through the terminal emulator
+as though that string had been typed on the keyboard.
+
+Very poor man's file transfer protocol."
+  (interactive "sStuff string: ")
+  (process-send-string te-process string))
+
+(defun te-set-output-log (name)
+  "Record output from the terminal emulator in a buffer."
+  (interactive (list (if te-log-buffer
+                         nil
+                       (read-buffer "Record output in buffer: "
+                                    (format "%s output-log"
+                                            (buffer-name (current-buffer)))
+                                    nil))))
+  (if (or (null name) (equal name ""))
+      (progn (setq te-log-buffer nil)
+             (message "Output logging off."))
+    (if (get-buffer name)
+        nil
+      (save-excursion
+        (set-buffer (get-buffer-create name))
+        (fundamental-mode)
+        (buffer-disable-undo (current-buffer))
+        (erase-buffer)))
+    (setq te-log-buffer (get-buffer name))
+    (message "Recording terminal emulator output into buffer \"%s\""
+             (buffer-name te-log-buffer))))
+
+(defun te-tofu ()
+  "Discontinue output log."
+  (interactive)
+  (te-set-output-log nil))
+  
+
+(defun te-toggle (sym arg)
+  (set sym (cond ((not (numberp arg)) arg)
+                 ((= arg 1) (not (symbol-value sym)))
+                 ((< arg 0) nil)
+                 (t t))))
+
+(defun te-toggle-more-processing (arg)
+  (interactive "p")
+  (message (if (te-toggle 'terminal-more-processing arg)
+               "More processing on" "More processing off"))
+  (if terminal-more-processing (setq te-more-count -1)))
+
+(defun te-toggle-scrolling (arg)
+  (interactive "p")
+  (message (if (te-toggle 'terminal-scrolling arg)
+               "Scroll at end of page" "Wrap at end of page")))
+
+(defun te-enable-more-processing ()
+  "Enable ** MORE ** processing"
+  (interactive)
+  (te-toggle-more-processing t))
+
+(defun te-disable-more-processing ()
+  "Disable ** MORE ** processing"
+  (interactive)
+  (te-toggle-more-processing nil))
+
+(defun te-do-scrolling ()
+  "Scroll at end of page (yuck)"
+  (interactive)
+  (te-toggle-scrolling t))
+
+(defun te-do-wrapping ()
+  "Wrap to top of window at end of page"
+  (interactive)
+  (te-toggle-scrolling nil))
+
+
+(defun te-set-redisplay-interval (arg)
+  "Set the maximum interval (in output characters) between screen updates.
+Set this number to large value for greater throughput,
+set it smaller for more frequent updates (but overall slower performance."
+  (interactive "NMax number of output chars between redisplay updates: ")
+  (setq arg (max arg 1))
+  (setq terminal-redisplay-interval arg
+        te-redisplay-count 0))
+
+;;;; more map
+
+;; every command -must- call te-more-break-unwind
+;; or grave lossage will result
+
+(put 'te-more-break-unread 'suppress-keymap t)
+(defun te-more-break-unread ()
+  (interactive)
+  (if (= 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)
+             (te-pending-output-length))
+    (setq te-more-count 259259)
+    (te-more-break-unwind)
+    (let ((terminal-more-processing nil))
+      (te-pass-through))))
+
+(defun te-more-break-resume ()
+  "Proceed past the **MORE** break,
+allowing the next page of output to appear"
+  (interactive)
+  (message "Continuing from more break")
+  (te-more-break-unwind))
+
+(defun te-more-break-help ()
+  "Provide help on commands available in a terminal-emulator **MORE** break"
+  (interactive)
+  (message "Terminal-emulator more break help...")
+  (sit-for 0)
+  (with-electric-help
+    (function (lambda ()
+      (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)
+                     (documentation 'te-more-break-resume)))
+      (princ (substitute-command-keys "\\{terminal-more-break-map}\n"))
+      (princ "Any other key is passed through to the program
+running under the terminal emulator and disables more processing until
+all pending output has been dealt with.")
+      nil))))
+
+
+(defun te-more-break-advance-one-line ()
+  "Allow one more line of text to be output before doing another more break."
+  (interactive)
+  (setq te-more-count 1)
+  (te-more-break-unwind))
+
+(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."
+  (interactive)
+  (te-more-break-unwind)
+  (te-flush-pending-output))
+
+(defun te-flush-pending-output ()
+  "Discard any as-yet-unprocessed output which has been received by
+the terminal emulator."
+  (interactive)
+  ;; this could conceivably be confusing in the presence of
+  ;; escape-sequences spanning process-output chunks
+  (if (null (cdr te-pending-output))
+      (message "(There is no output pending)")
+    (let ((length (te-pending-output-length)))
+      (message "Flushing %d chars of pending output" length)
+      (setq te-pending-output
+            (list 0 (format "\n*** %d chars of pending output flushed ***\n"
+                            length)))
+      (te-update-pending-output-display)
+      (te-process-output nil)
+      (sit-for 0))))
+
+
+(defun te-pass-through ()
+  "Character is passed to the program running under the terminal emulator.
+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)
+         (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))))
+
+
+(defun te-set-window-start ()
+  (let* ((w (get-buffer-window (current-buffer)))
+         (h (if w (window-height w))))
+    (cond ((not w)) ; buffer not displayed
+          ((>= h (/ (- (point) (point-min)) (1+ te-width)))
+           ;; this is the normal case
+           (set-window-start w (point-min)))
+          ;; this happens if some vandal shrinks our window.
+          ((>= h (/ (- (point-max) (point)) (1+ te-width)))
+           (set-window-start w (- (point-max) (* h (1+ te-width)) -1)))
+          ;; I give up.
+          (t nil))))
+
+(defun te-pending-output-length ()
+  (let ((length (car te-pending-output))
+        (tem (cdr te-pending-output)))
+    (while tem
+      (setq length (+ length (length (car tem))) tem (cdr tem)))
+    length))
+
+;;>> What use is this terminal-edit stuff anyway?
+;;>>  If nothing else, it was written by somebody who didn't
+;;>>  competently understand the terminal-emulator...
+
+(defvar terminal-edit-map nil)
+(if terminal-edit-map
+    nil
+  (setq terminal-edit-map (make-sparse-keymap))
+  (define-key terminal-edit-map "\C-c\C-c" 'terminal-cease-edit))
+
+;; Terminal Edit mode is suitable only for specially formatted data.
+(put 'terminal-edit-mode 'mode-class 'special)
+
+(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]."
+  (use-local-map terminal-edit-map)
+  (setq major-mode 'terminal-edit-mode)
+  (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))
+
+(defun te-edit ()
+  "Start editing the terminal emulator buffer with ordinary Emacs commands."
+  (interactive)
+  (terminal-edit-mode)
+  (set-buffer-modified-p (buffer-modified-p))
+  ;; 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")
+    (message (substitute-command-keys
+               "Editing: Type \\[terminal-cease-edit] to return to Terminal"))))
+
+(defun terminal-cease-edit ()
+  "Finish editing message; switch back to Terminal proper."
+  (interactive)
+
+  ;;>> emulator will blow out if buffer isn't exactly te-width x te-height
+  (let ((buffer-read-only nil))
+    (widen)
+    (let ((opoint (point-marker))
+          (width te-width)
+          (h (1- te-height)))
+      (goto-char (point-min))
+      (while (>= h 0)
+        (let ((p (point)))
+          (cond ((search-forward "\n" (+ p width) 'move)
+                 (forward-char -1)
+                 (insert-char ?\  (- width (- (point) p)))
+                 (forward-char 1))
+                ((eobp)
+                 (insert-char ?\  (- width (- (point) p))))
+                ((= (following-char) ?\n)
+                 (forward-char 1))
+                (t
+                 (setq p (point))
+                 (if (search-forward "\n" nil t)
+                     (delete-region p (1- (point)))
+                     (delete-region p (point-max))))))
+        (if (= h 0)
+            (if (not (eobp)) (delete-region (point) (point-max)))
+            (if (eobp) (insert ?\n)))
+        (setq h (1- h)))
+      (goto-char opoint)
+      (set-marker opoint nil nil)
+      (setq te-saved-point (point))
+      (setq te-redisplay-count 0)
+      (setq te-more-count -1)))
+
+  (setq mode-line-modified (default-value 'mode-line-modified))
+  (setq major-mode 'terminal-mode)
+  (setq mode-name "terminal")
+  (setq mode-line-process '(": %s")))
+
+;;;; more break hair
+
+(defun te-more-break ()
+  (te-set-more-count t)
+  (make-local-variable 'te-more-old-point)
+  (setq te-more-old-point (point))
+  (make-local-variable 'te-more-old-local-map)
+  (setq te-more-old-local-map (current-local-map))
+  (use-local-map terminal-more-break-map)
+  (make-local-variable 'te-more-old-filter)
+  (setq te-more-old-filter (process-filter te-process))
+  (make-local-variable 'te-more-old-mode-line-format)
+  (setq te-more-old-mode-line-format mode-line-format
+        mode-line-format (list "--   **MORE**  "
+                               mode-line-buffer-identification
+                               "%-"))
+  (set-process-filter te-process
+    (function (lambda (process string)
+                (save-excursion
+                  (set-buffer (process-buffer process))
+                  (setq te-pending-output (nconc te-pending-output
+                                                 (list string))))
+                  (te-update-pending-output-display))))
+  (te-update-pending-output-display)
+  (if (eq (window-buffer (selected-window)) (current-buffer))
+      (message "More break "))
+  (or (eobp)
+      (null terminal-more-break-insertion)
+      (save-excursion
+        (forward-char 1)
+        (delete-region (point) (+ (point) te-width))
+        (insert terminal-more-break-insertion)))
+  (run-hooks 'terminal-more-break-hook)
+  (sit-for 0) ;get display to update
+  (throw 'te-process-output t))
+
+(defun te-more-break-unwind ()
+  (use-local-map te-more-old-local-map)
+  (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))
+  (let ((buffer-read-only nil))
+    (cond ((eobp))
+          (terminal-more-break-insertion
+           (forward-char 1)
+           (delete-region (point)
+                          (+ (point) (length terminal-more-break-insertion)))
+           (insert-char ?\  te-width)
+           (goto-char te-more-old-point)))
+    (setq te-more-old-point nil)
+    (let ((te-more-count 259259))
+      (te-newline)))
+  ;(sit-for 0)
+  (te-process-output t))
+
+(defun te-set-more-count (newline)
+  (let ((line (/ (- (point) (point-min)) (1+ te-width))))
+    (if newline (setq line (1+ line)))
+    (cond ((= line te-height)
+           (setq te-more-count te-height))
+          ;>>>> something is strange.  Investigate this!
+          ((= line (1- te-height))
+           (setq te-more-count te-height))
+          ((or (< line (/ te-height 2))
+               (> (- te-height line) 10))
+           ;; break at end of this page
+           (setq te-more-count (- te-height line)))
+          (t
+           ;; migrate back towards top (ie bottom) of screen.
+           (setq te-more-count (- te-height
+                                  (if (> te-height 10) 2 1)))))))
+
+
+;;;; More or less straight-forward terminal escapes
+
+;; ^j, meaning `newline' to non-display programs.
+;; (Who would think of ever writing a system which doesn't understand
+;;  display terminals natively?  Un*x:  The Operating System of the Future.)
+(defun te-newline ()
+  "Move down a line, optionally do more processing, perhaps wrap/scroll,
+move to start of new line, clear to end of line."
+  (end-of-line)
+  (cond ((not terminal-more-processing))
+        ((< (setq te-more-count (1- te-more-count)) 0)
+         (te-set-more-count t))
+        ((eql te-more-count 0)
+         ;; this doesn't return
+         (te-more-break)))
+  (if (eobp)
+      (progn
+        (delete-region (point-min) (+ (point-min) te-width))
+        (goto-char (point-min))
+        (if terminal-scrolling
+            (progn (delete-char 1)
+                   (goto-char (point-max))
+                   (insert ?\n))))
+    (forward-char 1)
+    (delete-region (point) (+ (point) te-width)))
+  (insert-char ?\  te-width)
+  (beginning-of-line)
+  (te-set-window-start))
+
+; ^p = x+32 y+32
+(defun te-move-to-position ()
+  ;; must offset by #o40 since cretinous unix won't send a 004 char through
+  (let ((y (- (te-get-char) 32))
+        (x (- (te-get-char) 32)))
+    (if (or (> x te-width)
+            (> y te-height))
+        ()
+      (goto-char (+ (point-min) x (* y (1+ te-width))))
+      ;(te-set-window-start?)
+      ))
+  (setq te-more-count -1))
+
+
+
+;; ^p c
+(defun te-clear-rest-of-line ()
+  (save-excursion
+    (let ((n (- (point) (progn (end-of-line) (point)))))
+      (delete-region (point) (+ (point) n))
+      (insert-char ?\  (- n)))))
+
+
+;; ^p C
+(defun te-clear-rest-of-screen ()
+  (save-excursion
+    (te-clear-rest-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))))
+      
+
+;; ^p ^l
+(defun te-clear-screen ()
+  ;; regenerate buffer to compensate for (nonexistent!!) bugs.
+  (erase-buffer)
+  (let ((i 0))
+    (while (< i te-height)
+      (setq i (1+ i))
+      (insert-char ?\  te-width)
+      (insert ?\n)))
+  (delete-region (1- (point-max)) (point-max))
+  (goto-char (point-min))
+  (setq te-more-count -1))
+
+
+;; ^p ^o count+32
+(defun te-insert-lines ()
+  (if (not (bolp))
+      ();(error "fooI")
+    (save-excursion
+      (let* ((line (- te-height (/ (- (point) (point-min)) (1+ te-width)) -1))
+             (n (min (- (te-get-char) ?\ ) line))
+             (i 0))
+        (delete-region (- (point-max) (* n (1+ te-width))) (point-max))
+        (if (eql (point) (point-max)) (insert ?\n))
+        (while (< i n)
+          (setq i (1+ i))
+          (insert-char ?\  te-width)
+          (or (eql i line) (insert ?\n))))))
+  (setq te-more-count -1))
+
+
+;; ^p ^k count+32
+(defun te-delete-lines ()
+  (if (not (bolp))
+      ();(error "fooD")
+    (let* ((line (- te-height (/ (- (point) (point-min)) (1+ te-width)) -1))
+           (n (min (- (te-get-char) ?\ ) line))
+           (i 0))
+      (delete-region (point)
+                     (min (+ (point) (* n (1+ te-width))) (point-max)))
+      (save-excursion
+        (goto-char (point-max))
+        (while (< i n)
+          (setq i (1+ i))
+          (insert-char ?\  te-width)
+          (or (eql i line) (insert ?\n))))))
+  (setq te-more-count -1))
+
+;; ^p ^a
+(defun te-beginning-of-line ()
+  (beginning-of-line))
+
+;; ^p ^b
+(defun te-backward-char ()
+  (if (not (bolp))
+      (backward-char 1)))
+
+;; ^p ^f
+(defun te-forward-char ()
+  (if (not (eolp))
+      (forward-char 1)))
+
+
+;; 0177
+(defun te-delete ()
+  (if (bolp)
+      ()
+    (delete-region (1- (point)) (point))
+    (insert ?\ )
+    (forward-char -1)))
+
+;; ^p ^g
+(defun te-beep ()
+  (beep))
+
+
+;; ^p _ count+32
+(defun te-insert-spaces ()
+  (let* ((p (point))
+         (n (min (- (te-get-char) 32)
+                 (- (progn (end-of-line) (point)) p))))
+    (if (<= n 0)
+        nil
+      (delete-char (- n))
+      (goto-char p)
+      (insert-char ?\  n))
+    (goto-char p)))
+
+;; ^p d count+32  (should be ^p ^d but cretinous un*x won't send ^d chars!!!)
+(defun te-delete-char ()
+  (let* ((p (point))
+         (n (min (- (te-get-char) 32)
+                 (- (progn (end-of-line) (point)) p))))
+    (if (<= n 0)
+        nil
+      (insert-char ?\  n)
+      (goto-char p)
+      (delete-char n))
+    (goto-char p)))
+
+
+
+;; disgusting unix-required shit
+;;  Are we living twenty years in the past yet?
+
+(defun te-losing-unix ()
+  nil)
+
+;; ^i
+(defun te-output-tab ()
+  (let* ((p (point))
+         (x (- p (progn (beginning-of-line) (point))))
+         (l (min (- 8 (logand x 7))
+                 (progn (end-of-line) (- (point) p)))))
+    (goto-char (+ p l))))
+
+;; ^p ^j
+;; Handle the `do' or `nl' termcap capability.
+;;>> I am not sure why this broken, obsolete, capability is here.
+;;>> Perhaps it is for VIle.  No comment was made about why it
+;;>> was added (in "Sun Dec  6 01:22:27 1987  Richard Stallman")
+(defun te-down-vertically-or-scroll ()
+  "Move down a line vertically, or scroll at bottom."
+  (let ((column (current-column)))
+    (end-of-line)
+    (if (eobp)
+        (progn
+          (delete-region (point-min) (+ (point-min) te-width))
+          (goto-char (point-min))
+          (delete-char 1)
+          (goto-char (point-max))
+          (insert ?\n)
+          (insert-char ?\  te-width)
+          (beginning-of-line))
+      (forward-line 1))
+    (move-to-column column))
+  (te-set-window-start))
+
+;; Also:
+;;  ^m => beginning-of-line (for which it -should- be using ^p ^a, right?!!)
+;;  ^g => te-beep (for which it should use ^p ^g)
+;;  ^h => te-backward-char (for which it should use ^p ^b)
+
+
+
+(defun te-filter (process string)
+  (let* ((obuf (current-buffer))
+         (m meta-flag))
+    ;; 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)
+          ;; 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)))))
+          (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)
+  ;;>> There seems no good reason to ever disallow preemption
+  (setq preemptable t)
+  (catch 'te-process-output
+    (let ((buffer-read-only nil)
+          (string nil) ostring start char (matchpos nil))
+      (while (cdr te-pending-output)
+        (setq ostring string
+              start (car te-pending-output)
+              string (car (cdr te-pending-output))
+              char (aref string start))
+        (if (eql (setq start (1+ start)) (length string))
+            (progn (setq te-pending-output
+                           (cons 0 (cdr (cdr te-pending-output)))
+                         start 0
+                         string (car (cdr te-pending-output)))
+                   (te-update-pending-output-display))
+            (setcar te-pending-output start))
+        (if (and (> char ?\037) (< char ?\377))
+            (cond ((eolp)
+                   ;; unread char
+                   (if (eql start 0)
+                       (setq te-pending-output
+                             (cons 0 (cons (make-string 1 char)
+                                           (cdr te-pending-output))))
+                       (setcar te-pending-output (1- start)))
+                   (te-newline))
+                  ((null string)
+                   (delete-char 1) (insert char)
+                   (te-redisplay-if-necessary 1))
+                  (t
+                   (let ((end (or (and (eq ostring string) matchpos)
+                                  (setq matchpos (string-match
+                                                   "[\000-\037\177-\377]"
+                                                   string start))
+                                  (length string))))
+                     (delete-char 1) (insert char)
+                     (setq char (point)) (end-of-line)
+                     (setq end (min end (+ start (- (point) char))))
+                     (goto-char char)
+                     (if (eql end matchpos) (setq matchpos nil))
+                     (delete-region (point) (+ (point) (- end start)))
+                     (insert (if (and (eql start 0)
+                                      (eql end (length string)))
+                                 string
+                                 (substring string start end)))
+                     (if (eql end (length string))
+                         (setq te-pending-output
+                               (cons 0 (cdr (cdr te-pending-output))))
+                         (setcar te-pending-output end))
+                     (te-redisplay-if-necessary (1+ (- end start))))))
+          ;; I suppose if I split the guts of this out into a separate
+          ;;  function we could trivially emulate different terminals
+          ;; Who cares in any case?  (Apart from stupid losers using rlogin)
+          (funcall
+            (if (eql char ?\^p)
+                (or (cdr (assq (te-get-char)
+                               '((?= . te-move-to-position)
+                                 (?c . te-clear-rest-of-line)
+                                 (?C . te-clear-rest-of-screen)
+                                 (?\C-o . te-insert-lines)
+                                 (?\C-k . te-delete-lines)
+                                 ;; not necessary, but help sometimes.
+                                 (?\C-a . te-beginning-of-line)
+                                 (?\C-b . te-backward-char)
+                                 ;; should be C-d, but un*x
+                                 ;;  pty's won't send \004 through!
+                                 ;; Can you believe this?
+                                 (?d . te-delete-char)
+                                 (?_ . te-insert-spaces)
+                                 ;; random
+                                 (?\C-f . te-forward-char)
+                                 (?\C-g . te-beep)
+                                 (?\C-j . te-down-vertically-or-scroll)
+                                 (?\C-l . te-clear-screen)
+                                 )))
+                    'te-losing-unix)
+                (or (cdr (assq char
+                               '((?\C-j . te-newline)
+                                 (?\177 . te-delete)
+                                 ;; Did I ask to be sent these characters?
+                                 ;; I don't remember doing so, either.
+                                 ;; (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))))     
+                    'te-losing-unix)))
+          (te-redisplay-if-necessary 1))
+        (and preemptable
+             (input-pending-p)
+             ;; preemptable 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))))))
+
+(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))
+              (setq te-pending-output (cons 0 (cdr (cdr te-pending-output))))
+              (setcar te-pending-output start))))
+    (catch 'char
+      (let ((filter (process-filter te-process)))
+        (unwind-protect
+            (progn
+              (set-process-filter te-process
+                                  (function (lambda (p s)
+                                    (or (eql (length s) 1)
+                                        (setq te-pending-output (list 1 s)))
+                                    (throw 'char (aref s 0)))))
+              (accept-process-output te-process))
+          (set-process-filter te-process filter))))))
+
+
+(defun te-redisplay-if-necessary (length)
+  (and (<= (setq te-redisplay-count (- te-redisplay-count length)) 0)
+       (eq (current-buffer) (window-buffer (selected-window)))
+       (waiting-for-user-input-p)
+       (progn (te-update-pending-output-display)
+              (sit-for 0)
+              (setq te-redisplay-count terminal-redisplay-interval))))
+
+(defun te-update-pending-output-display ()
+  (if (null (cdr te-pending-output))
+      (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)))
+
+
+(defun te-sentinel (process message)
+  (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))
+               (setq buffer-read-only nil)
+               (fundamental-mode)
+               (goto-char (point-max))
+               (delete-blank-lines)
+               (delete-horizontal-space)
+               (insert "\n*******\n" message "*******\n"))
+             (if (and (eq b (process-buffer process))
+                      (waiting-for-user-input-p))
+                 (progn (goto-char (point-max))
+                        (recenter -1)))))))
+
+(defvar te-stty-string "stty -nl new dec echo"
+  "Command string (to be interpreted by \"sh\") which sets the modes
+of the virtual terminal to be appropriate for interactive use.")
+
+(defvar explicit-shell-file-name nil
+  "*If non-nil, is file name to use for explicitly requested inferior shell.")
+
+(defun terminal-emulator (buffer program args &optional width height)
+  "Under a display-terminal emulator in BUFFER, run PROGRAM on arguments ARGS.
+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.
+
+Interactively, BUFFER defaults to \"*terminal*\" and PROGRAM and ARGS
+are parsed from an input-string using your usual shell.
+WIDTH and HEIGHT are determined from the size of the current window
+-- WIDTH will be one less than the window's width, HEIGHT will be its height.
+
+To switch buffers and leave the emulator, or to give commands
+to the emulator itself (as opposed to the program running under it),
+type Control-^.  The following character is an emulator command.
+Type Control-^ twice to send it to the subprogram.
+This escape character may be changed using the variable `terminal-escape-char'.
+
+`Meta' characters may not currently be sent through the terminal emulator.
+
+Here is a list of some of the variables which control the behaviour
+of the emulator -- see their documentation for more information:
+terminal-escape-char, terminal-scrolling, terminal-more-processing,
+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."
+  (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))))))
+  (switch-to-buffer buffer)
+  (if (null width) (setq width (- (window-width (selected-window)) 1)))
+  (if (null height) (setq height (- (window-height (selected-window)) 1)))
+  (terminal-mode)
+  (setq te-width width te-height height)
+  (setq mode-line-buffer-identification
+        (list (format "Emacs terminal %dx%d: %%b  " te-width te-height)
+              'te-pending-output-info))
+  (let ((buffer-read-only nil))
+    (te-clear-screen))
+  (let (process)
+    (while (setq process (get-buffer-process (current-buffer)))
+      (if (y-or-n-p (format "Kill process %s? " (process-name process)))
+          (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)
+                             "/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))
+                                     (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)
+                      " ")))
+
+
+(defun te-parse-program-and-args (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]+\\)*"
+                                s p)
+                               (prog1 (substring s p (match-end 1))
+                                 (setq p (match-end 0))
+                                 (if (eql p (length s)) (setq p nil)))
+                               (prog1 (substring s p)
+                                 (setq p nil)))
+                           l)))
+           (setq l (nreverse l))
+           (list (car l) (cdr l))))
+        ((and (string-match "[ \t]" s) (not (file-exists-p s)))
+         (list shell-file-name (list "-c" (concat "exec " s))))
+        (t (list s ()))))
+
+(put 'terminal-mode 'mode-class 'special)
+;; This is only separated out from function terminal-emulator
+;; to keep the latter a little more managable.
+(defun terminal-mode ()
+  "Set up variables for use f the terminal-emualtor.
+One should not call this -- it is an internal function
+of the terminal-emulator"
+  (kill-all-local-variables)
+  (buffer-disable-undo (current-buffer))
+  (setq major-mode 'terminal-mode)
+  (setq mode-name "terminal")
+; (make-local-variable 'Helper-return-blurb)
+; (setq Helper-return-blurb "return to terminal simulator")
+  (setq mode-line-process '(": %s"))
+  (setq buffer-read-only t)
+  (setq truncate-lines t)
+  (make-local-variable 'terminal-escape-char)
+  (setq terminal-escape-char (default-value 'terminal-escape-char))
+  (make-local-variable 'terminal-scrolling)
+  (setq terminal-scrolling (default-value 'terminal-scrolling))
+  (make-local-variable 'terminal-more-processing)
+  (setq terminal-more-processing (default-value 'terminal-more-processing))
+  (make-local-variable 'terminal-redisplay-interval)
+  (setq terminal-redisplay-interval (default-value 'terminal-redisplay-interval))
+  (make-local-variable 'te-width)
+  (make-local-variable 'te-height)
+  (make-local-variable 'te-process)
+  (make-local-variable 'te-pending-output)
+  (setq te-pending-output (list 0))
+  (make-local-variable 'te-saved-point)
+  (setq te-saved-point (point-min))
+  (make-local-variable 'te-pending-output-info) ;for the mode line
+  (setq te-pending-output-info "")
+  (make-local-variable 'inhibit-quit)
+  ;(setq inhibit-quit t)
+  (make-local-variable 'te-log-buffer)
+  (setq te-log-buffer nil)
+  (make-local-variable 'te-more-count)
+  (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-+=_.@/:]+\\'"
+                       string)
+         string)
+        ((not (string-match "[$]" string))
+         ;; "[\"\\]" are special to sh and the lisp reader in the same way
+         (prin1-to-string string))
+        (t
+         (let ((harder "")
+               (start 0)
+               (end 0))
+           (while (cond ((>= start (length string))
+                         nil)
+                        ;; this is the set of chars magic with "..." in `sh'
+                        ((setq end (string-match "[\"\\$]"
+                                                 string start))
+                         t)
+                        (t (setq harder (concat harder
+                                                (substring string start)))
+                           nil))
+             (setq harder (concat harder (substring string start end)
+                                  ;; Can't use ?\\ since `concat'
+                                  ;; unfortunately does prin1-to-string
+                                  ;; on fixna.  Amazing.
+                                  "\\"
+                                  (substring string
+                                             end
+                                             (1+ end)))
+                   start (1+ end)))
+           (concat "\"" harder "\"")))))
\ No newline at end of file