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