1234567891011121314151617181920212223242526272829303132333435363738394041424344454647484950515253545556575859606162636465666768697071727374757677787980818283848586878889909192939495969798991001011021031041051061071081091101111121131141151161171181191201211221231241251261271281291301311321331341351361371381391401411421431441451461471481491501511521531541551561571581591601611621631641651661671681691701711721731741751761771781791801811821831841851861871881891901911921931941951961971981992002012022032042052062072082092102112122132142152162172182192202212222232242252262272282292302312322332342352362372382392402412422432442452462472482492502512522532542552562572582592602612622632642652662672682692702712722732742752762772782792802812822832842852862872882892902912922932942952962972982993003013023033043053063073083093103113123133143153163173183193203213223233243253263273283293303313323333343353363373383393403413423433443453463473483493503513523533543553563573583593603613623633643653663673683693703713723733743753763773783793803813823833843853863873883893903913923933943953963973983994004014024034044054064074084094104114124134144154164174184194204214224234244254264274284294304314324334344354364374384394404414424434444454464474484494504514524534544554564574584594604614624634644654664674684694704714724734744754764774784794804814824834844854864874884894904914924934944954964974984995005015025035045055065075085095105115125135145155165175185195205215225235245255265275285295305315325335345355365375385395405415425435445455465475485495505515525535545555565575585595605615625635645655665675685695705715725735745755765775785795805815825835845855865875885895905915925935945955965975985996006016026036046056066076086096106116126136146156166176186196206216226236246256266276286296306316326336346356366376386396406416426436446456466476486496506516526536546556566576586596606616626636646656666676686696706716726736746756766776786796806816826836846856866876886896906916926936946956966976986997007017027037047057067077087097107117127137147157167177187197207217227237247257267277287297307317327337347357367377387397407417427437447457467477487497507517527537547557567577587597607617627637647657667677687697707717727737747757767777787797807817827837847857867877887897907917927937947957967977987998008018028038048058068078088098108118128138148158168178188198208218228238248258268278288298308318328338348358368378388398408418428438448458468478488498508518528538548558568578588598608618628638648658668678688698708718728738748758768778788798808818828838848858868878888898908918928938948958968978988999009019029039049059069079089099109119129139149159169179189199209219229239249259269279289299309319329339349359369379389399409419429439449459469479489499509519529539549559569579589599609619629639649659669679689699709719729739749759769779789799809819829839849859869879889899909919929939949959969979989991000100110021003100410051006100710081009101010111012101310141015101610171018101910201021102210231024102510261027102810291030103110321033103410351036103710381039104010411042104310441045104610471048104910501051105210531054105510561057105810591060106110621063106410651066106710681069107010711072107310741075107610771078107910801081108210831084108510861087108810891090109110921093109410951096109710981099110011011102110311041105110611071108110911101111111211131114111511161117111811191120112111221123112411251126112711281129113011311132113311341135113611371138113911401141114211431144114511461147114811491150115111521153115411551156115711581159116011611162116311641165116611671168116911701171117211731174117511761177117811791180118111821183118411851186118711881189119011911192119311941195119611971198119912001201120212031204120512061207120812091210121112121213121412151216121712181219122012211222122312241225122612271228122912301231123212331234123512361237123812391240124112421243124412451246124712481249125012511252125312541255125612571258125912601261126212631264126512661267126812691270127112721273127412751276127712781279128012811282128312841285128612871288128912901291129212931294129512961297129812991300130113021303130413051306130713081309131013111312131313141315131613171318131913201321132213231324132513261327132813291330133113321333133413351336133713381339 |
- (require 'ehelp)
- (defgroup terminal nil
- "Terminal emulator for Emacs."
- :group 'terminals)
- (defcustom terminal-escape-char ?\C-^
- "All characters except for this are passed verbatim through the
- terminal-emulator. This character acts as a prefix for commands
- to the emulator program itself. Type this character twice to send
- it through the emulator. Type ? after typing it for a list of
- possible commands.
- This variable is local to each terminal-emulator buffer."
- :type 'character
- :group 'terminal)
- (defcustom terminal-scrolling t
- "If non-nil, the terminal-emulator will losingly `scroll' when output occurs
- past the bottom of the screen. If nil, output will win and `wrap' to the top
- of the screen.
- This variable is local to each terminal-emulator buffer."
- :type 'boolean
- :group 'terminal)
- (defcustom terminal-more-processing t
- "If non-nil, do more-processing.
- This variable is local to each terminal-emulator buffer."
- :type 'boolean
- :group 'terminal)
- (defcustom terminal-redisplay-interval 5000
- "Maximum number of characters which will be processed by the
- terminal-emulator before a screen redisplay is forced.
- Set this to a large value for greater throughput,
- set it smaller for more frequent updates but overall slower
- performance."
- :type 'integer
- :group 'terminal)
- (defvar terminal-more-break-insertion
- "*** More break -- Press space to continue ***")
- (defvar terminal-meta-map nil)
- (if terminal-meta-map
- nil
- (let ((map (make-sparse-keymap)))
- (define-key map [t] 'te-pass-through)
- (setq terminal-meta-map map)))
- (defvar terminal-map nil)
- (if terminal-map
- nil
- (let ((map (make-sparse-keymap)))
-
-
- (define-key map [menu-bar] (make-sparse-keymap))
- (define-key map [t] 'te-pass-through)
- (define-key map [switch-frame] 'handle-switch-frame)
- (define-key map "\e" terminal-meta-map)
-
-
- (setq terminal-map map)))
- (defvar terminal-escape-map nil)
- (if terminal-escape-map
- nil
- (let ((map (make-sparse-keymap)))
- (define-key map [t] 'undefined)
- (let ((s "0"))
- (while (<= (aref s 0) ?9)
- (define-key map s 'digit-argument)
- (aset s 0 (1+ (aref s 0)))))
- (define-key map "b" 'switch-to-buffer)
- (define-key map "o" 'other-window)
- (define-key map "e" 'te-set-escape-char)
- (define-key map "\C-l" 'redraw-display)
- (define-key map "\C-o" 'te-flush-pending-output)
- (define-key map "m" 'te-toggle-more-processing)
- (define-key map "x" 'te-escape-extended-command)
-
- (define-key map "w" 'te-edit)
- (define-key map "?" 'te-escape-help)
- (define-key map (char-to-string help-char) 'te-escape-help)
- (setq terminal-escape-map map)))
- (defvar te-escape-command-alist nil)
- (if te-escape-command-alist
- nil
- (setq te-escape-command-alist
- '(("Set Escape Character" . te-set-escape-char)
-
- ("Edit" . te-edit)
- ("Refresh" . redraw-display)
- ("Record Output" . te-set-output-log)
- ("Photo" . te-set-output-log)
- ("Tofu" . te-tofu)
- ("Stuff Input" . te-stuff-string)
- ("Flush Pending Output" . te-flush-pending-output)
- ("Enable More Processing" . te-enable-more-processing)
- ("Disable More Processing" . te-disable-more-processing)
- ("Scroll at end of page" . te-do-scrolling)
- ("Wrap at end of page" . te-do-wrapping)
- ("Switch To Buffer" . switch-to-buffer)
- ("Other Window" . other-window)
- ("Kill Buffer" . kill-buffer)
- ("Help" . te-escape-help)
- ("Set Redisplay Interval" . te-set-redisplay-interval)
- )))
- (defvar terminal-more-break-map nil)
- (if terminal-more-break-map
- nil
- (let ((map (make-sparse-keymap)))
- (define-key map [t] 'te-more-break-unread)
- (define-key map (char-to-string help-char) 'te-more-break-help)
- (define-key map " " 'te-more-break-resume)
- (define-key map "\C-l" 'redraw-display)
- (define-key map "\C-o" 'te-more-break-flush-pending-output)
-
-
- (define-key map "\r" 'te-more-break-advance-one-line)
- (setq terminal-more-break-map map)))
- (defvar te-process nil)
- (defvar te-log-buffer nil)
- (defvar te-height nil)
- (defvar te-width nil)
- (defvar te-more-count nil)
- (defvar te-redisplay-count nil)
- (defvar te-pending-output nil)
- (defvar te-saved-point)
- (defvar te-more-old-point nil)
- (defvar te-more-old-local-map nil)
- (defvar te-more-old-filter nil)
- (defvar te-more-old-mode-line-format nil)
- (defvar te-pending-output-info nil)
- (defconst te-terminal-name-prefix "emacs-em"
- "Prefix used for terminal type names for Terminfo.")
- (defconst te-terminfo-directory
- (file-name-as-directory
- (expand-file-name "emacs-terminfo" temporary-file-directory))
- "Directory used for run-time terminal definition files for Terminfo.")
- (defvar te-terminal-name nil)
- (defun te-escape ()
- (interactive)
- (let (s
- (local (current-local-map))
- (global (current-global-map)))
- (unwind-protect
- (progn
- (use-global-map terminal-escape-map)
- (use-local-map terminal-escape-map)
- (setq s (read-key-sequence
- (if current-prefix-arg
- (format "Emacs Terminal escape[%s for help]> %d "
- (substitute-command-keys
- "\\<terminal-escape-map>\\[te-escape-help]")
- (prefix-numeric-value current-prefix-arg))
- (format "Emacs Terminal escape[%s for help]> "
- (substitute-command-keys
- "\\<terminal-escape-map>\\[te-escape-help]"))))))
- (use-global-map global)
- (use-local-map local))
- (message "")
- (cond
-
-
- ((and (stringp s)
- (string= s (make-string 1 terminal-escape-char)))
- (setq last-command-event terminal-escape-char)
- (let ((terminal-escape-char -259))
- (te-pass-through)))
- ((setq s (lookup-key terminal-escape-map s))
- (call-interactively s)))
- ))
- (defun te-escape-help ()
- "Provide help on commands available after terminal-escape-char is typed."
- (interactive)
- (message "Terminal emulator escape help...")
- (let ((char (single-key-description terminal-escape-char)))
- (with-electric-help
- (function (lambda ()
- (princ (format "Terminal-emulator escape, invoked by \"%s\"
- Type \"%s\" twice to send a single \"%s\" through.
- Other chars following \"%s\" are interpreted as follows:\n"
- char char char char))
- (princ (substitute-command-keys "\\{terminal-escape-map}\n"))
- (princ (format "\nSubcommands of \"%s\" (%s)\n"
- (where-is-internal 'te-escape-extended-command
- terminal-escape-map t)
- 'te-escape-extended-command))
- (let ((l (sort (copy-sequence te-escape-command-alist)
- (function (lambda (a b)
- (string< (car a) (car b)))))))
- (while l
- (let ((doc (or (documentation (cdr (car l)))
- "Not documented")))
- (if (string-match "\n" doc)
-
- (setq doc (substring doc 0 (match-beginning 0))))
- (princ " \"")
- (princ (car (car l)))
- (princ "\":\n ")
- (princ doc)
- (write-char ?\n))
- (setq l (cdr l))))
- nil)))))
- (defun te-escape-extended-command ()
- (interactive)
- (let ((c (let ((completion-ignore-case t))
- (completing-read "terminal command: "
- te-escape-command-alist
- nil t))))
- (if c
- (catch 'foo
- (setq c (downcase c))
- (let ((l te-escape-command-alist))
- (while l
- (if (string= c (downcase (car (car l))))
- (throw 'foo (call-interactively (cdr (car l))))
- (setq l (cdr l)))))))))
- (defun te-escape-extended-command-unread ()
- (interactive)
- (setq unread-command-events (listify-key-sequence (this-command-keys)))
- (te-escape-extended-command))
- (defun te-set-escape-char (c)
- "Change the terminal-emulator escape character."
- (interactive "cSet escape character to: ")
- (let ((o terminal-escape-char))
- (message (if (= o c)
- "\"%s\" is the escape char"
- "\"%s\" is now the escape; \"%s\" passes through")
- (single-key-description c)
- (single-key-description o))
- (setq terminal-escape-char c)))
- (defun te-stuff-string (string)
- "Read a string to send to through the terminal emulator
- as though that string had been typed on the keyboard.
- Very poor man's file transfer protocol."
- (interactive "sStuff string: ")
- (process-send-string te-process string))
- (defun te-set-output-log (name)
- "Record output from the terminal emulator in a buffer."
- (interactive (list (if te-log-buffer
- nil
- (read-buffer "Record output in buffer: "
- (format "%s output-log"
- (buffer-name (current-buffer)))
- nil))))
- (if (or (null name) (equal name ""))
- (progn (setq te-log-buffer nil)
- (message "Output logging off."))
- (if (get-buffer name)
- nil
- (with-current-buffer (get-buffer-create name)
- (fundamental-mode)
- (buffer-disable-undo (current-buffer))
- (erase-buffer)))
- (setq te-log-buffer (get-buffer name))
- (message "Recording terminal emulator output into buffer \"%s\""
- (buffer-name te-log-buffer))))
- (defun te-tofu ()
- "Discontinue output log."
- (interactive)
- (te-set-output-log nil))
- (defun te-toggle (sym arg)
- (set sym (cond ((not (numberp arg)) arg)
- ((= arg 1) (not (symbol-value sym)))
- ((< arg 0) nil)
- (t t))))
- (defun te-toggle-more-processing (arg)
- (interactive "p")
- (message (if (te-toggle 'terminal-more-processing arg)
- "More processing on" "More processing off"))
- (if terminal-more-processing (setq te-more-count -1)))
- (defun te-toggle-scrolling (arg)
- (interactive "p")
- (message (if (te-toggle 'terminal-scrolling arg)
- "Scroll at end of page" "Wrap at end of page")))
- (defun te-enable-more-processing ()
- "Enable ** MORE ** processing"
- (interactive)
- (te-toggle-more-processing t))
- (defun te-disable-more-processing ()
- "Disable ** MORE ** processing"
- (interactive)
- (te-toggle-more-processing nil))
- (defun te-do-scrolling ()
- "Scroll at end of page (yuck)"
- (interactive)
- (te-toggle-scrolling t))
- (defun te-do-wrapping ()
- "Wrap to top of window at end of page"
- (interactive)
- (te-toggle-scrolling nil))
- (defun te-set-redisplay-interval (arg)
- "Set the maximum interval (in output characters) between screen updates.
- Set this number to large value for greater throughput,
- set it smaller for more frequent updates (but overall slower performance."
- (interactive "NMax number of output chars between redisplay updates: ")
- (setq arg (max arg 1))
- (setq terminal-redisplay-interval arg
- te-redisplay-count 0))
- (put 'te-more-break-unread 'suppress-keymap t)
- (defun te-more-break-unread ()
- (interactive)
- (if (eq last-input-event terminal-escape-char)
- (call-interactively 'te-escape)
- (message "Continuing from more break (\"%s\" typed, %d chars output pending...)"
- (single-key-description last-input-event)
- (te-pending-output-length))
- (setq te-more-count 259259)
- (te-more-break-unwind)
- (let ((terminal-more-processing nil))
- (te-pass-through))))
- (defun te-more-break-resume ()
- "Proceed past the **MORE** break,
- allowing the next page of output to appear"
- (interactive)
- (message "Continuing from more break")
- (te-more-break-unwind))
- (defun te-more-break-help ()
- "Provide help on commands available in a terminal-emulator **MORE** break"
- (interactive)
- (message "Terminal-emulator more break help...")
- (sit-for 0)
- (with-electric-help
- (function (lambda ()
- (princ "Terminal-emulator more break.\n\n")
- (princ (format "Type \"%s\" (te-more-break-resume)\n%s\n"
- (where-is-internal 'te-more-break-resume
- terminal-more-break-map t)
- (documentation 'te-more-break-resume)))
- (princ (substitute-command-keys "\\{terminal-more-break-map}\n"))
- (princ "Any other key is passed through to the program
- running under the terminal emulator and disables more processing until
- all pending output has been dealt with.")
- nil))))
- (defun te-more-break-advance-one-line ()
- "Allow one more line of text to be output before doing another more break."
- (interactive)
- (setq te-more-count 1)
- (te-more-break-unwind))
- (defun te-more-break-flush-pending-output ()
- "Discard any output which has been received by the terminal emulator but
- not yet processed and then proceed from the more break."
- (interactive)
- (te-more-break-unwind)
- (te-flush-pending-output))
- (defun te-flush-pending-output ()
- "Discard any as-yet-unprocessed output which has been received by
- the terminal emulator."
- (interactive)
-
-
- (if (null (cdr te-pending-output))
- (message "(There is no output pending)")
- (let ((length (te-pending-output-length)))
- (message "Flushing %d chars of pending output" length)
- (setq te-pending-output
- (list 0 (format "\n*** %d chars of pending output flushed ***\n"
- length)))
- (te-update-pending-output-display)
- (te-process-output nil)
- (sit-for 0))))
- (defun te-pass-through ()
- "Character is passed to the program running under the terminal emulator.
- One characters is treated specially:
- the terminal escape character (normally C-^)
- lets you type a terminal emulator command."
- (interactive)
- (cond ((eq last-input-event terminal-escape-char)
- (call-interactively 'te-escape))
- (t
-
- (if (and (symbolp last-input-event)
- (get last-input-event 'ascii-character))
- (setq last-input-event (get last-input-event 'ascii-character)))
-
- (if (and (integerp last-input-event)
- (not (zerop (logand last-input-event ?\M-\^@))))
- (setq last-input-event (+ 128 (logand last-input-event 127))))
-
-
-
-
- (if (integerp last-input-event)
- (progn
- (and terminal-more-processing (null (cdr te-pending-output))
- (te-set-more-count nil))
- (process-send-string te-process (make-string 1 last-input-event))
- (te-process-output t))
- (message "Function key `%s' ignored"
- (single-key-description last-input-event))))))
- (defun te-set-window-start ()
- (let* ((w (get-buffer-window (current-buffer)))
- (h (if w (window-height w))))
- (cond ((not w))
- ((>= h (/ (- (point) (point-min)) (1+ te-width)))
-
- (set-window-start w (point-min)))
-
- ((>= h (/ (- (point-max) (point)) (1+ te-width)))
- (set-window-start w (- (point-max) (* h (1+ te-width)) -1)))
-
- (t nil))))
- (defun te-pending-output-length ()
- (let ((length (car te-pending-output))
- (tem (cdr te-pending-output)))
- (while tem
- (setq length (+ length (length (car tem))) tem (cdr tem)))
- length))
- (defvar terminal-edit-map nil)
- (if terminal-edit-map
- nil
- (setq terminal-edit-map (make-sparse-keymap))
- (define-key terminal-edit-map "\C-c\C-c" 'terminal-cease-edit))
- (put 'terminal-edit-mode 'mode-class 'special)
- (defun terminal-edit-mode ()
- "Major mode for editing the contents of a terminal-emulator buffer.
- The editing commands are the same as in Fundamental mode,
- together with a command \\<terminal-edit-map>to return to terminal emulation: \\[terminal-cease-edit]."
- (use-local-map terminal-edit-map)
- (setq major-mode 'terminal-edit-mode)
- (setq mode-name "Terminal Edit")
- (setq mode-line-modified (default-value 'mode-line-modified))
- (setq mode-line-process nil)
- (run-mode-hooks 'terminal-edit-mode-hook))
- (defun te-edit ()
- "Start editing the terminal emulator buffer with ordinary Emacs commands."
- (interactive)
- (terminal-edit-mode)
- (force-mode-line-update)
-
- (if (eq (key-binding "\C-c\C-c") 'terminal-cease-edit)
- (message "Editing: Type C-c C-c to return to Terminal")
- (message "%s"
- (substitute-command-keys
- "Editing: Type \\[terminal-cease-edit] to return to Terminal"))))
- (defun terminal-cease-edit ()
- "Finish editing message; switch back to Terminal proper."
- (interactive)
-
- (let ((buffer-read-only nil))
- (widen)
- (let ((opoint (point-marker))
- (width te-width)
- (h (1- te-height)))
- (goto-char (point-min))
- (while (>= h 0)
- (let ((p (point)))
- (cond ((search-forward "\n" (+ p width) 'move)
- (forward-char -1)
- (insert-char ?\s (- width (- (point) p)))
- (forward-char 1))
- ((eobp)
- (insert-char ?\s (- width (- (point) p))))
- ((= (following-char) ?\n)
- (forward-char 1))
- (t
- (setq p (point))
- (if (search-forward "\n" nil t)
- (delete-region p (1- (point)))
- (delete-region p (point-max))))))
- (if (= h 0)
- (if (not (eobp)) (delete-region (point) (point-max)))
- (if (eobp) (insert ?\n)))
- (setq h (1- h)))
- (goto-char opoint)
- (set-marker opoint nil nil)
- (setq te-saved-point (point))
- (setq te-redisplay-count 0)
- (setq te-more-count -1)))
- (setq mode-line-modified (default-value 'mode-line-modified))
- (use-local-map terminal-map)
- (setq major-mode 'terminal-mode)
- (setq mode-name "terminal")
- (setq mode-line-process '(":%s")))
- (defun te-more-break ()
- (te-set-more-count t)
- (make-local-variable 'te-more-old-point)
- (setq te-more-old-point (point))
- (make-local-variable 'te-more-old-local-map)
- (setq te-more-old-local-map (current-local-map))
- (use-local-map terminal-more-break-map)
- (make-local-variable 'te-more-old-filter)
- (setq te-more-old-filter (process-filter te-process))
- (make-local-variable 'te-more-old-mode-line-format)
- (setq te-more-old-mode-line-format mode-line-format
- mode-line-format (list "-- **MORE** "
- mode-line-buffer-identification
- "%-"))
- (set-process-filter te-process
- (function (lambda (process string)
- (with-current-buffer (process-buffer process)
- (setq te-pending-output (nconc te-pending-output
- (list string))))
- (te-update-pending-output-display))))
- (te-update-pending-output-display)
- (if (eq (window-buffer (selected-window)) (current-buffer))
- (message "More break "))
- (or (eobp)
- (null terminal-more-break-insertion)
- (save-excursion
- (forward-char 1)
- (delete-region (point) (+ (point) te-width))
- (insert terminal-more-break-insertion)))
- (run-hooks 'terminal-more-break-hook)
- (sit-for 0)
- (throw 'te-process-output t))
- (defun te-more-break-unwind ()
- (use-local-map te-more-old-local-map)
- (set-process-filter te-process te-more-old-filter)
- (goto-char te-more-old-point)
- (setq mode-line-format te-more-old-mode-line-format)
- (force-mode-line-update)
- (let ((buffer-read-only nil))
- (cond ((eobp))
- (terminal-more-break-insertion
- (forward-char 1)
- (delete-region (point)
- (+ (point) (length terminal-more-break-insertion)))
- (insert-char ?\s te-width)
- (goto-char te-more-old-point)))
- (setq te-more-old-point nil)
- (let ((te-more-count 259259))
- (te-newline)))
-
- (te-process-output t))
- (defun te-set-more-count (newline)
- (let ((line (/ (- (point) (point-min)) (1+ te-width))))
- (if newline (setq line (1+ line)))
- (cond ((= line te-height)
- (setq te-more-count te-height))
-
- ((= line (1- te-height))
- (setq te-more-count te-height))
- ((or (< line (/ te-height 2))
- (> (- te-height line) 10))
-
- (setq te-more-count (- te-height line)))
- (t
-
- (setq te-more-count (- te-height
- (if (> te-height 10) 2 1)))))))
- (defun te-newline ()
- "Move down a line, optionally do more processing, perhaps wrap/scroll,
- move to start of new line, clear to end of line."
- (end-of-line)
- (cond ((not terminal-more-processing))
- ((< (setq te-more-count (1- te-more-count)) 0)
- (te-set-more-count t))
- ((eq te-more-count 0)
-
- (te-more-break)))
- (if (eobp)
- (progn
- (delete-region (point-min) (+ (point-min) te-width))
- (goto-char (point-min))
- (if terminal-scrolling
- (progn (delete-char 1)
- (goto-char (point-max))
- (insert ?\n))))
- (forward-char 1)
- (delete-region (point) (+ (point) te-width)))
- (insert-char ?\s te-width)
- (beginning-of-line)
- (te-set-window-start))
- (defun te-move-to-position ()
-
- (let ((y (- (te-get-char) 32))
- (x (- (te-get-char) 32)))
- (if (or (> x te-width)
- (> y te-height))
- ()
- (goto-char (+ (point-min) x (* y (1+ te-width))))
-
- ))
- (setq te-more-count -1))
- (defun te-clear-rest-of-line ()
- (save-excursion
- (let ((n (- (point) (progn (end-of-line) (point)))))
- (delete-region (point) (+ (point) n))
- (insert-char ?\s (- n)))))
- (defun te-clear-rest-of-screen ()
- (save-excursion
- (te-clear-rest-of-line)
- (while (progn (end-of-line) (not (eobp)))
- (forward-char 1) (end-of-line)
- (delete-region (- (point) te-width) (point))
- (insert-char ?\s te-width))))
- (defun te-clear-screen ()
-
- (erase-buffer)
- (let ((i 0))
- (while (< i te-height)
- (setq i (1+ i))
- (insert-char ?\s te-width)
- (insert ?\n)))
- (delete-region (1- (point-max)) (point-max))
- (goto-char (point-min))
- (setq te-more-count -1))
- (defun te-insert-lines ()
- (if (not (bolp))
- ()
- (save-excursion
- (let* ((line (- te-height (/ (- (point) (point-min)) (1+ te-width)) -1))
- (n (min (- (te-get-char) ?\s) line))
- (i 0))
- (delete-region (- (point-max) (* n (1+ te-width))) (point-max))
- (if (eq (point) (point-max)) (insert ?\n))
- (while (< i n)
- (setq i (1+ i))
- (insert-char ?\s te-width)
- (or (eq i line) (insert ?\n))))))
- (setq te-more-count -1))
- (defun te-delete-lines ()
- (if (not (bolp))
- ()
- (let* ((line (- te-height (/ (- (point) (point-min)) (1+ te-width)) -1))
- (n (min (- (te-get-char) ?\s) line))
- (i 0))
- (delete-region (point)
- (min (+ (point) (* n (1+ te-width))) (point-max)))
- (save-excursion
- (goto-char (point-max))
- (while (< i n)
- (setq i (1+ i))
- (insert-char ?\s te-width)
- (or (eq i line) (insert ?\n))))))
- (setq te-more-count -1))
- (defun te-beginning-of-line ()
- (beginning-of-line))
- (defun te-backward-char ()
- (if (not (bolp))
- (backward-char 1)))
- (defun te-forward-char ()
- (if (not (eolp))
- (forward-char 1)))
- (defun te-delete ()
- (if (bolp)
- ()
- (delete-region (1- (point)) (point))
- (insert ?\s)
- (forward-char -1)))
- (defun te-beep ()
- (beep))
- (defun te-insert-spaces ()
- (let* ((p (point))
- (n (min (- (te-get-char) 32)
- (- (progn (end-of-line) (point)) p))))
- (if (<= n 0)
- nil
- (delete-char (- n))
- (goto-char p)
- (insert-char ?\s n))
- (goto-char p)))
- (defun te-delete-char ()
- (let* ((p (point))
- (n (min (- (te-get-char) 32)
- (- (progn (end-of-line) (point)) p))))
- (if (<= n 0)
- nil
- (insert-char ?\s n)
- (goto-char p)
- (delete-char n))
- (goto-char p)))
- (defun te-losing-unix ()
- nil)
- (defun te-output-tab ()
- (let* ((p (point))
- (x (- p (progn (beginning-of-line) (point))))
- (l (min (- 8 (logand x 7))
- (progn (end-of-line) (- (point) p)))))
- (goto-char (+ p l))))
- (defun te-down-vertically-or-scroll ()
- "Move down a line vertically, or scroll at bottom."
- (let ((column (current-column)))
- (end-of-line)
- (if (eobp)
- (progn
- (delete-region (point-min) (+ (point-min) te-width))
- (goto-char (point-min))
- (delete-char 1)
- (goto-char (point-max))
- (insert ?\n)
- (insert-char ?\s te-width)
- (beginning-of-line))
- (forward-line 1))
- (move-to-column column))
- (te-set-window-start))
- (defun te-filter (process string)
- (with-current-buffer (process-buffer process)
- (goto-char te-saved-point)
- (and (bufferp te-log-buffer)
- (if (null (buffer-name te-log-buffer))
-
- (setq te-log-buffer nil)
- (set-buffer te-log-buffer)
- (goto-char (point-max))
- (insert-before-markers string)
- (set-buffer (process-buffer process))))
- (setq te-pending-output (nconc te-pending-output (list string)))
- (te-update-pending-output-display)
- (te-process-output (eq (current-buffer)
- (window-buffer (selected-window))))
- (set-buffer (process-buffer process))
- (setq te-saved-point (point))))
- (defun te-process-output (preemptible)
-
- (setq preemptible t)
- (catch 'te-process-output
- (let ((buffer-read-only nil)
- (string nil) ostring start char (matchpos nil))
- (while (cdr te-pending-output)
- (setq ostring string
- start (car te-pending-output)
- string (car (cdr te-pending-output))
- char (aref string start))
- (if (eq (setq start (1+ start)) (length string))
- (progn (setq te-pending-output
- (cons 0 (cdr (cdr te-pending-output)))
- start 0
- string (car (cdr te-pending-output)))
- (te-update-pending-output-display))
- (setcar te-pending-output start))
- (if (and (> char ?\037) (< char ?\377))
- (cond ((eolp)
-
- (if (eq start 0)
- (setq te-pending-output
- (cons 0 (cons (make-string 1 char)
- (cdr te-pending-output))))
- (setcar te-pending-output (1- start)))
- (te-newline))
- ((null string)
- (delete-char 1) (insert char)
- (te-redisplay-if-necessary 1))
- (t
- (let ((end (or (and (eq ostring string) matchpos)
- (setq matchpos (string-match
- "[\000-\037\177-\377]"
- string start))
- (length string))))
- (delete-char 1) (insert char)
- (setq char (point)) (end-of-line)
- (setq end (min end (+ start (- (point) char))))
- (goto-char char)
- (if (eq end matchpos) (setq matchpos nil))
- (delete-region (point) (+ (point) (- end start)))
- (insert (if (and (eq start 0)
- (eq end (length string)))
- string
- (substring string start end)))
- (if (eq end (length string))
- (setq te-pending-output
- (cons 0 (cdr (cdr te-pending-output))))
- (setcar te-pending-output end))
- (te-redisplay-if-necessary (1+ (- end start))))))
-
-
-
- (funcall
- (if (eq char ?\)
- (or (cdr (assq (te-get-char)
- '((?= . te-move-to-position)
- (?c . te-clear-rest-of-line)
- (?C . te-clear-rest-of-screen)
- (?\C-o . te-insert-lines)
- (?\C-k . te-delete-lines)
-
- (?\C-a . te-beginning-of-line)
- (?\C-b . te-backward-char)
-
-
-
- (?d . te-delete-char)
- (?_ . te-insert-spaces)
-
- (?\C-f . te-forward-char)
- (?\C-g . te-beep)
- (?\C-j . te-down-vertically-or-scroll)
- (?\C-l . te-clear-screen)
- )))
- 'te-losing-unix)
- (or (cdr (assq char
- '((?\C-j . te-newline)
- (?\177 . te-delete)
-
-
-
-
- (?\C-m . te-beginning-of-line)
- (?\C-g . te-beep)
- (?\C-h . te-backward-char)
- (?\C-i . te-output-tab))))
- 'te-losing-unix)))
- (te-redisplay-if-necessary 1))
- (and preemptible
- (input-pending-p)
-
- (throw 'te-process-output t)))))
-
- (walk-windows (lambda (w)
- (when (and (not (eq w (selected-window)))
- (eq (window-buffer w) (current-buffer)))
- (set-window-point w (point))))))
- (defun te-get-char ()
- (if (cdr te-pending-output)
- (let ((start (car te-pending-output))
- (string (car (cdr te-pending-output))))
- (prog1 (aref string start)
- (if (eq (setq start (1+ start)) (length string))
- (setq te-pending-output (cons 0 (cdr (cdr te-pending-output))))
- (setcar te-pending-output start))))
- (catch 'char
- (let ((filter (process-filter te-process)))
- (unwind-protect
- (progn
- (set-process-filter te-process
- (function (lambda (_p s)
- (or (eq (length s) 1)
- (setq te-pending-output (list 1 s)))
- (throw 'char (aref s 0)))))
- (accept-process-output te-process))
- (set-process-filter te-process filter))))))
- (defun te-redisplay-if-necessary (length)
- (and (<= (setq te-redisplay-count (- te-redisplay-count length)) 0)
- (eq (current-buffer) (window-buffer (selected-window)))
- (waiting-for-user-input-p)
- (progn (te-update-pending-output-display)
- (sit-for 0)
- (setq te-redisplay-count terminal-redisplay-interval))))
- (defun te-update-pending-output-display ()
- (if (null (cdr te-pending-output))
- (setq te-pending-output-info "")
- (let ((length (te-pending-output-length)))
- (if (< length 1500)
- (setq te-pending-output-info "")
- (setq te-pending-output-info (format "(%dK chars output pending) "
- (/ (+ length 512) 1024))))))
- (force-mode-line-update))
- (defun te-sentinel (process message)
- (cond ((eq (process-status process) 'run))
- ((null (buffer-name (process-buffer process))))
- (t (let ((b (current-buffer)))
- (with-current-buffer (process-buffer process)
- (setq buffer-read-only nil)
- (fundamental-mode)
- (goto-char (point-max))
- (delete-blank-lines)
- (delete-horizontal-space)
- (insert "\n*******\n" message "*******\n"))
- (if (and (eq b (process-buffer process))
- (waiting-for-user-input-p))
- (progn (goto-char (point-max))
- (recenter -1)))))))
- (defvar te-stty-string "stty -nl erase '^?' kill '^u' intr '^c' echo pass8"
- "Shell command to set terminal modes for terminal emulator.")
- (defcustom explicit-shell-file-name nil
- "If non-nil, is file name to use for explicitly requested inferior shell."
- :type '(choice (const :tag "None" nil)
- file)
- :group 'terminal)
- (defun terminal-emulator (buffer program args &optional width height)
- "Under a display-terminal emulator in BUFFER, run PROGRAM on arguments ARGS.
- ARGS is a list of argument-strings. Remaining arguments are WIDTH and HEIGHT.
- BUFFER's contents are made an image of the display generated by that program,
- and any input typed when BUFFER is the current Emacs buffer is sent to that
- program as keyboard input.
- Interactively, BUFFER defaults to \"*terminal*\" and PROGRAM and ARGS
- are parsed from an input-string using your usual shell.
- WIDTH and HEIGHT are determined from the size of the current window
- -- WIDTH will be one less than the window's width, HEIGHT will be its height.
- To switch buffers and leave the emulator, or to give commands
- to the emulator itself (as opposed to the program running under it),
- type Control-^. The following character is an emulator command.
- Type Control-^ twice to send it to the subprogram.
- This escape character may be changed using the variable `terminal-escape-char'.
- `Meta' characters may not currently be sent through the terminal emulator.
- Here is a list of some of the variables which control the behavior
- of the emulator -- see their documentation for more information:
- terminal-escape-char, terminal-scrolling, terminal-more-processing,
- terminal-redisplay-interval.
- This function calls the value of terminal-mode-hook if that exists
- and is non-nil after the terminal buffer has been set up and the
- subprocess started."
- (interactive
- (cons (with-current-buffer (get-buffer-create "*terminal*")
- (buffer-name (if (or (not (boundp 'te-process))
- (null te-process)
- (not (eq (process-status te-process)
- 'run)))
- (current-buffer)
- (generate-new-buffer "*terminal*"))))
- (append
- (let* ((default-s
-
- (or explicit-shell-file-name
- (getenv "ESHELL")
- (getenv "SHELL")
- "/bin/sh"))
- (s (read-string
- (format "Run program in emulator (default %s): "
- default-s))))
- (if (equal s "")
- (list default-s '())
- (te-parse-program-and-args s))))))
- (switch-to-buffer buffer)
- (if (null width) (setq width (- (window-width (selected-window)) 1)))
- (if (null height) (setq height (- (window-height (selected-window)) 1)))
- (terminal-mode)
- (setq te-width width te-height height)
- (setq te-terminal-name (concat te-terminal-name-prefix
- (number-to-string te-width)
- (number-to-string te-height)))
- (setq mode-line-buffer-identification
- (list (format "Emacs terminal %dx%d: %%b " te-width te-height)
- 'te-pending-output-info))
- (let ((buffer-read-only nil))
- (te-clear-screen))
- (let (process)
- (while (setq process (get-buffer-process (current-buffer)))
- (if (y-or-n-p (format "Kill process %s? " (process-name process)))
- (delete-process process)
- (error "Process %s not killed" (process-name process)))))
- (condition-case err
- (let ((process-environment
- (cons (concat "TERM=" te-terminal-name)
- (cons (concat "TERMCAP=" (te-create-termcap))
- (cons (concat "TERMINFO=" (te-create-terminfo))
- process-environment)))))
- (setq te-process
- (start-process "terminal-emulator" (current-buffer)
- "/bin/sh" "-c"
-
-
-
-
- (format "%s; exec %s"
- te-stty-string
- (mapconcat 'te-quote-arg-for-sh
- (cons program args) " "))))
- (set-process-filter te-process 'te-filter)
- (set-process-sentinel te-process 'te-sentinel))
- (error (fundamental-mode)
- (signal (car err) (cdr err))))
- (setq inhibit-quit t)
- (use-local-map terminal-map)
- (run-hooks 'terminal-mode-hook)
- (message "Entering Emacs terminal-emulator... Type %s %s for help"
- (single-key-description terminal-escape-char)
- (mapconcat 'single-key-description
- (where-is-internal 'te-escape-help terminal-escape-map t)
- " ")))
- (defun te-parse-program-and-args (s)
- (cond ((string-match "\\`\\([-a-zA-Z0-9+=_.@/:]+[ \t]*\\)+\\'" s)
- (let ((l ()) (p 0))
- (while p
- (setq l (cons (if (string-match
- "\\([-a-zA-Z0-9+=_.@/:]+\\)\\([ \t]+\\)*"
- s p)
- (prog1 (substring s p (match-end 1))
- (setq p (match-end 0))
- (if (eq p (length s)) (setq p nil)))
- (prog1 (substring s p)
- (setq p nil)))
- l)))
- (setq l (nreverse l))
- (list (car l) (cdr l))))
- ((and (string-match "[ \t]" s) (not (file-exists-p s)))
- (list shell-file-name (list "-c" (concat "exec " s))))
- (t (list s ()))))
- (put 'terminal-mode 'mode-class 'special)
- (defun terminal-mode ()
- "Set up variables for use with the terminal-emulator.
- One should not call this -- it is an internal function
- of the terminal-emulator"
- (kill-all-local-variables)
- (buffer-disable-undo (current-buffer))
- (setq major-mode 'terminal-mode)
- (setq mode-name "terminal")
- (setq mode-line-process '(":%s"))
- (setq buffer-read-only t)
- (setq truncate-lines t)
- (make-local-variable 'terminal-escape-char)
- (setq terminal-escape-char (default-value 'terminal-escape-char))
- (make-local-variable 'terminal-scrolling)
- (setq terminal-scrolling (default-value 'terminal-scrolling))
- (make-local-variable 'terminal-more-processing)
- (setq terminal-more-processing (default-value 'terminal-more-processing))
- (make-local-variable 'terminal-redisplay-interval)
- (setq terminal-redisplay-interval (default-value 'terminal-redisplay-interval))
- (make-local-variable 'te-width)
- (make-local-variable 'te-height)
- (make-local-variable 'te-process)
- (make-local-variable 'te-pending-output)
- (setq te-pending-output (list 0))
- (make-local-variable 'te-saved-point)
- (setq te-saved-point (point-min))
- (make-local-variable 'te-pending-output-info)
- (setq te-pending-output-info "")
- (make-local-variable 'inhibit-quit)
-
- (make-local-variable 'te-log-buffer)
- (setq te-log-buffer nil)
- (make-local-variable 'te-more-count)
- (setq te-more-count -1)
- (make-local-variable 'te-redisplay-count)
- (setq te-redisplay-count terminal-redisplay-interval)
-
-
- )
- (defun te-quote-arg-for-sh (string)
- (cond ((string-match "\\`[-a-zA-Z0-9+=_.@/:]+\\'"
- string)
- string)
- ((not (string-match "[$]" string))
-
- (prin1-to-string string))
- (t
- (let ((harder "")
- (start 0)
- (end 0))
- (while (cond ((>= start (length string))
- nil)
-
- ((setq end (string-match "[\"\\$]"
- string start))
- t)
- (t (setq harder (concat harder
- (substring string start)))
- nil))
- (setq harder (concat harder (substring string start end)
-
-
-
- "\\"
- (substring string
- end
- (1+ end)))
- start (1+ end)))
- (concat "\"" harder "\"")))))
- (defun te-create-terminfo ()
- "Create and compile a terminfo entry for the virtual terminal. This is kept
- in the directory specified by `te-terminfo-directory'."
- (when (and system-uses-terminfo
- (not (file-exists-p (concat te-terminfo-directory
- (substring te-terminal-name-prefix 0 1)
- "/" te-terminal-name))))
- (let ( (terminfo
- (concat
-
- (format "%s,\n\tmir, xon,cols#%d, lines#%d,"
- te-terminal-name te-width te-height)
- "bel=^P^G, clear=^P\\f, cr=^P^A, cub1=^P^B, cud1=^P\\n,"
- "cuf1=^P^F, cup=^P=%p1%'\\s'%+%c%p2%'\\s'%+%c,"
- "dch=^Pd%p1%'\\s'%+%c, dch1=^Pd!, dl=^P^K%p1%'\\s'%+%c,"
- "dl1=^P^K!, ed=^PC, el=^Pc, home=^P=\\s\\s,"
- "ich=^P_%p1%'\\s'%+%c, ich1=^P_!, il=^P^O%p1%'\\s'%+%c,"
-
- "il1=^P^O!, ind=^P\\n, nel=\\n,\n"))
-
- (file-name (concat te-terminfo-directory te-terminal-name ".tif")) )
- (make-directory te-terminfo-directory t)
- (let ((temp-file
- (make-temp-file (expand-file-name "tif" te-terminfo-directory))))
-
- (with-temp-file temp-file
- (insert terminfo))
-
-
-
-
- (rename-file temp-file file-name))
-
-
- (let ((process-environment
- (cons (concat "TERMINFO="
- (directory-file-name te-terminfo-directory))
- process-environment)))
- (set-process-sentinel (start-process "tic" nil "tic" file-name)
- 'te-tic-sentinel))))
- (directory-file-name te-terminfo-directory))
- (defun te-create-termcap ()
- "Create a termcap entry for the virtual terminal"
-
-
-
-
- (concat (format "%s:co#%d:li#%d:%s"
-
- te-terminal-name te-width te-height (if terminal-scrolling
- "" "ns:"))
-
-
- "cm=^p=%+ %+ :cr=^p^a:le=^p^b:nd=^p^f:"
-
- "nw=^j:ce=^pc:cd=^pC:cl=^p^l:bl=^p^g:"
-
- "IC=^p_%+ :DC=^pd%+ :AL=^p^o%+ :DL=^p^k%+ :"
-
-
-
-
-
- "LP:NF:"
-
- "ic=^p_!:dc=^pd!:al=^p^o!:dl=^p^k!:ho=^p= :"
-
-
- "im=:ei=:dm=:ed=:mi:do=^p^j:nl=^p^j:bs:")
- )
- (defun te-tic-sentinel (_proc state-change)
- "If tic has finished, delete the .tif file"
- (if (equal state-change "finished
- ")
- (delete-file (concat te-terminfo-directory te-terminal-name ".tif"))))
- (provide 'terminal)
|