bug#57821: 29.0.50; ANSI sequence not filtered in compilation buffer

[Matthias Meulien <orontee@gmail.com>]

[-- Attachment #1: Type: text/plain, Size: 374 bytes --]

Lars Ingebrigtsen <larsi@gnus.org> writes:

> You're supposed to type in after the colon what the change for the
> relevant item does.  :-)

😁 Sure.  Here are updated patches.  I also fixed the aliases: One was
missing (comint-osc-handlers) and one name was wrong
(comint-osc-hyperlink).

Note that I've not written any News entry.  Should I? For each patch?


[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: 0001-Extract-support-of-OSC-escape-sequences-from-comint.patch --]
[-- Type: text/x-diff, Size: 13601 bytes --]

From d31b6bf5ce7a3ad63aacf21d815f78eef5fa1404 Mon Sep 17 00:00:00 2001
From: Matthias Meulien <orontee@gmail.com>
Date: Sun, 18 Sep 2022 13:54:46 +0200
Subject: [PATCH 1/3] Extract support of OSC escape sequences from comint

* lisp/comint.el (osc): Now requires osc.el.
(comint-osc-directory-tracker): Alias to osc-directory-tracker.
(comint-osc-hyperlink-handler): Alias to osc-hyperlink-handler.
(comint-osc-hyperlink-map): Alias to osc-hyperlink-map.
(comint-osc-handlers): Alias to osc-handlers.
(comint-osc-hyperlink): Alias to osc-hyperlink.
(comint-osc-process-output): Rewritten to call osc-apply-on-region.
* lisp/osc.el (osc-handlers): Clone comint-osc-handlers.
(osc--marker): Clone comint-osc--marker.
(osc-apply-on-region): Implementation taken from comint-osc-process-output.
(osc-directory-tracker): Clone from comint-osc-directory-tracker.
(osc-hyperlink-map): Clone from comint-osc-hyperlink-map.
(osc-hyperlink): Clone from comint-osc-hyperlink.
(osc-hyperlink--state): Clone from comint-osc-hyperlink--state.
(osc-hyperlink-handler): Clone from comint-osc-hyperlink-handler.
* test/lisp/osc-tests.el (osc): Test osc-apply-region.
---
 lisp/comint.el         |  92 ++++-------------------------
 lisp/osc.el            | 127 +++++++++++++++++++++++++++++++++++++++++
 test/lisp/osc-tests.el |  57 ++++++++++++++++++
 3 files changed, 195 insertions(+), 81 deletions(-)
 create mode 100644 lisp/osc.el
 create mode 100644 test/lisp/osc-tests.el

