[elpa] externals/coterm 2358124 48/80: Try to enter and leave char-mode automatically

[ELPA Syncer]

branch: externals/coterm
commit 23581244de3f74ac1d8ed4f1236fcd1e218e8408
Author: m <>
Commit: m <>

    Try to enter and leave char-mode automatically
---
 coterm.el | 233 ++++++++++++++++++++++++++++++++++++++++++++++++++++----------
 1 file changed, 195 insertions(+), 38 deletions(-)

diff --git a/coterm.el b/coterm.el
index b6c46cf..1754728 100644
--- a/coterm.el
+++ b/coterm.el
@@ -1,6 +1,8 @@
 ;;; coterm.el --- Terminal emulation for comint -*- lexical-binding: t; -*-
 
 (require 'term)
+(eval-when-compile
+  (require 'cl-lib))
 
 ;;; Mode functions and configuration
 
@@ -85,13 +87,13 @@ if [ $1 = .. ]; then shift; fi; exec \"$@\"" null-device)
     (setq coterm-term-environment-function #'comint-term-environment)
     (setq coterm-start-process-function #'start-file-process)))
 
-;;; Raw mode
+;;; Char mode
 
 (defvar coterm-char-mode-map
   (let ((map (make-sparse-keymap)))
     (set-keymap-parent map term-raw-map)
-    (define-key map [remap term-char-mode] #'coterm-char-mode)
-    (define-key map [remap term-line-mode] #'coterm-char-mode)
+    (define-key map [remap term-char-mode] #'coterm-char-mode-cycle)
+    (define-key map [remap term-line-mode] #'coterm-char-mode-cycle)
     map))
 
 (define-minor-mode coterm-char-mode
@@ -107,8 +109,7 @@ customize it."
 
 (define-minor-mode coterm-scroll-snap-mode
   "Keep scroll synchronized.
-Usually enabled for full-screen terminal programs to keep them on
-screen."
+Useful for full-screen terminal programs to keep them on screen."
   :keymap nil
   (if coterm-scroll-snap-mode
       (progn
@@ -117,7 +118,8 @@ screen."
                 (cons scroll-margin
                       (local-variable-p 'scroll-margin)))
           (setq-local scroll-margin 0))
-        (add-hook 'coterm-t-after-insert-hook #'coterm--scroll-snap nil t))
+        (add-hook 'coterm-t-after-insert-hook #'coterm--scroll-snap 'append t)
+        (coterm--scroll-snap))
     (when-let ((margin coterm--char-old-scroll-margin))
       (setq coterm--char-old-scroll-margin nil)
       (if (cdr margin)
@@ -126,30 +128,193 @@ screen."
     (remove-hook 'coterm-t-after-insert-hook #'coterm--scroll-snap t)))
 
 (defun coterm--scroll-snap ()
-  (let* ((buf (current-buffer))
-         (pmark (process-mark (get-buffer-process buf)))
-         (sel-win (selected-window))
-         (w sel-win))
-    ;; Avoid infinite loop in strange case where minibuffer window
-    ;; is selected but not active.
-    (while (window-minibuffer-p w)
-      (setq w (next-window w nil t)))
-    (while
-        (progn
-          (when (and (eq buf (window-buffer w))
-                     ;; Only snap if point is on pmark
-                     (= (window-point w) pmark))
-            (if (eq sel-win w)
-                (progn
+  ;; We need to check for `coterm-scroll-snap-mode' because a function in
+  ;; `coterm-t-after-insert-hook' might have changed it
+  (when coterm-scroll-snap-mode
+    (let* ((buf (current-buffer))
+           (pmark (process-mark (get-buffer-process buf)))
+           (sel-win (selected-window))
+           (w sel-win))
+      ;; Avoid infinite loop in strange case where minibuffer window
+      ;; is selected but not active.
+      (while (window-minibuffer-p w)
+        (setq w (next-window w nil t)))
+      (while
+          (progn
+            (when (and (eq buf (window-buffer w))
+                       ;; Only snap if point is on pmark
+                       (= (window-point w) pmark))
+              (if (eq sel-win w)
+                  (progn
+                    (coterm--t-goto 0 0)
+                    (recenter 0)
+                    (goto-char pmark))
+                (with-selected-window w
                   (coterm--t-goto 0 0)
                   (recenter 0)
-                  (goto-char pmark))
-              (with-selected-window w
-                (coterm--t-goto 0 0)
-                (recenter 0)
-                (goto-char pmark))))
-          (setq w (next-window w nil t))
-          (not (eq w sel-win))))))
+                  (goto-char pmark))))
+            (setq w (next-window w nil t))
+            (not (eq w sel-win)))))))
+
+(defvar coterm-auto-char-mode)
+
+(defun coterm-char-mode-cycle ()
+  "Cycle between char mode on, off and auto.
+
+If `coterm-auto-char-mode' is enabled, disable it and enable
+both `coterm-char-mode' and `coterm-scroll-snap-mode'.
+
+If `coterm-char-mode' is enabled, disable it along with
+`coterm-scroll-snap-mode'.
+
+If it is disabled, enable `coterm-auto-char-mode'."
+  (interactive)
+  (cond
+   (coterm-auto-char-mode
+    ;; Interactively to show the message.
+    (funcall-interactively #'coterm-auto-char-mode -1)
+    (coterm-char-mode 1)
+    (coterm-scroll-snap-mode 1))
+   (coterm-char-mode
+    (coterm-char-mode -1)
+    (coterm-scroll-snap-mode -1))
+   (t (funcall-interactively #'coterm-auto-char-mode 1))))
+
+;;;; Automatic entry to char mode
+
+(define-minor-mode coterm-auto-char-mode
+  "Whether we should enter or leave char mode automatically.
+If enabled, `coterm-auto-char-functions' are consulted to set
+`coterm-char-mode' and `coterm-scroll-snap-mode' automatically."
+  :global nil
+  (if coterm-auto-char-mode
+      (progn
+        (add-hook 'coterm-t-after-insert-hook #'coterm--auto-char nil t)
+        (add-hook 'post-command-hook #'coterm--auto-char nil t)
+        (coterm--auto-char))
+    (remove-hook 'coterm-t-after-insert-hook #'coterm--auto-char t)
+    (remove-hook 'post-command-hook #'coterm--auto-char t)))
+
+(defvar coterm-auto-char-functions
+  (list #'coterm--auto-char-less-prompt
+        #'coterm--auto-char-mpv-prompt
+        #'coterm--auto-char-not-eob
+        #'coterm--auto-char-leave-both)
+  "Abnormal hook to enter or leave `coterm-char-mode'.
+This hook is run after every command and process output, if
+`coterm-auto-char-mode' enabled.  It is only called if point is
+on process's mark.
+
+Each function is called with zero argumets and with `point-max'
+on the end of process output until one returns non-nil.")
+
+(defun coterm--auto-char ()
+  "Automatically enter or leave `coterm-char-mode'.
+If point is not on process mark, leave `coterm-char-mode' and
+`coterm-scroll-snap-mode'.  Otherwise, call functions from
+`coterm-auto-char-functions' until one returns non-nil."
+  (let* ((proc (get-buffer-process (current-buffer)))
+         (pmark (and proc (process-mark proc)))
+         (opoint))
+    (if (and pmark (= (setq opoint (point)) pmark))
+        (save-restriction
+          (coterm--narrow-to-process-output pmark)
+          (goto-char opoint)
+          (run-hook-with-args-until-success 'coterm-auto-char-functions))
+      (when coterm-char-mode (coterm-char-mode -1))
+      (when coterm-scroll-snap-mode (coterm-scroll-snap-mode -1)))))
+
+(defun coterm--auto-char-less-prompt ()
+  (when (eobp)
+    (let ((opoint (point)))
+      (forward-line 0)
+      (prog1
+          (and
+           (looking-at
+            (concat
+             ":\\|"
+             "(END)\\|"
+             "byte [0-9]+\\|"
+             "100%\\|"
+             "\\(?:[^\n]* \\)?" "[0-9]?[0-9]%\\|"
+             "[^\n]*(press h for help or q to quit)"))
+           (when (= opoint (match-end 0))
+             (unless coterm-char-mode (coterm-char-mode 1))
+             (unless coterm-scroll-snap-mode (coterm-scroll-snap-mode 1))
+             t))
+        (goto-char opoint)))))
+
+(defun coterm--auto-char-mpv-prompt ()
+  (when (coterm--auto-char-mpv-prompt-1)
+    ;; (unless coterm-char-mode (coterm-char-mode 1))
+    ;; (when coterm-scroll-snap-mode (coterm-scroll-snap-mode -1))
+    (coterm-char-mode 1)
+    (cl-labels
+        ((hook ()
+           (or (coterm--auto-char-mpv-prompt-1)
+               (and (eobp) (bolp))
+               (ignore (rem-hook))))
+         (rem-hook ()
+           (remove-hook 'coterm-auto-char-functions #'hook t)
+           (remove-hook 'coterm-auto-char-mode-hook #'rem-hook t)))
+      (add-hook 'coterm-auto-char-functions #'hook nil t)
+      (add-hook 'coterm-auto-char-mode-hook #'rem-hook nil t)
+      (add-hook 'coterm-char-mode-hook #'rem-hook nil t)
+      (add-hook 'coterm-scroll-snap-mode-hook #'rem-hook nil t))
+    t))
+
+(defun coterm--auto-char-mpv-prompt-1 ()
+  "Return t if mpv is likely running."
+  (when (bolp)
+    (let ((opoint (point)))
+      (forward-line -1)
+      (prog1 (looking-at
+              (concat "\\(?:[^\n]*\n\\)?"
+                      "AV?: "
+                      "[0-9][0-9]:[0-9][0-9]:[0-9][0-9] / "
+                      "[0-9][0-9]:[0-9][0-9]:[0-9][0-9] "
+                      "([0-9]?[0-9]%)"
+                      "\\(?:"
+                      "\n\\[-*\\+-*\\]"
+                      "\\)?"
+                      "\\'"))
+        (goto-char opoint)))))
+
+(defun coterm--auto-char-not-eob ()
+  (when (looking-at "\\(?:.*\n\\)\\{9,\\}")
+    ;; (unless coterm-char-mode (coterm-char-mode 1))
+    ;; (unless coterm-scroll-snap-mode (coterm-scroll-snap-mode 1))
+    (coterm-char-mode 1)
+    (coterm-scroll-snap-mode 1)
+    (cl-labels
+        ((hook ()
+           (or (looking-at ".*\n.")
+               (ignore (rem-hook))))
+         (rem-hook ()
+           (remove-hook 'coterm-auto-char-functions #'hook t)
+           (remove-hook 'coterm-auto-char-mode-hook #'rem-hook t)))
+      (add-hook 'coterm-auto-char-functions #'hook nil t)
+      (add-hook 'coterm-auto-char-mode-hook #'rem-hook nil t)
+      (add-hook 'coterm-char-mode-hook #'rem-hook nil t)
+      (add-hook 'coterm-scroll-snap-mode-hook #'rem-hook nil t))
+    t))
+
+(defun coterm--auto-char-leave-both ()
+  (when coterm-char-mode (coterm-char-mode -1))
+  (when coterm-scroll-snap-mode (coterm-scroll-snap-mode -1))
+  t)
+
+(defun coterm--narrow-to-process-output (pmark)
+  "Narrow to process output and move point to the end of it.
+If there is no user input at end of buffer, simply widen.  PMARK
+is the process mark."
+  (widen)
+  (unless (eq (get-char-property (max 1 (1- (point-max))) 'field)
+              'output)
+    (goto-char (point-max))
+    (text-property-search-backward 'field 'output)
+    (when (<= pmark (point))
+      (narrow-to-region (point-min) (point)))))
 
 ;;; Terminal emulation
 
@@ -230,6 +395,7 @@ In sync with variables `coterm--t-home-marker',
 
     (setq-local comint-inhibit-carriage-motion t)
     (add-hook 'comint-output-filter-functions #'coterm--comint-strip-CR nil t)
+    (coterm-auto-char-mode)
 
     (add-function :filter-return
                   (local 'window-adjust-process-window-size-function)
@@ -499,16 +665,7 @@ buffer and the scrolling region must cover the whole 
screen."
           (setq old-pmark (copy-marker pmark window-point-insertion-type))
           (coterm--t-adjust-from-pmark pmark)
           (save-restriction
-            (widen)
-            (goto-char (point-max))
-            ;; Use narrowing to prevent modification of user input at end of
-            ;; buffer
-            (unless (eq (get-char-property (max 1 (1- (point-max))) 'field)
-                        'output)
-              (goto-char (point-max))
-              (text-property-search-backward 'field 'output)
-              (when (<= pmark (point))
-                (narrow-to-region (point-min) (point))))
+            (coterm--narrow-to-process-output pmark)
 
             (while (setq match (string-match coterm--t-control-seq-regexp
                                              string ctl-end))