[elpa] externals/coterm 7b1e001 01/80: Initial commit

[ELPA Syncer]

branch: externals/coterm
commit 7b1e0018654c297ff50aca18d5695ae06882db07
Author: m <>
Commit: m <>

    Initial commit
---
 .gitignore |   1 +
 coterm.el  | 408 +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
 2 files changed, 409 insertions(+)

diff --git a/.gitignore b/.gitignore
new file mode 100644
index 0000000..aee2ce5
--- /dev/null
+++ b/.gitignore
@@ -0,0 +1 @@
+/*.elc
diff --git a/coterm.el b/coterm.el
new file mode 100644
index 0000000..ad14a30
--- /dev/null
+++ b/coterm.el
@@ -0,0 +1,408 @@
+;; -*- lexical-binding: t; -*-
+
+;;; Terminal emulation
+
+;; Removed \t, \032 (\C-z), \eAnSiT
+(defconst coterm-t-control-seq-regexp
+  (concat
+   ;; A control character,
+   "\\(?:[\r\n\000\007\b\016\017]\\|"
+   ;; a C1 escape coded character (see [ECMA-48] section 5.3 "Elements
+   ;; of the C1 set"),
+   "\e\\(?:[DM78c]\\|"
+   ;; or an escape sequence (section 5.4 "Control Sequences"),
+   "\\[\\([\x30-\x3F]*\\)[\x20-\x2F]*[\x40-\x7E]\\)\\)")
+  "Regexp matching control sequences handled by term.el.")
+
+(defconst coterm-t-control-seq-prefix-regexp "\e")
+
+(defvar-local coterm-t-height t
+  "Number of lines in window.")
+(defvar-local coterm-t-width nil
+  "Number of columns in window.")
+
+(defvar-local coterm--t-home-marker nil
+  "Marks the \"home\" position for cursor addressing.
+`coterm--t-home-offset' should be taken into account as well.")
+(defvar-local coterm--t-home-offset 0
+  "How many rows lower the home position actually is.
+This usually is needed if `coterm--t-home-marker' is on the last
+line of the buffer.")
+(defvar-local coterm--t-row nil
+  "Current position from home marker.
+If nil, the current position is at process mark.")
+(defvar-local coterm--t-col nil
+  "Current position from home marker.
+If nil, the current position is at process mark.")
+
+(defvar-local coterm--t-pmark-in-sync nil
+  "If t, pmark is guaranteed to be in sync.
+In sync with variables `coterm--t-home-marker',
+`coterm--t-home-offset', `coterm--t-row' and `coterm--t-col'")
+
+(defvar-local coterm--t-saved-cursor nil)
+(defvar-local coterm-t-insert-mode nil)
+
+(defvar-local coterm--t-unhandled-fragment nil)
+
+(defun coterm--t-reset-size (height width)
+  (setq coterm-t-height height)
+  (setq coterm-t-width width))
+
+(defun coterm--t-normalize-home-offset ()
+  (save-excursion
+    (goto-char coterm--t-home-marker)
+    (let ((left-to-move (forward-line coterm--t-home-offset)))
+      (unless (bolp)
+        (cl-incf left-to-move)
+        (forward-line 0))
+      (set-marker coterm--t-home-marker (point))
+      (setq coterm--t-home-offset left-to-move))))
+
+(defun coterm-t-scroll-into-view ()
+  (let ((height coterm-t-height)
+        (row coterm--t-row)
+        (home coterm--t-home-marker))
+    (cond
+     ((> row height)
+      (save-excursion
+        (goto-char home)
+        (let ((left-to-move (forward-line (+ coterm--t-home-offset
+                                             (- row height 1)))))
+          (unless (bolp)
+            (cl-incf left-to-move)
+            (forward-line 0))
+          (set-marker home (point))
+          (cl-incf coterm--t-home-offset left-to-move)
+          (setq coterm--t-row height))))
+     ((< row 0)
+      (save-excursion
+        (goto-char home)
+        (forward-line row)
+        (set-marker home (point))
+        (setq coterm--t-row 0))))))
+
+(defun coterm-t-down (n)
+  (cl-incf coterm--t-row n)
+  (setq coterm--t-pmark-in-sync nil)
+  (coterm-t-scroll-into-view))
+
+;; Moves pmark, inserts
+(defun coterm--t-adjust-pmark (proc-filt process)
+  "Set PROCESS's mark to `coterm--t-row' and `coterm--t-col'.
+If necessary, this function inserts newlines and spaces using
+PROC-FILT, so use it sparingly, usually only before inserting
+non-whitespace text."
+  (unless coterm--t-pmark-in-sync
+    (let ((pmark (process-mark process)))
+      (save-excursion
+        (goto-char coterm--t-home-marker)
+
+        (let ((newlines (forward-line
+                         (+ coterm--t-row coterm--t-home-offset))))
+          (unless (bolp)
+            (cl-incf newlines))
+          (unless (zerop newlines)
+            (set-marker pmark (point))
+            (funcall proc-filt process (make-string newlines ?\n))))
+
+        (let ((col (move-to-column coterm--t-col)))
+          (set-marker pmark (point))
+          (when (< col coterm--t-col)
+            (funcall proc-filt process
+                     (make-string (- coterm--t-col col) ?\s))))))
+    (setq coterm--t-pmark-in-sync t)
+    (coterm--t-normalize-home-offset)))
+
+;; Moves pmark and inserts
+(defun coterm--t-insert (proc-filt process str newlines)
+  "Insert STR using PROC-FILT and PROCESS.
+Synchronise PROCESS's mark beforehand and insert at its position.
+NEWLINES is the number of newlines STR contains. Unless it is
+zero, insertion should happen at the end of accessible portion of
+buffer."
+  (coterm--t-adjust-pmark proc-filt process)
+  (funcall proc-filt process str)
+  (save-excursion
+    (goto-char (process-mark process))
+    (let ((column (current-column)))
+      (if (zerop newlines)
+          (if coterm-t-insert-mode
+              (progn
+                (move-to-column coterm-t-width)
+                (delete-region
+                 (point) (progn (forward-line 1) (1- (point)))))
+            (delete-region
+             (point)
+             (progn (move-to-column (- (* 2 column) coterm--t-col)) (point))))
+        (cl-incf coterm--t-row newlines)
+        (coterm-t-scroll-into-view))
+      (setq coterm--t-col column))))
+
+;; Depends on pmark
+(defun coterm--t-maybe-adjust-from-pmark (pos)
+  "If `coterm--t-row' and col are nil, point them to POS.
+`coterm--t-home-marker' may also be nil, in which case,
+initialize it sensibly."
+  (unless coterm--t-home-marker
+    (setq coterm--t-home-marker (point-min-marker))
+    (setq coterm--t-home-offset 0))
+  (unless coterm--t-row
+    (save-excursion
+      (goto-char pos)
+      (setq coterm--t-col (current-column))
+      (coterm--t-normalize-home-offset)
+      (forward-line 0)
+      (if (> (point) coterm--t-home-marker)
+          (save-restriction
+            (narrow-to-region coterm--t-home-marker (point))
+            (let ((lines-left (forward-line (- 1 coterm-t-height))))
+              (when (= 0 lines-left)
+                (set-marker coterm--t-home-marker (point)))
+              (setq coterm--t-row (+ -1 coterm-t-height lines-left))))
+        (progn
+          (set-marker coterm--t-home-marker (point))
+          (setq coterm--t-home-offset 0)
+          (setq coterm--t-row 0))))
+    (setq coterm--t-pmark-in-sync t)))
+
+(defun coterm-t-emulate-terminal (proc-filt process string)
+  (when-let ((fragment coterm--t-unhandled-fragment))
+    (setq string (concat fragment string))
+    (setq coterm--t-unhandled-fragment nil))
+
+  (let* ((pmark (process-mark process))
+         (match 0)
+         (will-insert-newlines 0)
+         restore-point
+         last-match-end
+         buf fragment
+         ctl-params ctl-end)
+
+    (cl-macrolet
+        ;; Macros for looping through control sequences
+        ((ins ()
+           `(progn
+              (let ((str (substring string last-match-end match)))
+                (unless (equal "" str)
+                  (coterm--t-insert proc-filt process str
+                                    will-insert-newlines)
+                  (setq will-insert-newlines 0)))
+              (setq last-match-end ctl-end)))
+         (dirty ()
+           `(setq coterm--t-pmark-in-sync nil))
+         (pass-through ()
+           `(ignore)))
+
+      (if (not (and string
+                    (setq buf (process-buffer process))
+                    (buffer-live-p buf)))
+          (funcall proc-filt process string)
+
+        (with-current-buffer buf
+          (setq restore-point (if (= (point) pmark) pmark (point-marker)))
+          (coterm--t-maybe-adjust-from-pmark pmark)
+          (save-restriction
+            (unless (text-property-any
+                     pmark (point-max) 'field 'output)
+              ;; If pmark is at the end of buffer, not counting user input,
+              ;; prevent changing this user input by narrowing the buffer
+              (narrow-to-region (point-min) pmark))
+
+            (while (setq match (string-match coterm-t-control-seq-regexp
+                                             string ctl-end))
+              (setq ctl-params (match-string 1 string))
+              (setq ctl-end (match-end 0))
+
+              (pcase (aref string match)
+                ((and ?\n
+                      (guard coterm--t-pmark-in-sync)
+                      (guard (= pmark (point-max))))
+                 (pass-through)
+                 (cl-incf will-insert-newlines))
+                (?\n (ins)
+                     (coterm-t-down 1)
+                     (setq coterm--t-col 0))
+                (?\r (ins) ;; (terminfo: cr)
+                     (setq coterm--t-col 0)
+                     (dirty))
+                (?\b (ins) ;; (terminfo: cub1)
+                     (cl-decf coterm--t-col 1)
+                     (dirty))
+                (?\C-g (ins) ;; (terminfo: bel)
+                       (beep t))
+                ;; Ignore NUL, Shift Out, Shift In.
+                ((or ?\0 14 15 '()) (ins))
+                (?\e
+                 (pcase (aref string (1+ match))
+                   (?D (ins)
+                       (coterm-t-down 1))
+                   (?M (ins) ;; (terminfo: ri)
+                       (coterm-t-down -1))
+                   (?7 (ins) ;; Save cursor (terminfo: sc)
+                       (coterm-t-scroll-into-view)
+                       (setq coterm--t-saved-cursor
+                             (list coterm--t-row
+                                   coterm--t-col
+                                   (when (boundp 'ansi-color-context-region)
+                                     (list ansi-color-context-region)))))
+                   (?8 (ins) ;; Restore cursor (terminfo: rc)
+                       (when-let ((cursor coterm--t-saved-cursor))
+                         (setq coterm--t-row (car cursor))
+                         (setq cursor (cdr (cursor)))
+                         (setq coterm--t-col (car cursor))
+                         (setq cursor (cdr (cursor)))
+                         (when (car cursor)
+                           (setq coterm--t-row (caar cursor)))))
+                   (?c (ins) ;; \Ec - Reset (terminfo: rs1)
+                       (erase-buffer)
+                       (when (boundp 'ansi-color-context-region)
+                         (setq ansi-color-context-region nil))
+                       (setq coterm--t-row 0)
+                       (setq coterm--t-col 0)
+                       (setq coterm-t-insert-mode nil))
+                   (?\[
+                    (pcase (aref string (1- ctl-end))
+                      (?m    ; Let `comint-output-filter-functions' handle this
+                       (pass-through))
+                      (char
+                       (setq ctl-params (mapcar #'string-to-number
+                                                (split-string ctl-params ";")))
+                       (pcase char
+                         (?H (ins) ;; cursor motion (terminfo: cup,home)
+                             (setq coterm--t-row
+                                   (1- (max 1 (min (or (nth 0 ctl-params) 0) 
coterm-t-height))))
+                             (setq coterm--t-col
+                                   (1- (max 1 (min (or (nth 1 ctl-params) 0) 
coterm-t-width))))
+                             (dirty))
+                         (?A (ins) ;; cursor up (terminfo: cuu, cuu1)
+                             (cl-decf coterm--t-row (car ctl-params))
+                             (setq coterm--t-row (max coterm--t-row 0))
+                             (dirty))
+                         (?B (ins) ;; cursor down (terminfo: cud)
+                             (cl-incf coterm--t-row (car ctl-params))
+                             (setq coterm--t-row (min coterm--t-row (1- 
coterm-t-height)))
+                             (dirty))
+                         (?C (ins) ;; \E[C - cursor right (terminfo: cuf, cuf1)
+                             (cl-incf coterm--t-col (car ctl-params))
+                             (setq coterm--t-col (min coterm--t-col (1- 
coterm-t-width)))
+                             (dirty))
+                         (?D (ins) ;; \E[D - cursor left (terminfo: cub)
+                             (cl-decf coterm--t-col (car ctl-params))
+                             (setq coterm--t-col (max coterm--t-col 0))
+                             (dirty))
+                         (?J ;; \E[J - clear to end of screen (terminfo: ed, 
clear)
+                          (ins)
+                          (save-excursion
+                            (goto-char coterm--t-home-marker)
+                            (and
+                             (zerop (forward-line
+                                     (+ coterm--t-home-offset coterm--t-row)))
+                             (bolp)
+                             (move-to-column coterm--t-col))
+                            (set-marker pmark (point)))
+                          (pcase (car ctl-params)
+                            (0
+                             (delete-region pmark (point-max)))
+                            (1 (coterm--t-normalize-home-offset)
+                               (delete-region coterm--t-home-marker pmark)
+                               (unless (= pmark (point-max))
+                                 ;; Substitute deleted region with empty lines
+                                 (funcall proc-filt process
+                                          (concat (make-string coterm--t-row 
?\n)
+                                                  (make-string coterm--t-col 
?\s)))))
+                            (_ (coterm--t-normalize-home-offset)
+                               (delete-region coterm--t-home-marker 
(point-max))))
+                          (dirty))))))))))
+
+            (cond
+             ((setq match (string-match coterm-t-control-seq-prefix-regexp
+                                        string ctl-end))
+              (while (setq match (string-match 
coterm-t-control-seq-prefix-regexp
+                                               string (1+ match)))
+                (setq ctl-end (1+ match)))
+              (ins)
+              (setq coterm--t-unhandled-fragment (substring string 
last-match-end)))
+             ((and (null last-match-end)
+                   ;; TODO Smo na koncu, razen vhoda
+                   )
+              ;; Optimization, no substring means no string copying
+              (coterm--t-insert proc-filt process string will-insert-newlines))
+             (t
+              (ins)))
+
+            ;; Here, we are at the end of process filtering. `coterm--t-row'
+            ;; and `coterm--t-col' may point to a not yet existent location
+            ;; after (point-max).  First, we move `pmark' as close to this
+            ;; position as possible.
+            (if (or coterm--t-pmark-in-sync
+                    (equal
+                     '(0 . t)
+                     (save-excursion
+                       (goto-char coterm--t-home-marker)
+                       (prog1
+                           (cons
+                            (let ((newlines (forward-line
+                                             (+ coterm--t-row 
coterm--t-home-offset))))
+                              (if (bolp) newlines nil))
+                            (unless (eobp)
+                              (>= coterm--t-col (move-to-column 
coterm--t-col))))
+                         (set-marker pmark (point))))))
+                ;; If we succeed, clear `coterm--t-row' and col.  On next
+                ;; output, we will initialize them to point to `pmark'.
+                (setq coterm--t-row nil
+                      coterm--t-col nil)
+              ;; If we don't succeed, leave the variables unchanged.  They will
+              ;; be used to handle next output.
+              (ignore)))
+
+          (goto-char restore-point))))))
+
+;;; Mode functions and configuration
+
+(defcustom coterm-term-name ;; term-term-name
+  "dumb"
+  "Name to use for TERM.")
+
+(defun coterm-comint-exec-h ()
+  (when-let (((derived-mode-p #'comint-mode))
+             (process (get-buffer-process (current-buffer))))
+    (setq coterm-t-height (floor (window-screen-lines)))
+    (setq coterm-t-width (window-max-chars-per-line))
+
+    (add-function :filter-return
+                  (local 'window-adjust-process-window-size-function)
+                  (lambda (size)
+                    (when size
+                      (coterm--t-reset-size (cdr size) (car size)))
+                    size)
+                  '((name . coterm-maybe-reset-size)))
+
+    (add-function :around (process-filter process)
+                  #'coterm-t-emulate-terminal))
+
+  ;; After `term-exec-hook', the major mode is often changed (for example into
+  ;; `shell-mode', which kills our local variables, so set them again after
+  ;; changing major modes.
+  (add-hook 'after-change-major-mode-hook #'coterm-comint-exec-h nil t))
+
+(put #'coterm-comint-exec-h 'permanent-local-hook t)
+
+(defvar coterm--old-comint-terminfo-terminal nil)
+
+(define-minor-mode coterm-mode
+  "Better terminal emulation in comint processes."
+  :global t
+  (if coterm-mode
+      (progn
+        (add-hook 'comint-exec-hook #'coterm-comint-exec-h)
+        (when coterm-term-name
+          (unless coterm--old-comint-terminfo-terminal
+            (setq coterm--old-comint-terminfo-terminal
+                  (list comint-terminfo-terminal)))
+          (setq comint-terminfo-terminal coterm-term-name)))
+    (remove-hook 'comint-exec-hook #'coterm-comint-exec-h)
+    (when coterm--old-comint-terminfo-terminal
+      (setq comint-terminfo-terminal
+            (car coterm--old-comint-terminfo-terminal))
+      (setq coterm--old-comint-terminfo-terminal nil))))