Detect 'mpv -v' prompt
[emacs-coterm.git] / coterm.el
blobe68a21c05d2a90b936dc2d7fce35dcd04ea1cc42
1 ;;; coterm.el --- Terminal emulation for comint -*- lexical-binding: t; -*-
3 ;; Copyright (C) 2021 Free Software Foundation, Inc.
5 ;; Filename: coterm.el
6 ;; Author: jakanakaevangeli <jakanakaevangeli@chiru.no>
7 ;; Version: 1.6
8 ;; Keywords: processes
9 ;; Package-Requires: ((emacs "26.1") (compat "28.1.2.0"))
10 ;; URL: https://repo.or.cz/emacs-coterm.git
12 ;; This file is part of GNU Emacs.
14 ;; This program is free software: you can redistribute it and/or modify
15 ;; it under the terms of the GNU General Public License as published by
16 ;; the Free Software Foundation, either version 3 of the License, or
17 ;; (at your option) any later version.
19 ;; This program is distributed in the hope that it will be useful,
20 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
21 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
22 ;; GNU General Public License for more details.
24 ;; You should have received a copy of the GNU General Public License
25 ;; along with this program. If not, see <http://www.gnu.org/licenses/>.
27 ;;; Commentary:
29 ;; If the global `coterm-mode' is enabled, proper terminal emulation will be
30 ;; supported for all newly spawned comint processes. This allows you to use
31 ;; more complex console programs such as "less" and "mpv" and full-screen TUI
32 ;; programs such as "vi", "top", "htop" or even "emacs -nw".
34 ;; In addition to that, the following two local minor modes may be used:
36 ;; `coterm-char-mode': if enabled, most characters you type are sent directly
37 ;; to the subprocess, which is useful for interacting with full-screen TUI
38 ;; programs.
40 ;; `coterm-auto-char-mode': if enabled, coterm will enter and leave
41 ;; `coterm-char-mode' automatically as appropriate. For example, if you
42 ;; execute "less" in a shell buffer, coterm will detect that "less" is running
43 ;; and automatically enable char mode so that you can interact with "less"
44 ;; directly. Once you leave the "less" program, coterm will disable char mode
45 ;; so that you can interact with your shell in the normal comint way. This
46 ;; mode is enabled by default in all coterm comint buffers.
48 ;; Automatic entrance into char mode is indicated by "AChar" in the modeline.
49 ;; Non-automatic entrance into char mode is indicated by "Char".
50 ;; Automatic exit of char mode is indicated by no text in the modeline.
51 ;; Non-automatic exit of char mode is indicated by "Line".
53 ;; The command `coterm-char-mode-cycle' is a handy command to cycle between
54 ;; automatic char-mode, char-mode enabled and char-mode disabled.
57 ;;;; Installation:
59 ;; To install coterm, type M-x package-install RET coterm RET
61 ;; It is best to add the following elisp snippet to your Emacs init file, to
62 ;; enable `coterm-mode' automatically on startup:
64 ;; (coterm-mode)
66 ;; ;; Optional: bind `coterm-char-mode-cycle' to C-; in comint
67 ;; (with-eval-after-load 'comint
68 ;; (define-key comint-mode-map (kbd "C-;") #'coterm-char-mode-cycle))
70 ;; ;; If your process repeats what you have already typed, try customizing
71 ;; ;; `comint-process-echoes':
72 ;; ;; (setq-default comint-process-echoes t)
75 ;;;; Differences from M-x term:
77 ;; coterm is written as an upgrade to comint. For existing comint users, the
78 ;; behaviour of comint doesn't change with coterm enabled except for the added
79 ;; functionality that we can now use TUI programs. It is therefore good for
80 ;; users who generally prefer comint to term.el but sometimes miss the superior
81 ;; terminal emulation that term.el provides.
83 ;; Coterm also provides `coterm-auto-char-mode' which aims to eliminate the
84 ;; need to manually enable and disable char mode.
87 ;;;; Some common probles:
89 ;; If some TUI programs misbehave, try checking your TERM environment variable
90 ;; with 'echo $TERM' in your coterm enabled M-x shell. It should normally be
91 ;; set to "eterm-color". If if isn't, it might be that one of your shell
92 ;; initialization files (~/.bashrc) changes it, so check for that and remove
93 ;; the change.
95 ;; The default "less" prompt, when invoked as 'less ~/some/file', is too
96 ;; generic and isn't recognized by `coterm-auto-char-mode', so char mode isn't
97 ;; entered automatically. It is recommended to make your "less" prompt more
98 ;; complete and recognizable by adding the character "m" or "M" to your LESS
99 ;; environment variable. For example, in your ~/.bashrc, add this line:
101 ;; export LESS="FRXim"
103 ;; The "FRX" options make "less" more compatible with "git", and the "i" option
104 ;; enables case insensitive search in less. See man page less(1) for more
105 ;; information. Automatic char mode detection also usually fails if
106 ;; "--incsearch" is enabled in "less". It is advised to either turn this
107 ;; option off or to use manual char mode.
110 ;;;; Bugs, suggestions and patches can be sent to
112 ;; bugs-doseganje (at) groups.io
114 ;; and can be viewed at https://groups.io/g/bugs-doseganje/topics. As this
115 ;; package is stored in GNU ELPA, non-trivial patches require copyright
116 ;; assignment to the FSF, see info node "(emacs) Copyright Assignment".
118 ;; Some useful information you can send in your bug reports:
120 ;; After enabling `coterm-mode', open up an M-x shell and copy the output of
121 ;; the following shell command:
123 ;; export | cat -v | grep 'LESS\|TERM'; stty;
125 ;; You can also set the variable `coterm--t-log-buffer' to "coterm-log",
126 ;; reproduce the issue and attach the contents of the buffer named
127 ;; "coterm-log", which now contains all process output that was sent to coterm.
129 ;;; Code:
131 (require 'term)
132 (require 'compat)
133 (eval-when-compile
134 (require 'cl-lib)
135 (require 'subr-x))
137 ;;; Mode functions and configuration
139 (defcustom coterm-term-name term-term-name
140 "Name to use for TERM.
141 coterm will use this option to set the TERM environment variable
142 for the subprocess. TUI programs usually consult this
143 environment variable to decide which escape sequences it should
144 send to the terminal. It is recommended to leave this set to
145 \"eterm-color\", the terminal type coterm emulates."
146 :group 'comint
147 :type 'string)
149 (defvar coterm-termcap-format term-termcap-format
150 "Termcap capabilities supported by coterm.")
152 (defvar coterm-term-environment-function #'comint-term-environment
153 "Function to calculate environment for comint processes.
154 If non-nil, it is called with zero arguments and should return a
155 list of environment variable settings to apply to comint
156 subprocesses.")
158 (defvar coterm-start-process-function #'start-file-process
159 "Function called to start a comint process.
160 It is called with the same arguments as `start-process' and
161 should return a process.")
163 (define-advice comint-exec-1 (:around (f &rest args) coterm-config)
164 "Make spawning processes for comint more configurable.
165 With this advice installed on `coterm-exec-1', you use the
166 settings `coterm-extra-environment-function' and
167 `coterm-start-process-function' to control how comint spawns a
168 process."
169 (cl-letf*
170 ((start-file-process (symbol-function #'start-file-process))
171 (comint-term-environment (symbol-function #'comint-term-environment))
172 ((symbol-function #'start-file-process)
173 (lambda (&rest args)
174 (fset #'start-file-process start-file-process)
175 (apply coterm-start-process-function args)))
176 ((symbol-function #'comint-term-environment)
177 (lambda (&rest args)
178 (fset #'comint-term-environment comint-term-environment)
179 (apply coterm-term-environment-function args))))
180 (apply f args)))
182 ;;;###autoload
183 (define-minor-mode coterm-mode
184 "Improved terminal emulation in comint processes.
185 When this mode is enabled, terminal emulation is enabled for all
186 newly spawned comint processes, allowing you to use more complex
187 console programs such as \"less\" and \"mpv\" and full-screen
188 programs such as \"vi\", \"top\", \"htop\" or even \"emacs -nw\".
190 Environment variables for comint processes are set according to
191 variables `coterm-term-name' and `coterm-termcap-format'."
192 :global t
193 :group 'comint
194 (if coterm-mode
196 (progn
197 (add-hook 'comint-mode-hook #'coterm--init)
198 (setq coterm-term-environment-function
199 (lambda ()
200 (let (ret)
201 (push (format "TERMINFO=%s" data-directory)
202 ret)
203 (when coterm-term-name
204 (push (format "TERM=%s" coterm-term-name) ret))
205 (when coterm-termcap-format
206 (push (format coterm-termcap-format "TERMCAP="
207 coterm-term-name
208 (floor (window-screen-lines))
209 (window-max-chars-per-line))
210 ret))
211 ret)))
212 (setq coterm-start-process-function
213 (lambda (name buffer command &rest switches)
214 (apply #'start-file-process name buffer
215 ;; Adapted from `term-exec-1'
216 "sh" "-c"
217 (format "stty -nl sane -echo 2>%s;\
218 if [ $1 = .. ]; then shift; fi; exec \"$@\"" null-device)
219 ".." command switches))))
221 (remove-hook 'comint-mode-hook #'coterm--init)
222 (setq coterm-term-environment-function #'comint-term-environment)
223 (setq coterm-start-process-function #'start-file-process)))
225 ;;; Char mode
227 (defvar coterm-char-mode-map
228 (let ((map (make-sparse-keymap)))
229 (set-keymap-parent map term-raw-map)
230 (define-key map [remap term-char-mode] #'coterm-char-mode-cycle)
231 (define-key map [remap term-line-mode] #'coterm-char-mode-cycle)
232 map))
234 (define-minor-mode coterm-char-mode
235 "Send characters you type directly to the inferior process.
236 When this mode is enabled, the keymap `coterm-char-mode-map' is
237 active, which inherits from `term-raw-map'. In this map, each
238 character is sent to the process, except for the escape
239 character (usually C-c). You can set `term-escape-char' to
240 customize it."
241 :lighter "")
243 (defvar-local coterm--char-old-scroll-margin nil)
245 (define-minor-mode coterm-scroll-snap-mode
246 "Keep scroll synchronized.
247 Useful for full-screen terminal programs to keep them on screen."
248 :keymap nil
249 (if coterm-scroll-snap-mode
250 (progn
251 (unless coterm--char-old-scroll-margin
252 (setq coterm--char-old-scroll-margin
253 (cons scroll-margin
254 (local-variable-p 'scroll-margin)))
255 (setq-local scroll-margin 0))
256 (add-hook 'coterm-t-after-insert-hook #'coterm--scroll-snap 'append t)
257 (coterm--scroll-snap))
258 (when-let ((margin coterm--char-old-scroll-margin))
259 (setq coterm--char-old-scroll-margin nil)
260 (if (cdr margin)
261 (setq scroll-margin (car margin))
262 (kill-local-variable 'scroll-margin)))
263 (remove-hook 'coterm-t-after-insert-hook #'coterm--scroll-snap t)))
265 (defvar coterm--t-home)
266 (defvar coterm--t-home-off)
268 (defun coterm--scroll-snap ()
269 ;; We need to check for `coterm-scroll-snap-mode' because a function in
270 ;; `coterm-t-after-insert-hook' might have changed it
271 (when coterm-scroll-snap-mode
272 (let* ((buf (current-buffer))
273 (pmark (process-mark (get-buffer-process buf)))
274 (sel-win (selected-window))
275 (w sel-win))
276 ;; Avoid infinite loop in strange case where minibuffer window
277 ;; is selected but not active.
278 (while (window-minibuffer-p w)
279 (setq w (next-window w nil t)))
280 (while
281 (progn
282 (when (and (eq buf (window-buffer w))
283 ;; Only snap if point is on pmark
284 (= (window-point w) pmark))
285 (if (eq sel-win w)
286 (progn
287 (goto-char coterm--t-home)
288 (forward-line coterm--t-home-off)
289 (forward-line 0)
290 (recenter 0)
291 (goto-char pmark))
292 (with-selected-window w
293 (goto-char coterm--t-home)
294 (forward-line coterm--t-home-off)
295 (forward-line 0)
296 (recenter 0)
297 (goto-char pmark))))
298 (setq w (next-window w nil t))
299 (not (eq w sel-win)))))))
301 (defvar coterm-auto-char-mode)
303 (defun coterm-char-mode-cycle ()
304 "Cycle between char mode on, off and auto.
306 If `coterm-auto-char-mode' is enabled, disable it and enable
307 both `coterm-char-mode' and `coterm-scroll-snap-mode'.
309 If `coterm-char-mode' is enabled, disable it along with
310 `coterm-scroll-snap-mode'.
312 If it is disabled, enable `coterm-auto-char-mode'."
313 (interactive)
314 (cond
315 (coterm-auto-char-mode
316 (coterm-auto-char-mode -1)
317 (coterm-char-mode 1)
318 (coterm-scroll-snap-mode 1))
319 (coterm-char-mode
320 (coterm-char-mode -1)
321 (coterm-scroll-snap-mode -1))
322 (t (coterm-auto-char-mode 1))))
324 ;;;; Automatic entry to char mode
326 (define-minor-mode coterm-auto-char-mode
327 "Whether we should enter or leave char mode automatically.
328 If enabled, `coterm-auto-char-functions' are consulted to set
329 `coterm-char-mode' and `coterm-scroll-snap-mode' automatically.
331 By default, functions in `coterm-auto-char-functions' try to
332 guess which mode is appropriate based on various heuristics. See
333 their doc strings for more information."
334 :lighter ""
335 (if coterm-auto-char-mode
336 (progn
337 (add-hook 'coterm-t-after-insert-hook #'coterm--auto-char nil t)
338 (add-hook 'post-command-hook #'coterm--auto-char nil t)
339 (coterm--auto-char))
340 (remove-hook 'coterm-t-after-insert-hook #'coterm--auto-char t)
341 (remove-hook 'post-command-hook #'coterm--auto-char t)))
343 (defvar coterm-auto-char-lighter-mode-format
344 '(coterm-char-mode (coterm-auto-char-mode " AChar" " Char")
345 (coterm-auto-char-mode "" " Line")))
347 (define-minor-mode coterm-auto-char-lighter-mode
348 "Show current char mode status in modeline."
349 :lighter coterm-auto-char-lighter-mode-format)
351 (defvar coterm-auto-char-functions
352 (list #'coterm--auto-char-alternative-sub-buffer
353 #'coterm--auto-char-less-prompt
354 #'coterm--auto-char-mpv-prompt
355 #'coterm--auto-char-not-eob
356 #'coterm--auto-char-leave-both)
357 "Abnormal hook to enter or leave `coterm-char-mode'.
358 This hook is run after every command and process output, if
359 `coterm-auto-char-mode' enabled. It is only called if point is
360 on process's mark.
362 Each function is called with zero argumets and with `point-max'
363 on the end of process output until one returns non-nil.")
365 (defun coterm--auto-char ()
366 "Automatically enter or leave `coterm-char-mode'.
367 If point is not on process mark, leave `coterm-char-mode' and
368 `coterm-scroll-snap-mode'. Otherwise, call functions from
369 `coterm-auto-char-functions' until one returns non-nil."
370 (let* ((proc (get-buffer-process (current-buffer)))
371 (pmark (and proc (process-mark proc))))
372 (if (and pmark (= (point) pmark))
373 (save-restriction
374 (coterm--narrow-to-process-output pmark)
375 (run-hook-with-args-until-success 'coterm-auto-char-functions))
376 (when coterm-char-mode (coterm-char-mode -1))
377 (when coterm-scroll-snap-mode (coterm-scroll-snap-mode -1)))))
379 (defvar coterm--t-alternative-sub-buffer)
381 (defun coterm--auto-char-alternative-sub-buffer ()
382 "Enter `coterm-char-mode' if using an alternative sub-buffer."
383 (when coterm--t-alternative-sub-buffer
384 (unless coterm-char-mode (coterm-char-mode 1))
385 (unless coterm-scroll-snap-mode (coterm-scroll-snap-mode 1))
388 (defun coterm--auto-char-less-prompt ()
389 "Enter `coterm-char-mode' if a \"less\" prompt is detected.
390 In addition, temporarily modify `coterm-auto-char-functions' such
391 that char mode is maintained even if the user presses \"/\",
392 \":\", \"ESC\", \"-\" or a digit."
393 (when (and (eobp) (coterm--auto-char-less-prompt-1))
394 (unless coterm-char-mode (coterm-char-mode 1))
395 (unless coterm-scroll-snap-mode (coterm-scroll-snap-mode 1))
396 (cl-labels
397 ((hook ()
398 (if (not (eobp))
399 (rem-hook)
401 (bolp) ; Empty last line if "less" is slow
402 (coterm--auto-char-less-prompt-1)
403 (progn
404 (forward-line 0)
405 ;; Various secondary prompts that "less" outputs
406 (prog1 (looking-at (concat
407 "\\(?: ESC\\| :\\)\\'\\|"
408 "Examine: \\|"
409 "[Ll]og file: \\|"
410 "Target line: \\|"
411 "Backwards scroll limit: \\|"
412 "\\(?:set \\|goto \\||\\)mark: \\|"
413 "[:_+!-]\\|"
414 "\\(?:.* \\)?[/?]"))
415 (goto-char (point-max))))
416 (rem-hook))))
417 (rem-hook ()
418 (remove-hook 'coterm-auto-char-functions #'hook t)
419 (remove-hook 'coterm-auto-char-mode-hook #'rem-hook t)
420 (remove-hook 'coterm-char-mode-hook #'rem-hook t)
421 (remove-hook 'coterm-scroll-snap-mode-hook #'rem-hook t)
422 nil))
423 (add-hook 'coterm-auto-char-functions #'hook nil t)
424 (add-hook 'coterm-auto-char-mode-hook #'rem-hook nil t)
425 (add-hook 'coterm-char-mode-hook #'rem-hook nil t)
426 (add-hook 'coterm-scroll-snap-mode-hook #'rem-hook nil t))
429 (defun coterm--auto-char-less-prompt-1 ()
430 "Return t if point is after a less prompt."
431 (let ((opoint (point)))
432 (forward-line 0)
433 (prog1 (looking-at
434 (concat
435 "\\(?:"
436 ":\\|"
437 "\\(?:.* \\)?" "(END)\\|"
438 "byte [0-9]+\\|"
439 "lines [0-9]+-[0-9]+\\|"
440 "100%\\|"
441 "\\(?:.* \\)?" "\\(:?[0-9]?[0-9]\\|100\\)" "%\\|"
442 ".*(press h for help or q to quit)\\|"
443 ".*(press RETURN)"
444 "\\)\\'"))
445 (goto-char opoint))))
447 (defun coterm--auto-char-mpv-prompt ()
448 "Enter `coterm-char-mode' if a mpv prompt is detected.
449 However, simply entering it isn't satisfactory, because mpv often
450 erases its status prompt for brief periods of time before
451 redrawing it again. Because we don't want to leave char mode for
452 these brief periods, we temporarily modify
453 `coterm-auto-char-functions' such that `coterm-char-mode' is kept
454 active if these status prompt erasures are detected."
455 (when (coterm--auto-char-mpv-prompt-1)
456 (coterm-char-mode 1)
457 (cl-labels
458 ((hook ()
459 (or (coterm--auto-char-mpv-prompt-1)
460 ;; If we are on the last lane and this line is empty, it is
461 ;; likely because mpv has erased its status buffer for a brief
462 ;; period before redrawing it.
463 (and (eobp) (bolp))
464 (ignore (rem-hook))))
465 (rem-hook ()
466 (remove-hook 'coterm-auto-char-functions #'hook t)
467 (remove-hook 'coterm-auto-char-mode-hook #'rem-hook t)
468 (remove-hook 'coterm-char-mode-hook #'rem-hook t)
469 (remove-hook 'coterm-scroll-snap-mode-hook #'rem-hook t)))
470 (add-hook 'coterm-auto-char-functions #'hook nil t)
471 (add-hook 'coterm-auto-char-mode-hook #'rem-hook nil t)
472 (add-hook 'coterm-char-mode-hook #'rem-hook nil t)
473 (add-hook 'coterm-scroll-snap-mode-hook #'rem-hook nil t))
476 (defun coterm--auto-char-mpv-prompt-1 ()
477 "Return t if mpv is likely running."
478 (when (bolp)
479 (let ((opoint (point)))
480 (forward-line -1)
481 (prog1 (looking-at
482 (concat "\\(?:.*\n\\)?"
483 (regexp-opt '("[statusline] " "")) ; mpv -v
484 (regexp-opt '("(Paused) " "(Buffering) " "(...) " ""))
485 "\\(?:[AV]\\|AV\\): "
486 "-?[0-9][0-9]:[0-9][0-9]:[0-9][0-9] / "
487 "-?[0-9][0-9]:[0-9][0-9]:[0-9][0-9] "
488 "([0-9]?[0-9]?[0-9]%).*"
489 "\\(?:"
490 "\n\\[-*\\+-*\\]"
491 "\\)?"
492 "\\'"))
493 (goto-char opoint)))))
495 (defun coterm--auto-char-not-eob ()
496 "Enter `coterm-char-mode' if a full-screen TUI program is detected.
497 We assume that if the cursor moves more than 9 lines above the
498 bottom row, a full-screen program is likely being drawn. In this
499 case, enter `coterm-char-mode' and `coterm-scroll-snap-mode' and
500 temporarily modify `coterm-auto-char-functions' such that we will
501 only leave these modes once cursor moves to the bottom line."
502 (when (looking-at "\\(?:.*\n\\)\\{9,\\}")
503 (coterm-char-mode 1)
504 (coterm-scroll-snap-mode 1)
505 (cl-labels
506 ((hook ()
507 (or (looking-at ".*\n.")
508 (ignore (rem-hook))))
509 (rem-hook ()
510 (remove-hook 'coterm-auto-char-functions #'hook t)
511 (remove-hook 'coterm-auto-char-mode-hook #'rem-hook t)
512 (remove-hook 'coterm-char-mode-hook #'rem-hook t)
513 (remove-hook 'coterm-scroll-snap-mode-hook #'rem-hook t)))
514 (add-hook 'coterm-auto-char-functions #'hook nil t)
515 (add-hook 'coterm-auto-char-mode-hook #'rem-hook nil t)
516 (add-hook 'coterm-char-mode-hook #'rem-hook nil t)
517 (add-hook 'coterm-scroll-snap-mode-hook #'rem-hook nil t))
520 (defun coterm--auto-char-leave-both ()
521 (when coterm-char-mode (coterm-char-mode -1))
522 (when coterm-scroll-snap-mode (coterm-scroll-snap-mode -1))
525 (defun coterm--narrow-to-process-output (pmark)
526 "Widen and narrow to process output.
527 If there is no user input at end of buffer, simply widen. PMARK
528 is the process mark."
529 (widen)
530 (unless comint-use-prompt-regexp
531 (unless (eq (get-char-property (max 1 (1- (point-max))) 'field)
532 'output)
533 (narrow-to-region
534 (point-min)
535 (previous-single-property-change (point-max) 'field nil pmark)))))
537 ;;; Terminal emulation
539 ;; This is essentially a re-implementation of term.el's terminal emulation. I
540 ;; could have simply reused functions from term.el but that would have been
541 ;; unsatisfactory in my opinion. That is mostly due to the fact that term.el's
542 ;; terminal emulation inserts a lot of redundant trailing whitespace and empty
543 ;; lines, which I believe is very distracting for ordinary comint usage.
545 ;; Terminal emulation is coordinate based, for example, "move cursor to row 11
546 ;; and column 21". A coordinate position may not be reachable in an Emacs
547 ;; buffer because the specified line is currently too short or there aren't
548 ;; enough lines in the buffer. term.el automatically inserts empty lines and
549 ;; spaces in order to move point to a specified coordinate position, which
550 ;; often results in trailing whitespace.
552 ;; coterm takes a different approach. Rather than insert whitespace, we move
553 ;; point close to the target terminal cursor coordinates and save the offset in
554 ;; the variables `coterm--t-row-off' and `coterm--t-col-off'. Only when
555 ;; terminal emulation requires insertion of actual text do we have to be able
556 ;; to reach the current cursor coordinates. We may have to insert newlines and
557 ;; spaces to make this position reachable, but inserting text after this
558 ;; whitespace means that it isn't trailing or redundant (except if the inserted
559 ;; text consists of only whitespace).
562 ;; Line wrapping:
564 ;; term.el wraps lines correctly and accurately. When text is to be inserted
565 ;; at the right edge, term.el will first move the cursor to the beginning of
566 ;; the next line.
568 ;; The beauty of comint, on the other hand, is that it inserts long lines
569 ;; unchanged and leaves line wrapping up to Emacs. One can easily use
570 ;; `toggle-truncate-lines' or even `word-wrap' to change display of long lines
571 ;; from compiler output for example. That is why it was decided that coterm
572 ;; will follow suit and insert long lines unchanged. However, this means that
573 ;; terminal emulation isn't fully accurate for long lines. Up to now, "less"
574 ;; was the only program I've encountered that relies on accurate line wrapping,
575 ;; so a workaround aimed at "less" specifically was implemented (search for the
576 ;; term "less" in the function `coterm--t-emulate-terminal').
578 (defconst coterm--t-control-seq-regexp
579 ;; Differences from `term-control-seq-regexp':
581 ;; For optimization, we try matching "\r\n" as whole, if possible, instead of
582 ;; \r and \n separately
584 ;; Removed: \032 (\C-z)
585 ;; Added: OSC sequence \e] ... ; ... \e\\ (or \a)
586 ;; Added: sequences \e= and \e>
587 ;; Added: Invalid sequence \e\e, used by package `bash-completion'
588 (concat
589 ;; A control character,
590 "\\(?:[\n\000\007\t\b\016\017]\\|\r\n?\\|"
591 ;; a C1 escape coded character (see [ECMA-48] section 5.3 "Elements
592 ;; of the C1 set"),
593 "\e\\(?:[DM78c=>\e]\\|"
594 ;; Emacs specific control sequence from term.el. In coterm, we simply
595 ;; ignore them.
596 "AnSiT[^\n]+\n\\|"
597 ;; OSC seqence. We print them normally to let
598 ;; `comint-output-filter-functions' handle them
599 "][0-9A-Za-z]*;.*?\\(?:\a\\|\e\\\\\\)\\|"
600 ;; or an escape sequence (section 5.4 "Control Sequences"),
601 "\\[\\([\x30-\x3F]*\\)[\x20-\x2F]*[\x40-\x7E]\\)\\)")
602 "Regexp matching control sequences handled by coterm.")
604 (defconst coterm--t-control-seq-prefix-regexp "\e")
606 (defvar coterm--t-log-buffer nil
607 "If non-nil, log process output to this buffer.
608 Set it to a name of a buffer if you want to record process output
609 for debugging purposes.")
611 (defvar-local coterm--t-height nil
612 "Number of lines in window.")
613 (defvar-local coterm--t-width nil
614 "Number of columns in window.")
615 (defvar-local coterm--t-scroll-beg nil
616 "First row of the scrolling area.")
617 (defvar-local coterm--t-scroll-end nil
618 "First row after the end of the scrolling area.")
620 (defvar-local coterm--t-home nil
621 "Marks the \"home\" position for cursor addressing.
622 `coterm--t-home-off' should be taken into account as well.")
623 (defvar-local coterm--t-home-off 0
624 "How many rows lower the home position actually is.
625 This usually is needed if `coterm--t-home' is on the last line of
626 the buffer.")
627 (defvar-local coterm--t-row-off 0
628 "How many rows lower the current position actually is.
629 May be non-zero if point on the last line of accessible portion
630 of the buffer. More precisely, this variable can only be
631 non-zero if there are no \\n characters after point.")
632 (defvar-local coterm--t-col-off 0
633 "How many cols to the right the current position actually is.
634 Non-zero only if point is on the end of line or on a character
635 that spans more than one columen. In the latter case, this
636 variable's value can be negative.")
638 (defvar-local coterm--t-row nil
639 "Cache of current terminal row if non-nil.")
640 (defvar-local coterm--t-col nil
641 "Cache of current terminal column if non-nil.")
643 (defun coterm--t-row ()
644 "Return terminal's current row.
645 Use the variable `coterm--t-row' as the cache if non-nil. Set it
646 to nil to invalidate the cache."
647 (or coterm--t-row
648 (setq coterm--t-row
649 (- (+ (save-restriction
650 (save-excursion
651 (narrow-to-region coterm--t-home (point-max))
652 (+ (forward-line -9999) 9999)))
653 coterm--t-row-off)
654 coterm--t-home-off))))
656 (defun coterm--t-col ()
657 "`current-column' with cache.
658 The variable `coterm--t-col' holds the cache if
659 non-nil. Set it to nil to invalidate the cache."
660 (or coterm--t-col
661 (setq coterm--t-col (+ (current-column) coterm--t-col-off))))
663 (defvar-local coterm--t-alternative-sub-buffer nil
664 "Non-nil if using an alternative sub-buffer (termcap smcup).")
666 (defvar-local coterm--t-saved-cursor nil)
667 (defvar-local coterm--t-insert-mode nil)
668 (defvar-local coterm--t-unhandled-fragment nil)
670 (defvar coterm-t-after-insert-hook nil
671 "Hook run after inserting process output.")
673 (defun coterm--init ()
674 "Initialize current buffer for coterm."
675 (when-let ((process (get-buffer-process (current-buffer))))
676 (setq coterm--t-height (floor (window-screen-lines)))
677 (setq coterm--t-width (window-max-chars-per-line))
678 (setq coterm--t-home (point-min-marker))
679 (setq coterm--t-scroll-beg 0)
680 (setq coterm--t-scroll-end coterm--t-height)
682 (setq-local comint-inhibit-carriage-motion t)
683 (coterm-auto-char-mode)
684 (coterm-auto-char-lighter-mode)
686 (add-function :filter-return
687 (local 'window-adjust-process-window-size-function)
688 (lambda (size)
689 (when size
690 (coterm--t-reset-size (cdr size) (car size)))
691 size)
692 '((name . coterm-maybe-reset-size)))
694 (add-function :around (process-filter process)
695 #'coterm--t-emulate-terminal)))
697 (defun coterm--t-reset-size (height width)
698 (let ((shrunk (< height coterm--t-height)))
699 (setq coterm--t-height height)
700 (setq coterm--t-width width)
701 (setq coterm--t-scroll-beg 0)
702 (setq coterm--t-scroll-end height)
703 (when-let ((shrunk)
704 (proc (get-buffer-process (current-buffer)))
705 (pmark (process-mark proc)))
706 (save-excursion
707 (save-restriction
708 (coterm--narrow-to-process-output pmark)
709 (goto-char pmark)
710 (setq coterm--t-row nil)
711 (when (>= (coterm--t-row) height)
712 (cond
713 (coterm--t-alternative-sub-buffer
714 (goto-char coterm--t-home)
715 (forward-line (- coterm--t-row height -1))
716 (delete-region coterm--t-home (point)))
718 (cl-incf coterm--t-home-off (- coterm--t-row coterm--t-height -1))
719 (setq coterm--t-row (1- coterm--t-height))))))))))
721 (defun coterm--t-goto (row col)
722 "Move point to a position that approximates ROW and COL.
723 Set `coterm--t-row-off' and `coterm--t-col-off' accordingly."
724 (goto-char coterm--t-home)
725 (setq coterm--t-row-off
726 (+ (forward-line (+ coterm--t-home-off row))
727 (if (bolp) 0 1)))
728 (setq coterm--t-row row)
729 (setq coterm--t-col-off
730 (- col (move-to-column (setq coterm--t-col col)))))
732 (defun coterm--t-apply-proc-filt (proc-filt process str)
733 "Insert STR at point using PROC-FILT and PROCESS.
734 Basically, call PROC-FILT with the arguments PROCESS and STR, but
735 adjusting `ansi-color-context-region' and setting PROCESS' mark
736 to point beforehand.
738 If STR contains newlines, the caller must take care that
739 `coterm--t-row' is adjusted accordingly."
740 (when-let ((context ansi-color-context-region)
741 (marker (cadr context)))
742 (set-marker marker (point)))
743 (let ((pmark (process-mark process)))
744 (set-marker pmark (point))
745 (funcall proc-filt process str)
746 ;; Needed for emacs version < 27 with buggy functions in
747 ;; `comint-output-filter-functions' which upredictably move point
748 (goto-char pmark))
749 (unless (string-empty-p str)
750 (setq coterm--t-col nil)))
752 (defun coterm--t-switch-to-alternate-sub-buffer (proc-filt process set)
753 (cond
754 ((and set (null coterm--t-alternative-sub-buffer))
755 (setq coterm--t-alternative-sub-buffer
756 (list coterm--t-home
757 coterm--t-home-off
758 (coterm--t-row)
759 (coterm--t-col)))
760 (setq coterm--t-home-off 0)
761 (setq coterm--t-row-off 0)
762 (setq coterm--t-col-off 0)
763 (setq coterm--t-row 0)
764 (setq coterm--t-col 0)
765 (goto-char (point-max))
766 (unless (bolp)
767 (coterm--t-apply-proc-filt proc-filt process "\n"))
768 (setq coterm--t-home (point-marker)))
770 ((and (not set) coterm--t-alternative-sub-buffer)
771 (delete-region coterm--t-home (point-max))
772 (set-marker coterm--t-home (car coterm--t-alternative-sub-buffer))
773 (set-marker (car coterm--t-alternative-sub-buffer) nil)
774 (setq coterm--t-home-off (nth 1 coterm--t-alternative-sub-buffer))
775 (coterm--t-goto (nth 2 coterm--t-alternative-sub-buffer)
776 (nth 3 coterm--t-alternative-sub-buffer))
777 (setq coterm--t-alternative-sub-buffer nil)
779 (when (>= (coterm--t-row) coterm--t-height)
780 (let ((opoint (point)))
782 (setq coterm--t-home-off
783 (forward-line (+ 1 (- coterm--t-height) coterm--t-row-off)))
784 (unless (eolp)
785 (cl-incf coterm--t-home-off)
786 (forward-line 0))
787 (set-marker coterm--t-home (point))
788 (setq coterm--t-row (1- coterm--t-height))
789 (goto-char opoint)))
791 (cl-labels
792 ((hook ()
793 (remove-hook 'coterm-t-after-insert-hook #'hook t)
794 (unless coterm--t-alternative-sub-buffer
795 (let ((coterm-scroll-snap-mode t))
796 (coterm--scroll-snap)))))
797 (add-hook 'coterm-t-after-insert-hook #'hook nil t)))))
799 (defun coterm--t-down-line (proc-filt process)
800 "Go down one line or scroll if at bottom.
801 This takes into account the scroll region as specified by
802 `coterm--t-scroll-beg' and `coterm--t-scroll-end'. If required,
803 PROC-FILT and PROCESS are used to scroll with deletion and
804 insertion of empty lines."
805 (let ((orow (coterm--t-row))
806 (ocol (coterm--t-col)))
807 (cond
808 ((= orow (1- coterm--t-scroll-end))
809 (let ((moved (and (zerop (forward-line)) (bolp))))
810 ;; Remove top line or move home marker
811 (save-excursion
812 (goto-char coterm--t-home)
813 (cond ((or coterm--t-alternative-sub-buffer
814 (not (zerop coterm--t-scroll-beg)))
815 ;; Remove top line
816 (and (zerop (forward-line
817 (+ coterm--t-home-off coterm--t-scroll-beg)))
818 (bolp)
819 (delete-region (point) (progn (forward-line) (point)))))
821 ;; Move home marker
822 (if (and (zerop (forward-line)) (bolp))
823 (set-marker coterm--t-home (point))
824 (cl-incf coterm--t-home-off)))))
825 ;; Insert an empty line at the bottom
826 (cond (moved
827 (unless (eobp)
828 (let ((opoint (point)))
829 (coterm--t-apply-proc-filt proc-filt process "\n")
830 (goto-char opoint)))
831 (setq coterm--t-col-off ocol))
833 (cl-incf coterm--t-row-off)
834 (setq coterm--t-col-off (- ocol (move-to-column ocol)))))))
835 ((= orow (1- coterm--t-height))
836 ;; Do nothing, behaviour of xterm
837 (ignore))
839 ;; Move point vertically down
840 (unless (and (zerop (forward-line)) (bolp))
841 (cl-incf coterm--t-row-off))
842 (cl-incf coterm--t-row)
843 (setq coterm--t-col-off (- ocol (move-to-column ocol)))))))
845 (defun coterm--t-up-line (proc-filt process)
846 "Go up one line or scroll if at top.
847 This takes into account the scroll region as specified by
848 `coterm--t-scroll-beg' and `coterm--t-scroll-end'. If required,
849 PROC-FILT and PROCESS are used to scroll with deletion and
850 insertion of empty lines."
851 (let ((orow (coterm--t-row))
852 (ocol (coterm--t-col)))
853 (cond
854 ((= orow coterm--t-scroll-beg)
855 ;; Remove bottom line
856 (save-excursion
857 (goto-char coterm--t-home)
858 (and (zerop (forward-line
859 (+ coterm--t-home-off coterm--t-scroll-end -1)))
860 (bolp)
861 (delete-region (point) (progn (forward-line) (point)))))
862 ;; Insert an empty line at the top or move home marker
863 (cond ((and (not coterm--t-alternative-sub-buffer)
864 (zerop coterm--t-scroll-beg))
865 ;; Move home marker
866 (forward-line -1)
867 (set-marker coterm--t-home (point))
868 (setq coterm--t-home-off 0)
869 (setq coterm--t-row 0)
870 (setq coterm--t-col-off (- ocol (move-to-column ocol))))
871 ((not (zerop coterm--t-row-off))
872 (ignore))
874 ;; Insert an empty line at the top
875 (forward-line 0)
876 (let ((opoint (point)))
877 (coterm--t-apply-proc-filt proc-filt process "\n")
878 (goto-char opoint))
879 (setq coterm--t-col-off ocol))))
881 ((= orow 0)
882 ;; Behaviour of xterm
883 (ignore))
885 ((zerop coterm--t-row-off)
886 ;; Move point vetically up
887 (forward-line -1)
888 (cl-decf coterm--t-row)
889 (setq coterm--t-col-off (- ocol (move-to-column ocol))))
891 (cl-decf coterm--t-row)
892 (cl-decf coterm--t-row-off)))))
894 (defun coterm--t-clear-screen ()
895 "Clear terminal screen.
896 If not using alternative sub-buffer, simply move home marker to
897 point-max"
898 (setq coterm--t-row-off (coterm--t-row))
899 (setq coterm--t-col-off (coterm--t-col))
900 (if coterm--t-alternative-sub-buffer
901 (delete-region coterm--t-home (point-max))
902 (setq coterm--t-home-off 0)
903 (goto-char (point-max))
904 (unless (bolp)
905 (cl-incf coterm--t-row-off)
906 (setq coterm--t-home-off 1)
907 (setq coterm--t-col-off
908 (- coterm--t-col-off (move-to-column coterm--t-col-off))))
909 (set-marker coterm--t-home (point))))
911 (defun coterm--t-insert (proc-filt process str newlines)
912 "Insert STR at point using PROC-FILT and PROCESS.
913 Synchronise PROCESS's mark beforehand and insert at its position.
914 NEWLINES is the number of newlines STR contains. Unless it is
915 zero, insertion must happen at the end of accessible portion of
916 buffer and the scrolling region must begin at the top of the
917 terminal screen.
919 This function also converts all occuences of \"\\r\\n\" into
920 \"\\n\" in STR before inserting it."
921 (setq str (string-replace "\r" "" str))
922 (unless (zerop coterm--t-row-off)
923 (setq coterm--t-col-off (coterm--t-col))
924 (goto-char (point-max)))
925 (unless (and (zerop coterm--t-col-off) (zerop coterm--t-row-off))
926 (coterm--t-apply-proc-filt proc-filt process
927 (concat (make-string coterm--t-row-off ?\n)
928 (make-string (max 0 coterm--t-col-off) ?\s)))
929 (setq coterm--t-col-off 0 coterm--t-row-off 0))
930 (cond
931 ((not (zerop newlines))
932 (coterm--t-apply-proc-filt proc-filt process str)
933 (when coterm--t-row
934 (cl-incf coterm--t-row newlines))
936 ;; Scroll if necessary
937 (when (>= (coterm--t-row) coterm--t-height)
938 (let ((opoint (point)))
939 (forward-line (- 1 coterm--t-height))
940 (set-marker coterm--t-home (point))
941 (setq coterm--t-home-off 0)
942 (setq coterm--t-row (1- coterm--t-height))
943 (goto-char opoint))))
945 ((not (eobp))
946 (if coterm--t-insert-mode
947 (coterm--t-apply-proc-filt proc-filt process str)
948 ;; If not in insert mode, replace text
949 (let ((old-col (coterm--t-col)))
950 (coterm--t-apply-proc-filt proc-filt process str)
951 (when (< old-col (coterm--t-col))
952 (delete-region
953 (point)
954 (progn (move-to-column (- (* 2 coterm--t-col) old-col))
955 (point)))))))
957 (t (coterm--t-apply-proc-filt proc-filt process str))))
959 (defun coterm--t-emulate-terminal (proc-filt process string)
960 (let* ((pmark (process-mark process))
961 (match 0)
962 (will-insert-newlines 0)
963 (inhibit-read-only t)
964 restore-point
965 last-match-end
966 old-pmark
968 ctl-params ctl-end)
970 (cl-macrolet
971 ;; Macros for looping through control sequences
972 ((ins ()
973 `(progn
974 (let ((str (substring string last-match-end match)))
975 (unless (equal "" str)
976 (coterm--t-insert proc-filt process str
977 will-insert-newlines)
978 (setq will-insert-newlines 0)))
979 (setq last-match-end ctl-end)))
980 (pass-through ()
981 `(ignore))
982 (ctl-params* ()
983 `(mapcar #'string-to-number (split-string ctl-params ";")))
984 (car-or-1 ()
985 `(max 1 (car (ctl-params*))))
986 (cadr-or-0 ()
987 `(or (cadr (ctl-params*)) 0)))
989 (if (not (and string
990 (setq buf (process-buffer process))
991 (buffer-live-p buf)))
992 (funcall proc-filt process string)
994 (with-current-buffer buf
995 (when coterm--t-log-buffer
996 (with-current-buffer (get-buffer-create coterm--t-log-buffer)
997 (save-excursion
998 (goto-char (point-max))
999 (insert (make-string 70 ?=) ?\n)
1000 (insert string ?\n))))
1002 (when-let ((fragment coterm--t-unhandled-fragment))
1003 (setq string (concat fragment string))
1004 (setq coterm--t-unhandled-fragment nil))
1006 (setq restore-point (if (= (point) pmark) pmark (point-marker)))
1007 (setq old-pmark (copy-marker pmark window-point-insertion-type))
1009 (save-restriction
1010 (coterm--narrow-to-process-output pmark)
1011 (goto-char pmark)
1012 ;; (setq coterm--t-row nil)
1013 (setq coterm--t-col nil)
1014 (setq coterm--t-row-off 0)
1015 (setq coterm--t-col-off 0)
1017 ;; scroll cursor pmark into view by moving home marker if necessary
1018 (let ((opoint (point)))
1019 (cond
1020 ((<= opoint coterm--t-home)
1021 (forward-line 0)
1022 (set-marker coterm--t-home (point))
1023 (setq coterm--t-home-off 0)
1024 (setq coterm--t-row 0))
1026 (unless (zerop coterm--t-home-off)
1027 (goto-char coterm--t-home)
1028 (forward-line coterm--t-home-off)
1029 (set-marker coterm--t-home (point))
1030 (setq coterm--t-home-off 0)
1031 (goto-char opoint))
1032 (forward-line (- 1 coterm--t-height))
1033 (if (<= (point) coterm--t-home)
1034 (setq coterm--t-row nil)
1035 (set-marker coterm--t-home (point))
1036 (setq coterm--t-row (1- coterm--t-height)))))
1037 (goto-char opoint))
1039 (while (setq match (string-match coterm--t-control-seq-regexp
1040 string ctl-end))
1041 (setq ctl-params (match-string 1 string))
1042 (setq ctl-end (match-end 0))
1044 (pcase (aref string match)
1045 ((and ?\r (guard (= ctl-end (+ 2 match))))
1046 ;; A match string of length two and beginning with \r means
1047 ;; that we have matched "\r\n". In this case, and if we are
1048 ;; at eob, we pass-through to avoid an unnecessary call to
1049 ;; `substring' which is expensive. In the most common case
1050 ;; when the process just outputs text at eob without any
1051 ;; control sequences, we will end up inserting the whole
1052 ;; string without a single call to `substring'.
1053 (if (and (eobp)
1054 (not coterm--t-alternative-sub-buffer)
1055 (= 0 coterm--t-scroll-beg))
1056 (progn (pass-through)
1057 (cl-incf will-insert-newlines))
1058 (ins)
1059 (setq coterm--t-col 0
1060 coterm--t-col-off 0)
1061 (move-to-column 0)
1062 (coterm--t-down-line proc-filt process)))
1063 (?\n (ins) ;; (terminfo: cud1, ind)
1064 (coterm--t-down-line proc-filt process))
1065 (?\r (ins) ;; (terminfo: cr)
1066 (setq coterm--t-col 0
1067 coterm--t-col-off 0)
1068 (move-to-column 0))
1069 ;; TAB (terminfo: ht)
1070 ((and ?\t (guard (eobp)))
1071 ;; Insert a TAB as is, if at eob
1072 (pass-through))
1073 (?\t
1074 ;; Otherwise, move cursor to the next tab stop
1075 (ins)
1076 (setq coterm--t-col
1077 (min (1- coterm--t-width)
1078 (+ (coterm--t-col) 8 (- (mod coterm--t-col 8)))))
1079 (setq coterm--t-col-off (- coterm--t-col (move-to-column coterm--t-col))))
1080 (?\b ;; (terminfo: cub1)
1081 (ins)
1082 (if (and (= (1- (coterm--t-col)) coterm--t-width)
1083 (eq (char-before) ?\s))
1084 ;; Awkward hack to make line-wrapping work in "less".
1085 ;; Very specific to the way "less" performs wrapping: When
1086 ;; reaching the end of line, instead of sending "\r\n" to
1087 ;; go to the start of the next line, it sends " \b": a
1088 ;; space which wraps to the next line in most terminals
1089 ;; and a backspace to move to the start of the line. Here
1090 ;; we detect this and handle it like an ordinary "\r\n".
1092 ;; For all other cases, coterm does not perform any
1093 ;; wrapping at all.
1094 (progn
1095 (delete-char -1)
1096 (setq coterm--t-col 0
1097 coterm--t-col-off 0)
1098 (move-to-column 0)
1099 (coterm--t-down-line proc-filt process))
1100 ;; (debug)
1101 (setq coterm--t-col (max 0 (1- coterm--t-col)))
1102 (setq coterm--t-col-off (- coterm--t-col (move-to-column coterm--t-col)))))
1103 (?\C-g (ins) ;; (terminfo: bel)
1104 (beep t))
1105 ;; Ignore NUL, Shift Out, Shift In.
1106 ((or ?\0 14 15 '()) (ins))
1107 (?\e
1108 (pcase (aref string (1+ match))
1109 (?D (ins)
1110 (coterm--t-down-line proc-filt process))
1111 (?M (ins) ;; (terminfo: ri)
1112 (coterm--t-up-line proc-filt process))
1113 (?7 (ins) ;; Save cursor (terminfo: sc)
1114 (setq coterm--t-saved-cursor
1115 (list (coterm--t-row)
1116 (coterm--t-col)
1117 ansi-color-context-region
1118 ansi-color-context)))
1119 (?8 (ins) ;; Restore cursor (terminfo: rc)
1120 (when-let ((cursor coterm--t-saved-cursor))
1121 (setq coterm--t-saved-cursor nil)
1122 (coterm--t-goto
1123 (min (car cursor) (1- coterm--t-height))
1124 (progn (setq cursor (cdr cursor))
1125 (min (car cursor) (1- coterm--t-width))))
1126 (setq cursor (cdr cursor))
1127 (setq ansi-color-context-region (car cursor))
1128 (setq ansi-color-context (cadr cursor))))
1129 (?c (ins) ;; \Ec - Reset (terminfo: rs1)
1130 (erase-buffer)
1131 (setq ansi-color-context-region nil)
1132 (setq ansi-color-context nil)
1133 (setq coterm--t-home-off 0)
1134 (setq coterm--t-row 0)
1135 (setq coterm--t-row-off 0)
1136 (setq coterm--t-col 0)
1137 (setq coterm--t-col-off 0)
1138 (setq coterm--t-scroll-beg 0)
1139 (setq coterm--t-scroll-end coterm--t-height)
1140 (setq coterm--t-insert-mode nil))
1141 (?\] (pass-through)) ;; OSC sequence, handled by comint
1142 (?A (ins)) ;; Ignore term.el specific \eAnSiT sequences
1143 ;; mpv outputs sequences \E= and \E>. Ignore them
1144 ((or ?= ?>) (ins))
1145 (?\[
1146 (pcase (aref string (1- ctl-end))
1147 (?m ;; Let `comint-output-filter-functions' handle this
1148 (pass-through))
1149 ((or ?H ?f) ;; cursor motion (terminfo: cup,home)
1150 (ins)
1151 (coterm--t-goto
1152 (1- (max 1 (min (car-or-1) coterm--t-height)))
1153 (1- (max 1 (min (cadr-or-0) coterm--t-width)))))
1154 (?A ;; cursor up (terminfo: cuu, cuu1)
1155 (ins)
1156 (coterm--t-goto (max (- (coterm--t-row) (car-or-1))
1157 coterm--t-scroll-beg)
1158 (coterm--t-col)))
1159 (?B ;; cursor down (terminfo: cud)
1160 (ins)
1161 (coterm--t-goto (min (+ (coterm--t-row) (car-or-1))
1162 (1- coterm--t-scroll-end))
1163 (coterm--t-col)))
1164 (?C ;; \E[C - cursor right (terminfo: cuf, cuf1)
1165 (ins)
1166 (setq coterm--t-col (min (+ (coterm--t-col) (car-or-1))
1167 (1- coterm--t-width)))
1168 (setq coterm--t-col-off (- coterm--t-col (move-to-column coterm--t-col))))
1169 (?D ;; \E[D - cursor left (terminfo: cub)
1170 (ins)
1171 (setq coterm--t-col (max (- (coterm--t-col) (car-or-1))
1173 (setq coterm--t-col-off (- coterm--t-col (move-to-column coterm--t-col))))
1174 (?E ;; \E[E - cursor down and column 0
1175 (ins)
1176 (coterm--t-goto (min (+ (coterm--t-row) (car-or-1))
1177 (1- coterm--t-scroll-end))
1179 (?F ;; \E[F - cursor up and column 0
1180 (ins)
1181 (coterm--t-goto (max (- (coterm--t-row) (car-or-1))
1182 coterm--t-scroll-beg)
1184 (?G ;; \E[G - horizontal cursor position
1185 (ins)
1186 (setq coterm--t-col (min (1- (car-or-1))
1187 (1- coterm--t-width)))
1188 (setq coterm--t-col-off (- coterm--t-col (move-to-column coterm--t-col))))
1189 ;; \E[J - clear to end of screen (terminfo: ed, clear)
1190 ((and ?J (guard (eq 0 (car (ctl-params*)))))
1191 (ins)
1192 (when (zerop coterm--t-row-off)
1193 (if (= (point) coterm--t-home)
1194 (coterm--t-clear-screen)
1195 (delete-region (point) (point-max)))))
1196 ((and ?J (guard (eq 1 (car (ctl-params*)))))
1197 (ins)
1198 (if (zerop coterm--t-row-off)
1199 (let ((opoint (point))
1200 (orow (coterm--t-row))
1201 (ocol (coterm--t-col)))
1202 (goto-char coterm--t-home)
1203 (forward-line coterm--t-home-off)
1204 (delete-region (point) opoint)
1205 (unless (eobp)
1206 (coterm--t-apply-proc-filt
1207 proc-filt process
1208 (concat (make-string orow ?\n)
1209 (unless (eolp)
1210 (make-string ocol ?\s)))))
1211 (coterm--t-goto orow ocol))
1212 (coterm--t-clear-screen)))
1213 (?J (ins) (coterm--t-clear-screen))
1214 ;; \E[K - clear to end of line (terminfo: el, el1)
1215 ((and ?K (guard (eq 1 (car (ctl-params*)))))
1216 (ins)
1217 (and
1218 (not (bolp))
1219 (zerop coterm--t-row-off)
1220 (let ((ocol (coterm--t-col)))
1221 (delete-region (point) (progn (forward-line 0) (point)))
1222 (if (eolp)
1223 (setq coterm--t-col-off ocol)
1224 (coterm--t-apply-proc-filt
1225 proc-filt process (make-string ocol ?\s))
1226 (setq coterm--t-col-off 0)))))
1227 ((and ?K (guard (eobp)))
1228 (pass-through))
1230 (ins)
1231 (when (< (coterm--t-col) coterm--t-width)
1232 (let ((opoint (point)))
1233 (when (zerop (forward-line))
1234 (when (bolp) (backward-char))
1235 (delete-region opoint (point)))
1236 (goto-char opoint))))
1237 (?L ;; \E[L - insert lines (terminfo: il, il1)
1238 (ins)
1239 (when (<= coterm--t-scroll-beg (coterm--t-row)
1240 (1- coterm--t-scroll-end))
1241 (let ((coterm--t-scroll-beg coterm--t-row))
1242 (dotimes (_ (min (- coterm--t-scroll-end coterm--t-row)
1243 (car-or-1)))
1244 (coterm--t-up-line proc-filt process)))))
1245 (?M ;; \E[M - delete lines (terminfo: dl, dl1)
1246 (ins)
1247 (when (<= coterm--t-scroll-beg (coterm--t-row)
1248 (1- coterm--t-scroll-end))
1249 (let ((coterm--t-scroll-beg coterm--t-row)
1250 (orow coterm--t-row)
1251 (ocol (coterm--t-col)))
1252 (coterm--t-goto (1- coterm--t-scroll-end) ocol)
1253 (dotimes (_ (min (- coterm--t-scroll-end orow)
1254 (car-or-1)))
1255 (coterm--t-down-line proc-filt process))
1256 (coterm--t-goto orow ocol))))
1257 (?P ;; \E[P - delete chars (terminfo: dch, dch1)
1258 (ins)
1259 (when (zerop coterm--t-row-off)
1260 (let ((opoint (point)))
1261 (move-to-column (+ (coterm--t-col) (car-or-1)))
1262 (delete-region opoint (point)))))
1263 (?@ ;; \E[@ - insert spaces (terminfo: ich)
1264 (ins)
1265 (let ((width (min (car-or-1) (max 0 (- coterm--t-width
1266 (coterm--t-col)))))
1267 (opoint (point)))
1268 (unless (eolp)
1269 (coterm--t-apply-proc-filt proc-filt process
1270 (make-string width ?\s))
1271 (goto-char opoint))))
1272 (?h ;; \E[?h - DEC Private Mode Set
1273 (ins)
1274 (pcase (car (ctl-params*))
1275 (47 ;; (terminfo: smcup)
1276 (coterm--t-switch-to-alternate-sub-buffer
1277 proc-filt process t))
1278 (4 ;; (terminfo: smir)
1279 (setq coterm--t-insert-mode t))))
1280 (?l ;; \E[?l - DEC Private Mode Reset
1281 (ins)
1282 (pcase (car (ctl-params*))
1283 (47 ;; (terminfo: rmcup)
1284 (coterm--t-switch-to-alternate-sub-buffer
1285 proc-filt process nil))
1286 (4 ;; (terminfo: rmir)
1287 (setq coterm--t-insert-mode nil))))
1288 (?n ;; \E[6n - Report cursor position (terminfo: u7)
1289 (ins)
1290 (process-send-string
1291 process
1292 ;; (terminfo: u6)
1293 (format "\e[%s;%sR"
1294 (1+ (coterm--t-row))
1295 (1+ (coterm--t-col)))))
1296 (?r ;; \E[r - Set scrolling region (terminfo: csr)
1297 (ins)
1298 (let ((beg (1- (car-or-1)))
1299 (end (max 1 (cadr-or-0))))
1300 (setq coterm--t-scroll-beg
1301 (if (< beg coterm--t-height) beg 0))
1302 (setq coterm--t-scroll-end
1303 (if (<= 1 end coterm--t-height)
1304 end coterm--t-height))))))))))
1306 (cond
1307 ((setq match (string-match coterm--t-control-seq-prefix-regexp
1308 string ctl-end))
1309 (ins)
1310 (setq coterm--t-unhandled-fragment (substring string match)))
1311 ((null last-match-end)
1312 ;; Optimization: no substring means no string copying
1313 (coterm--t-insert proc-filt process string will-insert-newlines))
1315 (ins)))
1317 ;; Synchronize pmark and remove all trailing whitespace after it.
1318 (unless (and (zerop coterm--t-col-off) (zerop coterm--t-row-off))
1319 (coterm--t-insert proc-filt process "" 0))
1320 (set-marker pmark (point))
1321 (skip-chars-forward " \n")
1322 (when (eobp)
1323 (delete-region pmark (point))))
1325 ;; Restore point (this restores it only for the selected window)
1326 (goto-char restore-point)
1327 (unless (eq restore-point pmark)
1328 (set-marker restore-point nil))
1330 ;; Restore points of non-selected windows, if their `window-point'
1331 ;; was on pmark
1332 (let* ((sel-win (selected-window))
1333 (w (next-window sel-win nil t)))
1334 ;; Avoid infinite loop in strange case where minibuffer window
1335 ;; is selected but not active.
1336 (while (window-minibuffer-p w)
1337 (setq w (next-window w nil t)))
1338 (while (not (eq w sel-win))
1339 (and (eq buf (window-buffer w))
1340 (= (window-point w) old-pmark)
1341 (set-window-point w pmark))
1342 (setq w (next-window w nil t)))
1343 (set-marker old-pmark nil))
1345 (run-hooks 'coterm-t-after-insert-hook))))))
1347 (provide 'coterm)
1348 ;;; coterm.el ends here