lisp/terminal.el

   1 ;;; terminal.el --- terminal emulator for GNU Emacs.
   2
   3 ;; Copyright (C) 1986, 1987, 1988, 1989 Free Software Foundation, Inc.
   4
   5 ;; Author: Richard Mlynarik <mly@eddie.mit.edu>
   6 ;; Maintainer: FSF
   7 ;; Keywords: comm, terminals
   8
   9 ;; This file is part of GNU Emacs.
  10
  11 ;; GNU Emacs is free software; you can redistribute it and/or modify
  12 ;; it under the terms of the GNU General Public License as published by
  13 ;; the Free Software Foundation; either version 2, or (at your option)
  14 ;; any later version.
  15
  16 ;; GNU Emacs is distributed in the hope that it will be useful,
  17 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  18 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  19 ;; GNU General Public License for more details.
  20
  21 ;; You should have received a copy of the GNU General Public License
  22 ;; along with GNU Emacs; see the file COPYING.  If not, write to
  23 ;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
  24
  25 ;;; Code:
  26
  27 ;;>>TODO
  28 ;;>> terminfo?
  29 ;;>> ** Nothing can be done about emacs' meta-lossage **
  30 ;;>>  (without redoing keymaps `sanely' -- ask Mly for details)
  31
  32 ;;>> One probably wants to do setenv MORE -c when running with
  33 ;;>>   more-processing enabled.
  34
  35 (require 'ehelp)
  36
  37 (defvar terminal-escape-char ?\C-^
  38   "*All characters except for this are passed verbatim through the
  39 terminal-emulator.  This character acts as a prefix for commands
  40 to the emulator program itself.  Type this character twice to send
  41 it through the emulator.  Type ? after typing it for a list of
  42 possible commands.
  43 This variable is local to each terminal-emulator buffer.")
  44
  45 (defvar terminal-scrolling t ;;>> Setting this to T sort-of defeats my whole aim in writing this package...
  46   "*If non-nil, the terminal-emulator will losingly `scroll' when output occurs
  47 past the bottom of the screen.  If nil, output will win and `wrap' to the top
  48 of the screen.
  49 This variable is local to each terminal-emulator buffer.")
  50
  51 (defvar terminal-more-processing t
  52   "*If non-nil, do more-processing.
  53 This variable is local to each terminal-emulator buffer.")
  54
  55 ;; If you are the sort of loser who uses scrolling without more breaks
  56 ;; and expects to actually see anything, you should probably set this to
  57 ;; around 400
  58 (defvar terminal-redisplay-interval 5000
  59   "*Maximum number of characters which will be processed by the
  60 terminal-emulator before a screen redisplay is forced.
  61 Set this to a large value for greater throughput,
  62 set it smaller for more frequent updates but overall slower
  63 performance.")
  64
  65 (defvar terminal-more-break-insertion
  66   "*** More break -- Press space to continue ***")
  67
  68 (defvar terminal-escape-map nil)
  69 (defvar terminal-map nil)
  70 (defvar terminal-more-break-map nil)
  71 (if terminal-map
  72     nil
  73   (let ((map (make-keymap)))
  74     (fillarray (car (cdr map)) 'te-pass-through)
  75     ;(define-key map "\C-l"
  76     ;  '(lambda () (interactive) (te-pass-through) (redraw-display)))
  77     (setq terminal-map map)))
  78
  79 ;(setq terminal-escape-map nil)
  80 (if terminal-escape-map
  81     nil
  82   (let ((map (make-keymap)))
  83     ;(fillarray map 'te-escape-extended-command-unread)
  84     (fillarray (car (cdr map)) 'undefined)
  85     (let ((s "0"))
  86       (while (<= (aref s 0) ?9)
  87         (define-key map s 'digit-argument)
  88         (aset s 0 (1+ (aref s 0)))))
  89     (define-key map "b" 'switch-to-buffer)
  90     (define-key map "o" 'other-window)
  91     (define-key map "e" 'te-set-escape-char)
  92     (define-key map "\C-l" 'redraw-display)
  93     (define-key map "\C-o" 'te-flush-pending-output)
  94     (define-key map "m" 'te-toggle-more-processing)
  95     (define-key map "x" 'te-escape-extended-command)
  96     ;;>> What use is this?  Why is it in the default terminal-emulator map?
  97     (define-key map "w" 'te-edit)
  98     (define-key map "?" 'te-escape-help)
  99     (define-key map (char-to-string help-char) 'te-escape-help)
 100     (setq terminal-escape-map map)))
 101
 102 (defvar te-escape-command-alist ())
 103 ;(setq te-escape-command-alist ())
 104 (if te-escape-command-alist
 105     nil
 106   (setq te-escape-command-alist
 107         '(("Set Escape Character" . te-set-escape-char)
 108           ;;>> What use is this?  Why is it in the default terminal-emulator map?
 109           ("Edit" . te-edit)
 110           ("Refresh" . redraw-display)
 111           ("Record Output" . te-set-output-log)
 112           ("Photo" . te-set-output-log)
 113           ("Tofu" . te-tofu) ;; confuse the uninitiated
 114           ("Stuff Input" . te-stuff-string)
 115           ("Flush Pending Output" . te-flush-pending-output)
 116           ("Enable More Processing" . te-enable-more-processing)
 117           ("Disable More Processing" . te-disable-more-processing)
 118           ("Scroll at end of page" . te-do-scrolling)
 119           ("Wrap at end of page" . te-do-wrapping)
 120           ("Switch To Buffer" . switch-to-buffer)
 121           ("Other Window" . other-window)
 122           ("Kill Buffer" . kill-buffer)
 123           ("Help" . te-escape-help)
 124           ("Set Redisplay Interval" . te-set-redisplay-interval)
 125           )))
 126
 127 ;(setq terminal-more-break-map nil)
 128 (if terminal-more-break-map
 129     nil
 130   (let ((map (make-keymap)))
 131     (fillarray (car (cdr map)) 'te-more-break-unread)
 132     (define-key map (char-to-string help-char) 'te-more-break-help)
 133     (define-key map " " 'te-more-break-resume)
 134     (define-key map "\C-l" 'redraw-display)
 135     (define-key map "\C-o" 'te-more-break-flush-pending-output)
 136     ;;>>> this isn't right
 137     ;(define-key map "\^?" 'te-more-break-flush-pending-output) ;DEL
 138     (define-key map "\r" 'te-more-break-advance-one-line)
 139
 140     (setq terminal-more-break-map map)))
 141
 142 \f
 143 ;;;;  escape map
 144
 145 (defun te-escape ()
 146   (interactive)
 147   (let (s
 148         (local (current-local-map))
 149         (global (current-global-map)))
 150     (unwind-protect
 151         (progn
 152           (use-global-map terminal-escape-map)
 153           (use-local-map terminal-escape-map)
 154           (setq s (read-key-sequence
 155                     (if prefix-arg
 156                         (format "Emacs Terminal escape> %d "
 157                                 (prefix-numeric-value prefix-arg))
 158                         "Emacs Terminal escape> "))))
 159       (use-global-map global)
 160       (use-local-map local))
 161     (message "")
 162     (cond ((string= s (make-string 1 terminal-escape-char))
 163            (setq last-command-char terminal-escape-char)
 164            (let ((terminal-escape-char -259))
 165              (te-pass-through)))
 166           ((setq s (lookup-key terminal-escape-map s))
 167            (call-interactively s)))))
 168
 169 (defun te-escape-help ()
 170   "Provide help on commands available after terminal-escape-char is typed."
 171   (interactive)
 172   (message "Terminal emulator escape help...")
 173   (let ((char (single-key-description terminal-escape-char)))
 174     (with-electric-help
 175       (function (lambda ()
 176          (princ (format "Terminal-emulator escape, invoked by \"%s\"
 177 Type \"%s\" twice to send a single \"%s\" through.
 178
 179 Other chars following \"%s\" are interpreted as follows:\n"
 180                         char char char char))
 181
 182          (princ (substitute-command-keys "\\{terminal-escape-map}\n"))
 183          (princ (format "\nSubcommands of \"%s\" (%s)\n"
 184                         (where-is-internal 'te-escape-extended-command
 185                                            terminal-escape-map nil t)
 186                         'te-escape-extended-command))
 187          (let ((l (if (fboundp 'sortcar)
 188                       (sortcar (copy-sequence te-escape-command-alist)
 189                                'string<)
 190                       (sort (copy-sequence te-escape-command-alist)
 191                             (function (lambda (a b)
 192                               (string< (car a) (car b))))))))
 193            (while l
 194              (let ((doc (or (documentation (cdr (car l)))
 195                             "Not documented")))
 196                (if (string-match "\n" doc)
 197                    ;; just use first line of documentation
 198                    (setq doc (substring doc 0 (match-beginning 0))))
 199                (princ "  \"")
 200                (princ (car (car l)))
 201                (princ "\":\n     ")
 202                (princ doc)
 203                (write-char ?\n))
 204              (setq l (cdr l))))
 205          nil)))))
 206
 207
 208
 209 (defun te-escape-extended-command ()
 210   (interactive)
 211   (let ((c (let ((completion-ignore-case t))
 212              (completing-read "terminal command: "
 213                               te-escape-command-alist
 214                               nil t))))
 215     (if c
 216         (catch 'foo
 217           (setq c (downcase c))
 218           (let ((l te-escape-command-alist))
 219             (while l
 220               (if (string= c (downcase (car (car l))))
 221                   (throw 'foo (call-interactively (cdr (car l))))
 222                 (setq l (cdr l)))))))))
 223
 224 ;; not used.
 225 (defun te-escape-extended-command-unread ()
 226   (interactive)
 227   (setq unread-command-events (listify-key-sequence (this-command-keys)))
 228   (te-escape-extended-command))
 229
 230 (defun te-set-escape-char (c)
 231   "Change the terminal-emulator escape character."
 232   (interactive "cSet escape character to: ")
 233   (let ((o terminal-escape-char))
 234     (message (if (= o c)
 235                  "\"%s\" is the escape char"
 236                  "\"%s\" is now the escape; \"%s\" passes through")
 237              (single-key-description c)
 238              (single-key-description o))
 239     (setq terminal-escape-char c)))
 240
 241
 242 (defun te-stuff-string (string)
 243   "Read a string to send to through the terminal emulator
 244 as though that string had been typed on the keyboard.
 245
 246 Very poor man's file transfer protocol."
 247   (interactive "sStuff string: ")
 248   (process-send-string te-process string))
 249
 250 (defun te-set-output-log (name)
 251   "Record output from the terminal emulator in a buffer."
 252   (interactive (list (if te-log-buffer
 253                          nil
 254                        (read-buffer "Record output in buffer: "
 255                                     (format "%s output-log"
 256                                             (buffer-name (current-buffer)))
 257                                     nil))))
 258   (if (or (null name) (equal name ""))
 259       (progn (setq te-log-buffer nil)
 260              (message "Output logging off."))
 261     (if (get-buffer name)
 262         nil
 263       (save-excursion
 264         (set-buffer (get-buffer-create name))
 265         (fundamental-mode)
 266         (buffer-disable-undo (current-buffer))
 267         (erase-buffer)))
 268     (setq te-log-buffer (get-buffer name))
 269     (message "Recording terminal emulator output into buffer \"%s\""
 270              (buffer-name te-log-buffer))))
 271
 272 (defun te-tofu ()
 273   "Discontinue output log."
 274   (interactive)
 275   (te-set-output-log nil))
 276
 277
 278 (defun te-toggle (sym arg)
 279   (set sym (cond ((not (numberp arg)) arg)
 280                  ((= arg 1) (not (symbol-value sym)))
 281                  ((< arg 0) nil)
 282                  (t t))))
 283
 284 (defun te-toggle-more-processing (arg)
 285   (interactive "p")
 286   (message (if (te-toggle 'terminal-more-processing arg)
 287                "More processing on" "More processing off"))
 288   (if terminal-more-processing (setq te-more-count -1)))
 289
 290 (defun te-toggle-scrolling (arg)
 291   (interactive "p")
 292   (message (if (te-toggle 'terminal-scrolling arg)
 293                "Scroll at end of page" "Wrap at end of page")))
 294
 295 (defun te-enable-more-processing ()
 296   "Enable ** MORE ** processing"
 297   (interactive)
 298   (te-toggle-more-processing t))
 299
 300 (defun te-disable-more-processing ()
 301   "Disable ** MORE ** processing"
 302   (interactive)
 303   (te-toggle-more-processing nil))
 304
 305 (defun te-do-scrolling ()
 306   "Scroll at end of page (yuck)"
 307   (interactive)
 308   (te-toggle-scrolling t))
 309
 310 (defun te-do-wrapping ()
 311   "Wrap to top of window at end of page"
 312   (interactive)
 313   (te-toggle-scrolling nil))
 314
 315
 316 (defun te-set-redisplay-interval (arg)
 317   "Set the maximum interval (in output characters) between screen updates.
 318 Set this number to large value for greater throughput,
 319 set it smaller for more frequent updates (but overall slower performance."
 320   (interactive "NMax number of output chars between redisplay updates: ")
 321   (setq arg (max arg 1))
 322   (setq terminal-redisplay-interval arg
 323         te-redisplay-count 0))
 324 \f
 325 ;;;; more map
 326
 327 ;; every command -must- call te-more-break-unwind
 328 ;; or grave lossage will result
 329
 330 (put 'te-more-break-unread 'suppress-keymap t)
 331 (defun te-more-break-unread ()
 332   (interactive)
 333   (if (= last-input-char terminal-escape-char)
 334       (call-interactively 'te-escape)
 335     (message "Continuing from more break (\"%s\" typed, %d chars output pending...)"
 336              (single-key-description last-input-char)
 337              (te-pending-output-length))
 338     (setq te-more-count 259259)
 339     (te-more-break-unwind)
 340     (let ((terminal-more-processing nil))
 341       (te-pass-through))))
 342
 343 (defun te-more-break-resume ()
 344   "Proceed past the **MORE** break,
 345 allowing the next page of output to appear"
 346   (interactive)
 347   (message "Continuing from more break")
 348   (te-more-break-unwind))
 349
 350 (defun te-more-break-help ()
 351   "Provide help on commands available in a terminal-emulator **MORE** break"
 352   (interactive)
 353   (message "Terminal-emulator more break help...")
 354   (sit-for 0)
 355   (with-electric-help
 356     (function (lambda ()
 357       (princ "Terminal-emulator more break.\n\n")
 358       (princ (format "Type \"%s\" (te-more-break-resume)\n%s\n"
 359                      (where-is-internal 'te-more-break-resume
 360                                         terminal-more-break-map nil t)
 361                      (documentation 'te-more-break-resume)))
 362       (princ (substitute-command-keys "\\{terminal-more-break-map}\n"))
 363       (princ "Any other key is passed through to the program
 364 running under the terminal emulator and disables more processing until
 365 all pending output has been dealt with.")
 366       nil))))
 367
 368
 369 (defun te-more-break-advance-one-line ()
 370   "Allow one more line of text to be output before doing another more break."
 371   (interactive)
 372   (setq te-more-count 1)
 373   (te-more-break-unwind))
 374
 375 (defun te-more-break-flush-pending-output ()
 376   "Discard any output which has been received by the terminal emulator but
 377 not yet proceesed and then proceed from the more break."
 378   (interactive)
 379   (te-more-break-unwind)
 380   (te-flush-pending-output))
 381
 382 (defun te-flush-pending-output ()
 383   "Discard any as-yet-unprocessed output which has been received by
 384 the terminal emulator."
 385   (interactive)
 386   ;; this could conceivably be confusing in the presence of
 387   ;; escape-sequences spanning process-output chunks
 388   (if (null (cdr te-pending-output))
 389       (message "(There is no output pending)")
 390     (let ((length (te-pending-output-length)))
 391       (message "Flushing %d chars of pending output" length)
 392       (setq te-pending-output
 393             (list 0 (format "\n*** %d chars of pending output flushed ***\n"
 394                             length)))
 395       (te-update-pending-output-display)
 396       (te-process-output nil)
 397       (sit-for 0))))
 398
 399 \f
 400 (defun te-pass-through ()
 401   "Character is passed to the program running under the terminal emulator.
 402 One characters is treated specially:
 403 the terminal escape character (normally C-^)
 404 lets you type a terminal emulator command."
 405   (interactive)
 406   (cond ((= last-input-char terminal-escape-char)
 407          (call-interactively 'te-escape))
 408         (t
 409          (and terminal-more-processing (null (cdr te-pending-output))
 410               (te-set-more-count nil))
 411          (send-string te-process (make-string 1 last-input-char))
 412          (te-process-output t))))
 413
 414
 415 (defun te-set-window-start ()
 416   (let* ((w (get-buffer-window (current-buffer)))
 417          (h (if w (window-height w))))
 418     (cond ((not w)) ; buffer not displayed
 419           ((>= h (/ (- (point) (point-min)) (1+ te-width)))
 420            ;; this is the normal case
 421            (set-window-start w (point-min)))
 422           ;; this happens if some vandal shrinks our window.
 423           ((>= h (/ (- (point-max) (point)) (1+ te-width)))
 424            (set-window-start w (- (point-max) (* h (1+ te-width)) -1)))
 425           ;; I give up.
 426           (t nil))))
 427
 428 (defun te-pending-output-length ()
 429   (let ((length (car te-pending-output))
 430         (tem (cdr te-pending-output)))
 431     (while tem
 432       (setq length (+ length (length (car tem))) tem (cdr tem)))
 433     length))
 434 \f
 435 ;;>> What use is this terminal-edit stuff anyway?
 436 ;;>>  If nothing else, it was written by somebody who didn't
 437 ;;>>  competently understand the terminal-emulator...
 438
 439 (defvar terminal-edit-map nil)
 440 (if terminal-edit-map
 441     nil
 442   (setq terminal-edit-map (make-sparse-keymap))
 443   (define-key terminal-edit-map "\C-c\C-c" 'terminal-cease-edit))
 444
 445 ;; Terminal Edit mode is suitable only for specially formatted data.
 446 (put 'terminal-edit-mode 'mode-class 'special)
 447
 448 (defun terminal-edit-mode ()
 449   "Major mode for editing the contents of a terminal-emulator buffer.
 450 The editing commands are the same as in Fundamental mode,
 451 together with a command \\<terminal-edit-mode-map>to return to terminal emulation: \\[terminal-cease-edit]."
 452   (use-local-map terminal-edit-map)
 453   (setq major-mode 'terminal-edit-mode)
 454   (setq mode-name "Terminal Edit")
 455   (setq mode-line-modified (default-value 'mode-line-modified))
 456   (setq mode-line-process nil)
 457   (run-hooks 'terminal-edit-mode-hook))
 458
 459 (defun te-edit ()
 460   "Start editing the terminal emulator buffer with ordinary Emacs commands."
 461   (interactive)
 462   (terminal-edit-mode)
 463   (set-buffer-modified-p (buffer-modified-p))
 464   ;; Make mode line update.
 465   (if (eq (key-binding "\C-c\C-c") 'terminal-cease-edit)
 466       (message "Editing: Type C-c C-c to return to Terminal")
 467     (message (substitute-command-keys
 468                "Editing: Type \\[terminal-cease-edit] to return to Terminal"))))
 469
 470 (defun terminal-cease-edit ()
 471   "Finish editing message; switch back to Terminal proper."
 472   (interactive)
 473
 474   ;;>> emulator will blow out if buffer isn't exactly te-width x te-height
 475   (let ((buffer-read-only nil))
 476     (widen)
 477     (let ((opoint (point-marker))
 478           (width te-width)
 479           (h (1- te-height)))
 480       (goto-char (point-min))
 481       (while (>= h 0)
 482         (let ((p (point)))
 483           (cond ((search-forward "\n" (+ p width) 'move)
 484                  (forward-char -1)
 485                  (insert-char ?\  (- width (- (point) p)))
 486                  (forward-char 1))
 487                 ((eobp)
 488                  (insert-char ?\  (- width (- (point) p))))
 489                 ((= (following-char) ?\n)
 490                  (forward-char 1))
 491                 (t
 492                  (setq p (point))
 493                  (if (search-forward "\n" nil t)
 494                      (delete-region p (1- (point)))
 495                      (delete-region p (point-max))))))
 496         (if (= h 0)
 497             (if (not (eobp)) (delete-region (point) (point-max)))
 498             (if (eobp) (insert ?\n)))
 499         (setq h (1- h)))
 500       (goto-char opoint)
 501       (set-marker opoint nil nil)
 502       (setq te-saved-point (point))
 503       (setq te-redisplay-count 0)
 504       (setq te-more-count -1)))
 505
 506   (setq mode-line-modified (default-value 'mode-line-modified))
 507   (setq major-mode 'terminal-mode)
 508   (setq mode-name "terminal")
 509   (setq mode-line-process '(": %s")))
 510 \f
 511 ;;;; more break hair
 512
 513 (defun te-more-break ()
 514   (te-set-more-count t)
 515   (make-local-variable 'te-more-old-point)
 516   (setq te-more-old-point (point))
 517   (make-local-variable 'te-more-old-local-map)
 518   (setq te-more-old-local-map (current-local-map))
 519   (use-local-map terminal-more-break-map)
 520   (make-local-variable 'te-more-old-filter)
 521   (setq te-more-old-filter (process-filter te-process))
 522   (make-local-variable 'te-more-old-mode-line-format)
 523   (setq te-more-old-mode-line-format mode-line-format
 524         mode-line-format (list "--   **MORE**  "
 525                                mode-line-buffer-identification
 526                                "%-"))
 527   (set-process-filter te-process
 528     (function (lambda (process string)
 529                 (save-excursion
 530                   (set-buffer (process-buffer process))
 531                   (setq te-pending-output (nconc te-pending-output
 532                                                  (list string))))
 533                   (te-update-pending-output-display))))
 534   (te-update-pending-output-display)
 535   (if (eq (window-buffer (selected-window)) (current-buffer))
 536       (message "More break "))
 537   (or (eobp)
 538       (null terminal-more-break-insertion)
 539       (save-excursion
 540         (forward-char 1)
 541         (delete-region (point) (+ (point) te-width))
 542         (insert terminal-more-break-insertion)))
 543   (run-hooks 'terminal-more-break-hook)
 544   (sit-for 0) ;get display to update
 545   (throw 'te-process-output t))
 546
 547 (defun te-more-break-unwind ()
 548   (use-local-map te-more-old-local-map)
 549   (set-process-filter te-process te-more-old-filter)
 550   (goto-char te-more-old-point)
 551   (setq mode-line-format te-more-old-mode-line-format)
 552   (set-buffer-modified-p (buffer-modified-p))
 553   (let ((buffer-read-only nil))
 554     (cond ((eobp))
 555           (terminal-more-break-insertion
 556            (forward-char 1)
 557            (delete-region (point)
 558                           (+ (point) (length terminal-more-break-insertion)))
 559            (insert-char ?\  te-width)
 560            (goto-char te-more-old-point)))
 561     (setq te-more-old-point nil)
 562     (let ((te-more-count 259259))
 563       (te-newline)))
 564   ;(sit-for 0)
 565   (te-process-output t))
 566
 567 (defun te-set-more-count (newline)
 568   (let ((line (/ (- (point) (point-min)) (1+ te-width))))
 569     (if newline (setq line (1+ line)))
 570     (cond ((= line te-height)
 571            (setq te-more-count te-height))
 572           ;>>>> something is strange.  Investigate this!
 573           ((= line (1- te-height))
 574            (setq te-more-count te-height))
 575           ((or (< line (/ te-height 2))
 576                (> (- te-height line) 10))
 577            ;; break at end of this page
 578            (setq te-more-count (- te-height line)))
 579           (t
 580            ;; migrate back towards top (ie bottom) of screen.
 581            (setq te-more-count (- te-height
 582                                   (if (> te-height 10) 2 1)))))))
 583
 584 \f
 585 ;;;; More or less straight-forward terminal escapes
 586
 587 ;; ^j, meaning `newline' to non-display programs.
 588 ;; (Who would think of ever writing a system which doesn't understand
 589 ;;  display terminals natively?  Un*x:  The Operating System of the Future.)
 590 (defun te-newline ()
 591   "Move down a line, optionally do more processing, perhaps wrap/scroll,
 592 move to start of new line, clear to end of line."
 593   (end-of-line)
 594   (cond ((not terminal-more-processing))
 595         ((< (setq te-more-count (1- te-more-count)) 0)
 596          (te-set-more-count t))
 597         ((eql te-more-count 0)
 598          ;; this doesn't return
 599          (te-more-break)))
 600   (if (eobp)
 601       (progn
 602         (delete-region (point-min) (+ (point-min) te-width))
 603         (goto-char (point-min))
 604         (if terminal-scrolling
 605             (progn (delete-char 1)
 606                    (goto-char (point-max))
 607                    (insert ?\n))))
 608     (forward-char 1)
 609     (delete-region (point) (+ (point) te-width)))
 610   (insert-char ?\  te-width)
 611   (beginning-of-line)
 612   (te-set-window-start))
 613
 614 ; ^p = x+32 y+32
 615 (defun te-move-to-position ()
 616   ;; must offset by #o40 since cretinous unix won't send a 004 char through
 617   (let ((y (- (te-get-char) 32))
 618         (x (- (te-get-char) 32)))
 619     (if (or (> x te-width)
 620             (> y te-height))
 621         ()
 622       (goto-char (+ (point-min) x (* y (1+ te-width))))
 623       ;(te-set-window-start?)
 624       ))
 625   (setq te-more-count -1))
 626
 627
 628
 629 ;; ^p c
 630 (defun te-clear-rest-of-line ()
 631   (save-excursion
 632     (let ((n (- (point) (progn (end-of-line) (point)))))
 633       (delete-region (point) (+ (point) n))
 634       (insert-char ?\  (- n)))))
 635
 636
 637 ;; ^p C
 638 (defun te-clear-rest-of-screen ()
 639   (save-excursion
 640     (te-clear-rest-of-line)
 641     (while (progn (end-of-line) (not (eobp)))
 642       (forward-char 1) (end-of-line)
 643       (delete-region (- (point) te-width) (point))
 644       (insert-char ?\  te-width))))
 645
 646
 647 ;; ^p ^l
 648 (defun te-clear-screen ()
 649   ;; regenerate buffer to compensate for (nonexistent!!) bugs.
 650   (erase-buffer)
 651   (let ((i 0))
 652     (while (< i te-height)
 653       (setq i (1+ i))
 654       (insert-char ?\  te-width)
 655       (insert ?\n)))
 656   (delete-region (1- (point-max)) (point-max))
 657   (goto-char (point-min))
 658   (setq te-more-count -1))
 659
 660
 661 ;; ^p ^o count+32
 662 (defun te-insert-lines ()
 663   (if (not (bolp))
 664       ();(error "fooI")
 665     (save-excursion
 666       (let* ((line (- te-height (/ (- (point) (point-min)) (1+ te-width)) -1))
 667              (n (min (- (te-get-char) ?\ ) line))
 668              (i 0))
 669         (delete-region (- (point-max) (* n (1+ te-width))) (point-max))
 670         (if (eql (point) (point-max)) (insert ?\n))
 671         (while (< i n)
 672           (setq i (1+ i))
 673           (insert-char ?\  te-width)
 674           (or (eql i line) (insert ?\n))))))
 675   (setq te-more-count -1))
 676
 677
 678 ;; ^p ^k count+32
 679 (defun te-delete-lines ()
 680   (if (not (bolp))
 681       ();(error "fooD")
 682     (let* ((line (- te-height (/ (- (point) (point-min)) (1+ te-width)) -1))
 683            (n (min (- (te-get-char) ?\ ) line))
 684            (i 0))
 685       (delete-region (point)
 686                      (min (+ (point) (* n (1+ te-width))) (point-max)))
 687       (save-excursion
 688         (goto-char (point-max))
 689         (while (< i n)
 690           (setq i (1+ i))
 691           (insert-char ?\  te-width)
 692           (or (eql i line) (insert ?\n))))))
 693   (setq te-more-count -1))
 694
 695 ;; ^p ^a
 696 (defun te-beginning-of-line ()
 697   (beginning-of-line))
 698
 699 ;; ^p ^b
 700 (defun te-backward-char ()
 701   (if (not (bolp))
 702       (backward-char 1)))
 703
 704 ;; ^p ^f
 705 (defun te-forward-char ()
 706   (if (not (eolp))
 707       (forward-char 1)))
 708
 709 \f
 710 ;; 0177
 711 (defun te-delete ()
 712   (if (bolp)
 713       ()
 714     (delete-region (1- (point)) (point))
 715     (insert ?\ )
 716     (forward-char -1)))
 717
 718 ;; ^p ^g
 719 (defun te-beep ()
 720   (beep))
 721
 722
 723 ;; ^p _ count+32
 724 (defun te-insert-spaces ()
 725   (let* ((p (point))
 726          (n (min (- (te-get-char) 32)
 727                  (- (progn (end-of-line) (point)) p))))
 728     (if (<= n 0)
 729         nil
 730       (delete-char (- n))
 731       (goto-char p)
 732       (insert-char ?\  n))
 733     (goto-char p)))
 734
 735 ;; ^p d count+32  (should be ^p ^d but cretinous un*x won't send ^d chars!!!)
 736 (defun te-delete-char ()
 737   (let* ((p (point))
 738          (n (min (- (te-get-char) 32)
 739                  (- (progn (end-of-line) (point)) p))))
 740     (if (<= n 0)
 741         nil
 742       (insert-char ?\  n)
 743       (goto-char p)
 744       (delete-char n))
 745     (goto-char p)))
 746
 747
 748 \f
 749 ;; disgusting unix-required shit
 750 ;;  Are we living twenty years in the past yet?
 751
 752 (defun te-losing-unix ()
 753   nil)
 754
 755 ;; ^i
 756 (defun te-output-tab ()
 757   (let* ((p (point))
 758          (x (- p (progn (beginning-of-line) (point))))
 759          (l (min (- 8 (logand x 7))
 760                  (progn (end-of-line) (- (point) p)))))
 761     (goto-char (+ p l))))
 762
 763 ;; ^p ^j
 764 ;; Handle the `do' or `nl' termcap capability.
 765 ;;>> I am not sure why this broken, obsolete, capability is here.
 766 ;;>> Perhaps it is for VIle.  No comment was made about why it
 767 ;;>> was added (in "Sun Dec  6 01:22:27 1987  Richard Stallman")
 768 (defun te-down-vertically-or-scroll ()
 769   "Move down a line vertically, or scroll at bottom."
 770   (let ((column (current-column)))
 771     (end-of-line)
 772     (if (eobp)
 773         (progn
 774           (delete-region (point-min) (+ (point-min) te-width))
 775           (goto-char (point-min))
 776           (delete-char 1)
 777           (goto-char (point-max))
 778           (insert ?\n)
 779           (insert-char ?\  te-width)
 780           (beginning-of-line))
 781       (forward-line 1))
 782     (move-to-column column))
 783   (te-set-window-start))
 784
 785 ;; Also:
 786 ;;  ^m => beginning-of-line (for which it -should- be using ^p ^a, right?!!)
 787 ;;  ^g => te-beep (for which it should use ^p ^g)
 788 ;;  ^h => te-backward-char (for which it should use ^p ^b)
 789
 790 \f
 791
 792 (defun te-filter (process string)
 793   (let* ((obuf (current-buffer))
 794          (m meta-flag))
 795     ;; can't use save-excursion, as that preserves point, which we don't want
 796     (unwind-protect
 797         (progn
 798           (set-buffer (process-buffer process))
 799           (goto-char te-saved-point)
 800           (and (bufferp te-log-buffer)
 801                (if (null (buffer-name te-log-buffer))
 802                    ;; killed
 803                    (setq te-log-buffer nil)
 804                  (set-buffer te-log-buffer)
 805                  (goto-char (point-max))
 806                  (insert-before-markers string)
 807                  (set-buffer (process-buffer process))))
 808           (setq te-pending-output (nconc te-pending-output (list string)))
 809           (te-update-pending-output-display)
 810           ;; this binding is needed because emacs looks at meta-flag when
 811           ;;  the keystroke is read from the keyboard, not when it is about
 812           ;;  to be fed into a keymap (or returned by read-char)
 813           ;; There still could be some screws, though.
 814           (let ((meta-flag m))
 815             (te-process-output (eq (current-buffer)
 816                                    (window-buffer (selected-window)))))
 817           (set-buffer (process-buffer process))
 818           (setq te-saved-point (point)))
 819       (set-buffer obuf))))
 820
 821 ;; (A version of the following comment which might be distractingly offensive
 822 ;; to some readers has been moved to term-nasty.el.)
 823 ;; unix lacks ITS-style tty control...
 824 (defun te-process-output (preemptable)
 825   ;;>> There seems no good reason to ever disallow preemption
 826   (setq preemptable t)
 827   (catch 'te-process-output
 828     (let ((buffer-read-only nil)
 829           (string nil) ostring start char (matchpos nil))
 830       (while (cdr te-pending-output)
 831         (setq ostring string
 832               start (car te-pending-output)
 833               string (car (cdr te-pending-output))
 834               char (aref string start))
 835         (if (eql (setq start (1+ start)) (length string))
 836             (progn (setq te-pending-output
 837                            (cons 0 (cdr (cdr te-pending-output)))
 838                          start 0
 839                          string (car (cdr te-pending-output)))
 840                    (te-update-pending-output-display))
 841             (setcar te-pending-output start))
 842         (if (and (> char ?\037) (< char ?\377))
 843             (cond ((eolp)
 844                    ;; unread char
 845                    (if (eql start 0)
 846                        (setq te-pending-output
 847                              (cons 0 (cons (make-string 1 char)
 848                                            (cdr te-pending-output))))
 849                        (setcar te-pending-output (1- start)))
 850                    (te-newline))
 851                   ((null string)
 852                    (delete-char 1) (insert char)
 853                    (te-redisplay-if-necessary 1))
 854                   (t
 855                    (let ((end (or (and (eq ostring string) matchpos)
 856                                   (setq matchpos (string-match
 857                                                    "[\000-\037\177-\377]"
 858                                                    string start))
 859                                   (length string))))
 860                      (delete-char 1) (insert char)
 861                      (setq char (point)) (end-of-line)
 862                      (setq end (min end (+ start (- (point) char))))
 863                      (goto-char char)
 864                      (if (eql end matchpos) (setq matchpos nil))
 865                      (delete-region (point) (+ (point) (- end start)))
 866                      (insert (if (and (eql start 0)
 867                                       (eql end (length string)))
 868                                  string
 869                                  (substring string start end)))
 870                      (if (eql end (length string))
 871                          (setq te-pending-output
 872                                (cons 0 (cdr (cdr te-pending-output))))
 873                          (setcar te-pending-output end))
 874                      (te-redisplay-if-necessary (1+ (- end start))))))
 875           ;; I suppose if I split the guts of this out into a separate
 876           ;;  function we could trivially emulate different terminals
 877           ;; Who cares in any case?  (Apart from stupid losers using rlogin)
 878           (funcall
 879             (if (eql char ?\^p)
 880                 (or (cdr (assq (te-get-char)
 881                                '((?= . te-move-to-position)
 882                                  (?c . te-clear-rest-of-line)
 883                                  (?C . te-clear-rest-of-screen)
 884                                  (?\C-o . te-insert-lines)
 885                                  (?\C-k . te-delete-lines)
 886                                  ;; not necessary, but help sometimes.
 887                                  (?\C-a . te-beginning-of-line)
 888                                  (?\C-b . te-backward-char)
 889                                  ;; should be C-d, but un*x
 890                                  ;;  pty's won't send \004 through!
 891                                  ;; Can you believe this?
 892                                  (?d . te-delete-char)
 893                                  (?_ . te-insert-spaces)
 894                                  ;; random
 895                                  (?\C-f . te-forward-char)
 896                                  (?\C-g . te-beep)
 897                                  (?\C-j . te-down-vertically-or-scroll)
 898                                  (?\C-l . te-clear-screen)
 899                                  )))
 900                     'te-losing-unix)
 901                 (or (cdr (assq char
 902                                '((?\C-j . te-newline)
 903                                  (?\177 . te-delete)
 904                                  ;; Did I ask to be sent these characters?
 905                                  ;; I don't remember doing so, either.
 906                                  ;; (Perhaps some operating system or
 907                                  ;; other is completely incompetent...)
 908                                  (?\C-m . te-beginning-of-line)
 909                                  (?\C-g . te-beep)
 910                                  (?\C-h . te-backward-char)
 911                                  (?\C-i . te-output-tab))))
 912                     'te-losing-unix)))
 913           (te-redisplay-if-necessary 1))
 914         (and preemptable
 915              (input-pending-p)
 916              ;; preemptable output!  Oh my!!
 917              (throw 'te-process-output t)))))
 918   ;; We must update window-point in every window displaying our buffer
 919   (let* ((s (selected-window))
 920          (w s))
 921     (while (not (eq s (setq w (next-window w))))
 922       (if (eq (window-buffer w) (current-buffer))
 923           (set-window-point w (point))))))
 924
 925 (defun te-get-char ()
 926   (if (cdr te-pending-output)
 927       (let ((start (car te-pending-output))
 928             (string (car (cdr te-pending-output))))
 929         (prog1 (aref string start)
 930           (if (eql (setq start (1+ start)) (length string))
 931               (setq te-pending-output (cons 0 (cdr (cdr te-pending-output))))
 932               (setcar te-pending-output start))))
 933     (catch 'char
 934       (let ((filter (process-filter te-process)))
 935         (unwind-protect
 936             (progn
 937               (set-process-filter te-process
 938                                   (function (lambda (p s)
 939                                     (or (eql (length s) 1)
 940                                         (setq te-pending-output (list 1 s)))
 941                                     (throw 'char (aref s 0)))))
 942               (accept-process-output te-process))
 943           (set-process-filter te-process filter))))))
 944
 945
 946 (defun te-redisplay-if-necessary (length)
 947   (and (<= (setq te-redisplay-count (- te-redisplay-count length)) 0)
 948        (eq (current-buffer) (window-buffer (selected-window)))
 949        (waiting-for-user-input-p)
 950        (progn (te-update-pending-output-display)
 951               (sit-for 0)
 952               (setq te-redisplay-count terminal-redisplay-interval))))
 953
 954 (defun te-update-pending-output-display ()
 955   (if (null (cdr te-pending-output))
 956       (setq te-pending-output-info "")
 957     (let ((length (te-pending-output-length)))
 958       (if (< length 1500)
 959           (setq te-pending-output-info "")
 960         (setq te-pending-output-info (format "(%dK chars output pending) "
 961                                              (/ (+ length 512) 1024))))))
 962   ;; update mode line
 963   (set-buffer-modified-p (buffer-modified-p)))
 964
 965 \f
 966 (defun te-sentinel (process message)
 967   (cond ((eq (process-status process) 'run))
 968         ((null (buffer-name (process-buffer process)))) ;deleted
 969         (t (let ((b (current-buffer)))
 970              (save-excursion
 971                (set-buffer (process-buffer process))
 972                (setq buffer-read-only nil)
 973                (fundamental-mode)
 974                (goto-char (point-max))
 975                (delete-blank-lines)
 976                (delete-horizontal-space)
 977                (insert "\n*******\n" message "*******\n"))
 978              (if (and (eq b (process-buffer process))
 979                       (waiting-for-user-input-p))
 980                  (progn (goto-char (point-max))
 981                         (recenter -1)))))))
 982 \f
 983 (defvar te-stty-string "stty -nl dec echo"
 984   "Shell command to set terminal modes for terminal emulator.")
 985 ;; This used to have `new' in it, but that loses outside BSD
 986 ;; and it's apparently not needed in BSD.
 987
 988 (defvar explicit-shell-file-name nil
 989   "*If non-nil, is file name to use for explicitly requested inferior shell.")
 990
 991 ;;;###autoload
 992 (defun terminal-emulator (buffer program args &optional width height)
 993   "Under a display-terminal emulator in BUFFER, run PROGRAM on arguments ARGS.
 994 ARGS is a list of argument-strings.  Remaining arguments are WIDTH and HEIGHT.
 995 BUFFER's contents are made an image of the display generated by that program,
 996 and any input typed when BUFFER is the current Emacs buffer is sent to that
 997 program an keyboard input.
 998
 999 Interactively, BUFFER defaults to \"*terminal*\" and PROGRAM and ARGS
1000 are parsed from an input-string using your usual shell.
1001 WIDTH and HEIGHT are determined from the size of the current window
1002 -- WIDTH will be one less than the window's width, HEIGHT will be its height.
1003
1004 To switch buffers and leave the emulator, or to give commands
1005 to the emulator itself (as opposed to the program running under it),
1006 type Control-^.  The following character is an emulator command.
1007 Type Control-^ twice to send it to the subprogram.
1008 This escape character may be changed using the variable `terminal-escape-char'.
1009
1010 `Meta' characters may not currently be sent through the terminal emulator.
1011
1012 Here is a list of some of the variables which control the behaviour
1013 of the emulator -- see their documentation for more information:
1014 terminal-escape-char, terminal-scrolling, terminal-more-processing,
1015 terminal-redisplay-interval.
1016
1017 This function calls the value of terminal-mode-hook if that exists
1018 and is non-nil after the terminal buffer has been set up and the
1019 subprocess started.
1020
1021 Presently with `termcap' only; if somebody sends us code to make this
1022 work with `terminfo' we will try to use it."
1023   (interactive
1024     (cons (save-excursion
1025             (set-buffer (get-buffer-create "*terminal*"))
1026             (buffer-name (if (or (not (boundp 'te-process))
1027                                  (null te-process)
1028                                  (not (eq (process-status te-process)
1029                                           'run)))
1030                              (current-buffer)
1031                            (generate-new-buffer "*terminal*"))))
1032           (append
1033             (let* ((default-s
1034                      ;; Default shell is same thing M-x shell uses.
1035                      (or explicit-shell-file-name
1036                          (getenv "ESHELL")
1037                          (getenv "SHELL")
1038                          "/bin/sh"))
1039                    (s (read-string
1040                        (format "Run program in emulator: (default %s) "
1041                                default-s))))
1042               (if (equal s "")
1043                   (list default-s '())
1044                 (te-parse-program-and-args s))))))
1045   (switch-to-buffer buffer)
1046   (if (null width) (setq width (- (window-width (selected-window)) 1)))
1047   (if (null height) (setq height (- (window-height (selected-window)) 1)))
1048   (terminal-mode)
1049   (setq te-width width te-height height)
1050   (setq mode-line-buffer-identification
1051         (list (format "Emacs terminal %dx%d: %%b  " te-width te-height)
1052               'te-pending-output-info))
1053   (let ((buffer-read-only nil))
1054     (te-clear-screen))
1055   (let (process)
1056     (while (setq process (get-buffer-process (current-buffer)))
1057       (if (y-or-n-p (format "Kill process %s? " (process-name process)))
1058           (delete-process process)
1059         (error "Process %s not killed" (process-name process)))))
1060   (condition-case err
1061       (let ((termcap
1062              ;; Because of Unix Brain Death(tm), we can't change
1063              ;;  the terminal type of a running process, and so
1064              ;;  terminal size and scrollability are wired-down
1065              ;;  at this point.  ("Detach?  What's that?")
1066              (concat (format "emacs-virtual:co#%d:li#%d:%s"
1067                              ;; Sigh.  These can't be dynamically changed.
1068                              te-width te-height (if terminal-scrolling
1069                                                     "" "ns:"))
1070                      ;;-- Basic things
1071                      ;; cursor-motion, bol, forward/backward char
1072                      "cm=^p=%+ %+ :cr=^p^a:le=^p^b:nd=^p^f:"
1073                      ;; newline, clear eof/eof, audible bell
1074                      "nw=^j:ce=^pc:cd=^pC:cl=^p^l:bl=^p^g:"
1075                      ;; insert/delete char/line
1076                      "IC=^p_%+ :DC=^pd%+ :AL=^p^o%+ :DL=^p^k%+ :"
1077                      ;;-- Not-widely-known (ie nonstandard) flags, which mean
1078                      ;; o writing in the last column of the last line
1079                      ;;   doesn't cause idiotic scrolling, and
1080                      ;; o don't use idiotische c-s/c-q sogenannte
1081                      ;;   ``flow control'' auf keinen Fall.
1082                      "LP:NF:"
1083                      ;;-- For stupid or obsolete programs
1084                      "ic=^p_!:dc=^pd!:al=^p^o!:dl=^p^k!:ho=^p=  :"
1085                      ;;-- For disgusting programs.
1086                      ;; (VI? What losers need these, I wonder?)
1087                      "im=:ei=:dm=:ed=:mi:do=^p^j:nl=^p^j:bs:")))
1088         (let ((process-environment
1089                (cons "TERM=emacs-virtual"
1090                      (cons (concat "TERMCAP=" termcap)
1091                            process-environment))))
1092           (setq te-process
1093                 (start-process "terminal-emulator" (current-buffer)
1094                                "/bin/sh" "-c"
1095                                ;; Yuck!!! Start a shell to set some terminal
1096                                ;; control characteristics.  Then start the
1097                                ;; "env" program to setup the terminal type
1098                                ;; Then finally start the program we wanted.
1099                                (format "%s; exec %s"
1100                                        te-stty-string
1101                                        (mapconcat 'te-quote-arg-for-sh
1102                                                   (cons program args) " ")))))
1103         (set-process-filter te-process 'te-filter)
1104         (set-process-sentinel te-process 'te-sentinel))
1105     (error (fundamental-mode)
1106            (signal (car err) (cdr err))))
1107   ;; sigh
1108   (if (default-value 'meta-flag)
1109       (progn (message
1110  "Note:  Meta key disabled due to maybe-eventually-reparable braindamage")
1111              (sit-for 1)))
1112   (setq inhibit-quit t)                 ;sport death
1113   (use-local-map terminal-map)
1114   (run-hooks 'terminal-mode-hook)
1115   (message "Entering emacs terminal-emulator...  Type %s %s for help"
1116            (single-key-description terminal-escape-char)
1117            (mapconcat 'single-key-description
1118                       (where-is-internal 'te-escape-help
1119                                          terminal-escape-map
1120                                          nil t)
1121                       " ")))
1122
1123
1124 (defun te-parse-program-and-args (s)
1125   (cond ((string-match "\\`\\([a-zA-Z0-9-+=_.@/:]+[ \t]*\\)+\\'" s)
1126          (let ((l ()) (p 0))
1127            (while p
1128              (setq l (cons (if (string-match
1129                                 "\\([a-zA-Z0-9-+=_.@/:]+\\)\\([ \t]+\\)*"
1130                                 s p)
1131                                (prog1 (substring s p (match-end 1))
1132                                  (setq p (match-end 0))
1133                                  (if (eql p (length s)) (setq p nil)))
1134                                (prog1 (substring s p)
1135                                  (setq p nil)))
1136                            l)))
1137            (setq l (nreverse l))
1138            (list (car l) (cdr l))))
1139         ((and (string-match "[ \t]" s) (not (file-exists-p s)))
1140          (list shell-file-name (list "-c" (concat "exec " s))))
1141         (t (list s ()))))
1142
1143 (put 'terminal-mode 'mode-class 'special)
1144 ;; This is only separated out from function terminal-emulator
1145 ;; to keep the latter a little more managable.
1146 (defun terminal-mode ()
1147   "Set up variables for use f the terminal-emualtor.
1148 One should not call this -- it is an internal function
1149 of the terminal-emulator"
1150   (kill-all-local-variables)
1151   (buffer-disable-undo (current-buffer))
1152   (setq major-mode 'terminal-mode)
1153   (setq mode-name "terminal")
1154 ; (make-local-variable 'Helper-return-blurb)
1155 ; (setq Helper-return-blurb "return to terminal simulator")
1156   (setq mode-line-process '(": %s"))
1157   (setq buffer-read-only t)
1158   (setq truncate-lines t)
1159   (make-local-variable 'terminal-escape-char)
1160   (setq terminal-escape-char (default-value 'terminal-escape-char))
1161   (make-local-variable 'terminal-scrolling)
1162   (setq terminal-scrolling (default-value 'terminal-scrolling))
1163   (make-local-variable 'terminal-more-processing)
1164   (setq terminal-more-processing (default-value 'terminal-more-processing))
1165   (make-local-variable 'terminal-redisplay-interval)
1166   (setq terminal-redisplay-interval (default-value 'terminal-redisplay-interval))
1167   (make-local-variable 'te-width)
1168   (make-local-variable 'te-height)
1169   (make-local-variable 'te-process)
1170   (make-local-variable 'te-pending-output)
1171   (setq te-pending-output (list 0))
1172   (make-local-variable 'te-saved-point)
1173   (setq te-saved-point (point-min))
1174   (make-local-variable 'te-pending-output-info) ;for the mode line
1175   (setq te-pending-output-info "")
1176   (make-local-variable 'inhibit-quit)
1177   ;(setq inhibit-quit t)
1178   (make-local-variable 'te-log-buffer)
1179   (setq te-log-buffer nil)
1180   (make-local-variable 'te-more-count)
1181   (setq te-more-count -1)
1182   (make-local-variable 'te-redisplay-count)
1183   (setq te-redisplay-count terminal-redisplay-interval)
1184   ;;>> Nothing can be done about this without decruftifying
1185   ;;>>  emacs keymaps.
1186   (make-local-variable 'meta-flag) ;sigh
1187   (setq meta-flag nil)
1188   ;(use-local-map terminal-mode-map)
1189   ;; terminal-mode-hook is called above in function terminal-emulator
1190   )
1191 \f
1192 ;;;; what a complete loss
1193
1194 (defun te-quote-arg-for-sh (string)
1195   (cond ((string-match "\\`[a-zA-Z0-9-+=_.@/:]+\\'"
1196                        string)
1197          string)
1198         ((not (string-match "[$]" string))
1199          ;; "[\"\\]" are special to sh and the lisp reader in the same way
1200          (prin1-to-string string))
1201         (t
1202          (let ((harder "")
1203                (start 0)
1204                (end 0))
1205            (while (cond ((>= start (length string))
1206                          nil)
1207                         ;; this is the set of chars magic with "..." in `sh'
1208                         ((setq end (string-match "[\"\\$]"
1209                                                  string start))
1210                          t)
1211                         (t (setq harder (concat harder
1212                                                 (substring string start)))
1213                            nil))
1214              (setq harder (concat harder (substring string start end)
1215                                   ;; Can't use ?\\ since `concat'
1216                                   ;; unfortunately does prin1-to-string
1217                                   ;; on fixna.  Amazing.
1218                                   "\\"
1219                                   (substring string
1220                                              end
1221                                              (1+ end)))
1222                    start (1+ end)))
1223            (concat "\"" harder "\"")))))
1224
1225 (provide 'terminal)
1226
1227 ;;; terminal.el ends here