diff --git a/lisp/comint.el b/lisp/comint.el
index 696dac3d12..afaa27c2c0 100644
--- a/lisp/comint.el
+++ b/lisp/comint.el
@@ -103,6 +103,7 @@
 
 (require 'ring)
 (require 'ansi-color)
+(require 'osc)
 (require 'regexp-opt)                   ;For regexp-opt-charset.
 (eval-when-compile (require 'subr-x))
 \f
@@ -3914,12 +3915,12 @@ comint-redirect-results-list-from-process
 ;; to `comint-osc-handlers' allows a customized treatment of further
 ;; sequences.
 
-(defvar-local comint-osc-handlers '(("7" . comint-osc-directory-tracker)
-                                    ("8" . comint-osc-hyperlink-handler))
-  "Alist of handlers for OSC escape sequences.
-See `comint-osc-process-output' for details.")
-
-(defvar-local comint-osc--marker nil)
+;; Aliases defined for reverse compatibility
+(defalias 'comint-osc-handlers 'osc-handlers)
+(defalias 'comint-osc-directory-tracker 'osc-directory-tracker)
+(defalias 'comint-osc-hyperlink-handler 'osc-hyperlink-handler)
+(defalias 'comint-osc-hyperlink 'osc-hyperlink)
+(defalias 'comint-osc-hyperlink-map 'osc-hyperlink-map)
 
 (defun comint-osc-process-output (_)
   "Interpret OSC escape sequences in comint output.
@@ -3935,81 +3936,10 @@ comint-osc-process-output
 `comint-osc-handlers' alist, the corresponding value, which
 should be a function, is called with `command' and `text' as
 arguments, with point where the escape sequence was located."
-  (let ((bound (process-mark (get-buffer-process (current-buffer)))))
-    (save-excursion
-      ;; Start one char before last output to catch a possibly stray ESC
-      (goto-char (or comint-osc--marker (1- comint-last-output-start)))
-      (when (eq (char-before) ?\e) (backward-char))
-      (while (re-search-forward "\e]" bound t)
-        (let ((pos0 (match-beginning 0))
-              (code (and (re-search-forward "\\=\\([0-9A-Za-z]*\\);" bound t)
-                         (match-string 1)))
-              (pos1 (point)))
-          (if (re-search-forward "\a\\|\e\\\\" bound t)
-              (let ((text (buffer-substring-no-properties
-                           pos1 (match-beginning 0))))
-                (setq comint-osc--marker nil)
-                (delete-region pos0 (point))
-                (when-let ((fun (cdr (assoc-string code comint-osc-handlers))))
-                  (funcall fun code text)))
-            (put-text-property pos0 bound 'invisible t)
-            (setq comint-osc--marker (copy-marker pos0))))))))
-
-;; Current directory tracking (OSC 7)
-
-(declare-function url-host "url/url-parse.el")
-(declare-function url-type "url/url-parse.el")
-(declare-function url-filename "url/url-parse.el")
-(defun comint-osc-directory-tracker (_ text)
-  "Update `default-directory' from OSC 7 escape sequences.
-
-This function is intended to be included as an entry of
-`comint-osc-handlers'.  You should moreover arrange for your
-shell to print the appropriate escape sequence at each prompt,
-say with the following command:
-
-    printf \"\\e]7;file://%s%s\\e\\\\\" \"$HOSTNAME\" \"$PWD\"
-
-This functionality serves as an alternative to `dirtrack-mode'
-and `shell-dirtrack-mode'."
-  (let ((url (url-generic-parse-url text)))
-    (when (and (string= (url-type url) "file")
-               (or (null (url-host url))
-                   (string= (url-host url) (system-name))))
-      (ignore-errors
-        (cd-absolute (url-unhex-string (url-filename url)))))))
-
-;; Hyperlink handling (OSC 8)
-
-(defvar comint-osc-hyperlink-map
-  (let ((map (make-sparse-keymap)))
-    (define-key map "\C-c\r" 'browse-url-button-open)
-    (define-key map [mouse-2] 'browse-url-button-open)
-    (define-key map [follow-link] 'mouse-face)
-    map)
-  "Keymap used by OSC 8 hyperlink buttons.")
-
-(define-button-type 'comint-osc-hyperlink
-  'keymap comint-osc-hyperlink-map
-  'help-echo (lambda (_ buffer pos)
-               (when-let ((url (get-text-property pos 'browse-url-data buffer)))
-                 (format "mouse-2, C-c RET: Open %s" url))))
-
-(defvar-local comint-osc-hyperlink--state nil)
-
-(defun comint-osc-hyperlink-handler (_ text)
-  "Create a hyperlink from an OSC 8 escape sequence.
-This function is intended to be included as an entry of
-`comint-osc-handlers'."
-  (when comint-osc-hyperlink--state
-    (let ((start (car comint-osc-hyperlink--state))
-          (url (cdr comint-osc-hyperlink--state)))
-      (make-text-button start (point)
-                        'type 'comint-osc-hyperlink
-                        'browse-url-data url)))
-  (setq comint-osc-hyperlink--state
-        (and (string-match ";\\(.+\\)" text)
-             (cons (point-marker) (match-string-no-properties 1 text)))))
+  (let ((start (1- comint-last-output-start))
+        ;; Start one char before last output to catch a possibly stray ESC
+        (bound (process-mark (get-buffer-process (current-buffer)))))
+    (osc-apply-on-region start bound)))
 
 \f
 ;;; Input fontification and indentation through an indirect buffer
diff --git a/lisp/osc.el b/lisp/osc.el
new file mode 100644
index 0000000000..224981a856
--- /dev/null
+++ b/lisp/osc.el
@@ -0,0 +1,127 @@
+;;; osc.el --- Support for OSC escape sequences      -*- lexical-binding: t; -*-
+
+;; Copyright (C) 2022  Free Software Foundation, Inc.
+
+;; Author: Augusto Stoffel <arstoffel@gmail.com>
+;;         Matthias Meulien <orontee@gmail.com>
+;; Maintainer: emacs-devel@gnu.org
+;; Keywords: processes, terminals, services
+
+;; This program is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; This program is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with this program.  If not, see <https://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;; Interpretation of OSC (Operating System Commands) escape
+;; sequences. Handlers for OSC 7 and 8 (for current directory and
+;; hyperlinks respectively) are provided.
+
+;;; Code:
+
+(defvar-local osc-handlers '(("7" . osc-directory-tracker)
+                             ("8" . osc-hyperlink-handler))
+  "Alist of handlers for OSC escape sequences.
+See `osc-apply-on-region' for details.")
+
+(defvar-local osc--marker nil)
+;; The function `osc-apply-on-region' can set `osc--marker' to the start
+;; position of an escape sequence without termination.
+
+(defun osc-apply-on-region (begin end)
+  "Interpret OSC escape sequences in region.
+This function search for escape sequences of the forms
+
+    ESC ] command ; text BEL
+    ESC ] command ; text ESC \\
+
+Every occurrence of such escape sequences is removed from the
+buffer.  Then, if `command' is a key of the local variable
+`osc-handlers' alist, the corresponding value, which should be a
+function, is called with `command' and `text' as arguments, with
+point where the escape sequence was located."
+  (save-excursion
+    (goto-char (or osc--marker begin))
+    (when (eq (char-before) ?\e) (backward-char))
+    (while (re-search-forward "\e]" end t)
+      (let ((pos0 (match-beginning 0))
+            (code (and (re-search-forward "\\=\\([0-9A-Za-z]*\\);" end t)
+                       (match-string 1)))
+            (pos1 (point)))
+        (if (re-search-forward "\a\\|\e\\\\" end t)
+            (let ((text (buffer-substring-no-properties
+                         pos1 (match-beginning 0))))
+              (setq osc--marker nil)
+              (delete-region pos0 (point))
+              (when-let ((fun (cdr (assoc-string code osc-handlers))))
+                (funcall fun code text)))
+          (put-text-property pos0 end 'invisible t)
+          (setq osc--marker (copy-marker pos0)))))))
+
+;; Current directory tracking (OSC 7)
+
+(declare-function url-host "url/url-parse.el")
+(declare-function url-type "url/url-parse.el")
+(declare-function url-filename "url/url-parse.el")
+(defun osc-directory-tracker (_ text)
+  "Update `default-directory' from OSC 7 escape sequences.
+
+This function is intended to be included as an entry of
+`osc-handlers'.  You should moreover arrange for your shell to
+print the appropriate escape sequence at each prompt, say with
+the following command:
+
+    printf \"\\e]7;file://%s%s\\e\\\\\" \"$HOSTNAME\" \"$PWD\"
+
+This functionality serves as an alternative to `dirtrack-mode'
+and `shell-dirtrack-mode'."
+  (let ((url (url-generic-parse-url text)))
+    (when (and (string= (url-type url) "file")
+               (or (null (url-host url))
+                   (string= (url-host url) (system-name))))
+      (ignore-errors
+        (cd-absolute (url-unhex-string (url-filename url)))))))
+
+;; Hyperlink handling (OSC 8)
+
+(defvar osc-hyperlink-map
+  (let ((map (make-sparse-keymap)))
+    (define-key map "\C-c\r" 'browse-url-button-open)
+    (define-key map [mouse-2] 'browse-url-button-open)
+    (define-key map [follow-link] 'mouse-face)
+    map)
+  "Keymap used by OSC 8 hyperlink buttons.")
+
+(define-button-type 'osc-hyperlink
+  'keymap osc-hyperlink-map
+  'help-echo (lambda (_ buffer pos)
+               (when-let ((url (get-text-property pos 'browse-url-data buffer)))
+                 (format "mouse-2, C-c RET: Open %s" url))))
+
+(defvar-local osc-hyperlink--state nil)
+
+(defun osc-hyperlink-handler (_ text)
+  "Create a hyperlink from an OSC 8 escape sequence.
+This function is intended to be included as an entry of
+`osc-handlers'."
+  (when osc-hyperlink--state
+    (let ((start (car osc-hyperlink--state))
+          (url (cdr osc-hyperlink--state)))
+      (make-text-button start (point)
+                        'type 'osc-hyperlink
+                        'browse-url-data url)))
+  (setq osc-hyperlink--state
+        (and (string-match ";\\(.+\\)" text)
+             (cons (point-marker) (match-string-no-properties 1 text)))))
+
+(provide 'osc)
+;;; osc.el ends here
diff --git a/test/lisp/osc-tests.el b/test/lisp/osc-tests.el
new file mode 100644
index 0000000000..d53bab08d3
--- /dev/null
+++ b/test/lisp/osc-tests.el
@@ -0,0 +1,57 @@
+;;; osc-tests.el --- Tests for osc.el  -*- lexical-binding: t; -*-
+
+;; Copyright (C) 2022 Free Software Foundation, Inc.
+
+;; Author: Matthias Meulien <orontee@gmail.com>
+;; Keywords:
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs is free software: you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs.  If not, see <https://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;;
+
+;;; Code:
+
+(require 'osc)
+(require 'ert)
+
+(defvar osc-tests--strings
+  `(
+    ("Hello World" "Hello World")
+
+    ;; window title
+    ("Buffer \e]2;A window title\e\\content" "Buffer content")
+
+    ;; window title
+    ("Unfinished \e]2;window title" "Unfinished \e]2;window title")
+
+    ;; current directory
+    ("\e]7;file://127.0.0.1/tmp\e\\user@host$ " "user@host$ ")
+
+    ;; hyperlink
+    ("\e]8;;http://example.com\e\\This is a link\e]8;;\e\\" "This is a link")
+    ))
+;; Don't output those strings to stdout since they may have
+;; side-effects on the environment
+
+(ert-deftest osc-tests-apply-region-no-handlers ()
+  (let ((osc-handlers nil))
+    (pcase-dolist (`(,input ,text) osc-tests--strings)
+      (with-temp-buffer
+        (insert input)
+        (osc-apply-on-region (point-min) (point-max))
+        (should (equal (buffer-string) text))))))
-- 
2.30.2


[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #3: 0002-Handle-OSC-command-to-set-window-title.patch --]
[-- Type: text/x-diff, Size: 1995 bytes --]

From 5b80b2444b5c27315e39303637ec4356218c400b Mon Sep 17 00:00:00 2001
From: Matthias Meulien <orontee@gmail.com>
Date: Sat, 17 Sep 2022 17:54:24 +0200
Subject: [PATCH 2/3] Handle OSC command to set window title

* lisp/osc.el (osc-handlers): Bind osc-window-title-handler to OSC
command 2.
(osc-window-title): Local variable storing string extracted from OSC
command 2.
(osc-window-title-handler): Copy text from OSC command 2 to
osc-window-title.
---
 lisp/osc.el | 19 ++++++++++++++++---
 1 file changed, 16 insertions(+), 3 deletions(-)

diff --git a/lisp/osc.el b/lisp/osc.el
index 224981a856..619972dab1 100644
--- a/lisp/osc.el
+++ b/lisp/osc.el
@@ -23,12 +23,13 @@
 ;;; Commentary:
 
 ;; Interpretation of OSC (Operating System Commands) escape
-;; sequences. Handlers for OSC 7 and 8 (for current directory and
-;; hyperlinks respectively) are provided.
+;; sequences. Handlers for OSC 2, 7 and 8 (for window title, current
+;; directory and hyperlinks respectively) are provided.
 
 ;;; Code:
 
-(defvar-local osc-handlers '(("7" . osc-directory-tracker)
+(defvar-local osc-handlers '(("2" . osc-window-title-handler)
+                             ("7" . osc-directory-tracker)
                              ("8" . osc-hyperlink-handler))
   "Alist of handlers for OSC escape sequences.
 See `osc-apply-on-region' for details.")
@@ -67,6 +68,18 @@ osc-apply-on-region
           (put-text-property pos0 end 'invisible t)
           (setq osc--marker (copy-marker pos0)))))))
 
+;; Window title handling (OSC 2)
+
+(defvar-local osc-window-title nil)
+(defun osc-window-title-handler (_ text)
+  "Set value of `osc-window-title' from an OSC 2 escape sequence.
+The variable `osc-window-title' can be referred to in
+`frame-title-format' to dynamically set the frame title.
+
+This function is intended to be included as an entry of
+`osc-handlers'."
+  (setq osc-window-title text))
+
 ;; Current directory tracking (OSC 7)
 
 (declare-function url-host "url/url-parse.el")
-- 
2.30.2


[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #4: 0003-OSC-escape-sequences-filter-for-compilation-buffer.patch --]
[-- Type: text/x-diff, Size: 3164 bytes --]

From fc0dd679efc62b72588ab2d7cd0efcd67221e5cf Mon Sep 17 00:00:00 2001
From: Matthias Meulien <orontee@gmail.com>
Date: Sat, 17 Sep 2022 18:59:31 +0200
Subject: [PATCH 3/3] OSC escape sequences filter for compilation buffer

* lisp/osc.el (osc-control-seq-regexp): Regexp matching OSC control sequence.
(osc-filter-region): Filter out OSC control sequences from region.
(osc-for-compilation-buffer): Determines what to do with OSC escape
sequences in compilation output.
(osc-compilation-filter): Implement OSC escape sequence handling for
compilation output.
---
 lisp/osc.el | 48 ++++++++++++++++++++++++++++++++++++++++++++++++
 1 file changed, 48 insertions(+)

diff --git a/lisp/osc.el b/lisp/osc.el
index 619972dab1..89467bc4cf 100644
--- a/lisp/osc.el
+++ b/lisp/osc.el
@@ -26,8 +26,26 @@
 ;; sequences. Handlers for OSC 2, 7 and 8 (for window title, current
 ;; directory and hyperlinks respectively) are provided.
 
+;; The function `osc-compilation-filter' can be added to
+;; `compilation-filter-hook' to collect OSC sequences in compilation
+;; buffers. The variable `osc-for-compilation-buffer' tells what to do
+;; with collected sequences.
+
 ;;; Code:
 
+(defconst osc-control-seq-regexp
+  ;; See ECMA 48, section 8.3.89 "OSC - OPERATING SYSTEM COMMAND".
+  "\e\\][\x08-\x0D]*[\x20-\x7E]*\\(\a\\|\e\\\\\\)"
+  "Regexp matching an OSC control sequence.")
+
+(defun osc-filter-region (begin end)
+  "Filter out all OSC control sequences from region BEGIN to END."
+  (save-excursion
+    (goto-char begin)
+    ;; Delete escape sequences.
+    (while (re-search-forward osc-control-seq-regexp end t)
+      (delete-region (match-beginning 0) (match-end 0)))))
+
 (defvar-local osc-handlers '(("2" . osc-window-title-handler)
                              ("7" . osc-directory-tracker)
                              ("8" . osc-hyperlink-handler))
@@ -136,5 +154,35 @@ osc-hyperlink-handler
         (and (string-match ";\\(.+\\)" text)
              (cons (point-marker) (match-string-no-properties 1 text)))))
 
+(defcustom osc-for-compilation-buffer 'filter
+  "Determines what to do of OSC escape sequences in compilation output.
+If nil, do nothing.
+
+If the symbol `filter', then filter out all OSC control sequences.
+
+If anything else (such as t), then collect OSC control sequences
+and call appropriate handler as described in `osc-handlers'.
+
+In order for this to have any effect, `osc-compilation-filter'
+must be in `compilation-filter-hook'."
+  :type '(choice (const :tag "Do nothing" nil)
+                 (const :tag "Filter" filter)
+                 (other :tag "Translate" t))
+  :group 'osc
+  :version "29.0")
+
+;;;###autoload
+(defun osc-compilation-filter ()
+  "Maybe collect OSC control sequences.
+This function depends on the `osc-for-compilation-buffer'
+variable, and is meant to be used in `compilation-filter-hook'."
+  (let ((inhibit-read-only t))
+    (pcase osc-for-compilation-buffer
+      ('nil nil)
+      ('filter
+       (osc-filter-region compilation-filter-start (point)))
+      (_
+       (osc-apply-on-region compilation-filter-start (point))))))
+
 (provide 'osc)
 ;;; osc.el ends here
-- 
2.30.2


[-- Attachment #5: Type: text/plain, Size: 17 bytes --]





-- 
Matthias