bug#58518: 29.0.50; [PATCH] Turning off compilation-minor-mode removes fontification of other modes

bug#58518: 29.0.50; [PATCH] Turning off compilation-minor-mode removes fontification of other modes

[miha--- via Bug reports for GNU Emacs, the Swiss army knife of text editors]

[-- Attachment #1.1: Type: text/plain, Size: 934 bytes --]

I propose the attached patch, which fixes the following problem:

1. M-x shell
2. grep -R -n --color=always 'some-search-string-which-yeilds-resuts'
   File names and line numbers output by grep should be in color
3. M-x compilation-shell-minor-mode
   File names and line numbers are now underlined by compile.el
4. M-x compilation-shell-minor-mode, to turn it back off

File names and line numbers lose their fontification completely, that
is, they are now in the default face.

The attached patch makes them return to the face they had after step 2,
as specified by the grep command. It also "name-spaces" other text
properties used by compile.el, such as keymap and mouse-face. If other
minor or major modes make use of these text properties, turning off
compilation-shell-minor-mode or compilation-minor-mode should now leave
them alone. (Though the ones from compile.el take precedence as long as
compilation-*-mode is active.)

[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #1.2: 0001-compile-Don-t-clobber-text-properties-of-other-modes.patch --]
[-- Type: text/x-patch, Size: 10111 bytes --]

From 0b60dc0bfbe22dd8c570fab25b6ae1087da76022 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Miha=20Rihtar=C5=A1i=C4=8D?= <miha@kamnitnik.top>
Date: Fri, 14 Oct 2022 14:58:44 +0200
Subject: [PATCH] compile.el: Don't clobber text properties of other modes

* lisp/progmodes/compile.el (compilation-mode-font-lock-keywords):
(compilation-directory-properties):
(compilation-internal-error-properties):
(compilation-parse-errors):
(compilation--remove-properties): Don't modify 'font-lock-face' and
other public text properties directly.  Modify the private
'compilation-face' property instead.

(compilation-setup): Set up 'compilation-face' text property up as an
alias to the 'font-lock-face', and similarly for the other private
compilation text properties.

(compilation--unsetup): Remove the text property aliases.
---
 lisp/progmodes/compile.el | 90 ++++++++++++++++++---------------------
 1 file changed, 42 insertions(+), 48 deletions(-)

diff --git a/lisp/progmodes/compile.el b/lisp/progmodes/compile.el
index 6473b50778..c543d40d64 100644
--- a/lisp/progmodes/compile.el
+++ b/lisp/progmodes/compile.el
@@ -762,10 +762,10 @@ compilation-mode-font-lock-keywords
       (1 font-lock-function-name-face) (3 compilation-line-face nil t))
      (" --?o\\(?:utfile\\|utput\\)?[= ]\\(\\S +\\)" . 1)
      ("^Compilation \\(finished\\).*"
-      (0 '(face nil compilation-message nil help-echo nil mouse-face nil) t)
+      (0 '(face nil compilation-message nil compilation-help-echo nil compilation-mouse-face nil) t)
       (1 compilation-info-face))
      ("^Compilation \\(exited abnormally\\|interrupt\\|killed\\|terminated\\|segmentation fault\\)\\(?:.*with code \\([0-9]+\\)\\)?.*"
-      (0 '(face nil compilation-message nil help-echo nil mouse-face nil) t)
+      (0 '(face nil compilation-message nil compilation-help-echo nil compilation-mouse-face nil) t)
       (1 compilation-error-face)
       (2 compilation-error-face nil t)))
    "Additional things to highlight in Compilation mode.
@@ -1185,9 +1185,9 @@ compilation-directory-properties
   (let ((dir (compilation--previous-directory (match-beginning 0))))
     (setq dir (if dir (or (get-text-property (1- dir) 'compilation-directory)
 			  (get-text-property dir 'compilation-directory))))
-    `(font-lock-face ,(if leave
-                          compilation-leave-directory-face
-                        compilation-enter-directory-face)
+    `(compilation-face ,(if leave
+                            compilation-leave-directory-face
+                          compilation-enter-directory-face)
       compilation-directory ,(if leave
                                  (or (cdr dir)
                                      '(nil)) ; nil only isn't a property-change
@@ -1195,9 +1195,9 @@ compilation-directory-properties
       ;; Place a `compilation-message' everywhere we change text-properties
       ;; so compilation--remove-properties can know what to remove.
       compilation-message ,(compilation--make-message nil 0 nil nil)
-      mouse-face highlight
-      keymap compilation-button-map
-      help-echo "mouse-2: visit destination directory")))
+      compilation-mouse-face highlight
+      compilation-keymap compilation-button-map
+      compilation-help-echo "mouse-2: visit destination directory")))
 
 ;; Data type `reverse-ordered-alist' retriever.  This function retrieves the
 ;; KEY element from the ALIST, creating it in the right position if not already
@@ -1467,15 +1467,15 @@ compilation-internal-error-properties
                                               end-marker))))
 
     ;; Must start with face
-    `(font-lock-face ,compilation-message-face
+    `(compilation-face ,compilation-message-face
       compilation-message ,(compilation--make-message loc type end-loc rule)
-      help-echo ,(if col
-                     "mouse-2: visit this file, line and column"
-                   (if line
-                       "mouse-2: visit this file and line"
-                     "mouse-2: visit this file"))
-      keymap compilation-button-map
-      mouse-face highlight)))
+      compilation-help-echo ,(if col
+                                 "mouse-2: visit this file, line and column"
+                               (if line
+                                   "mouse-2: visit this file and line"
+                                 "mouse-2: visit this file"))
+      compilation-keymap compilation-button-map
+      compilation-mouse-face highlight)))
 
 (defun compilation--put-prop (matchnum prop val)
   (when (and (integerp matchnum) (match-beginning matchnum))
@@ -1485,30 +1485,11 @@ compilation--put-prop
 
 (defun compilation--remove-properties (&optional start end)
   (with-silent-modifications
-    ;; When compile.el used font-lock directly, we could just remove all
-    ;; our text-properties in one go, but now that we manually place
-    ;; font-lock-face, we have to be careful to only remove the font-lock-face
-    ;; we placed.
-    ;; (remove-list-of-text-properties
-    ;;  (or start (point-min)) (or end (point-max))
-    ;;  '(compilation-debug compilation-directory compilation-message
-    ;;    font-lock-face help-echo mouse-face))
-    (let (next)
-      (unless start (setq start (point-min)))
-      (unless end (setq end (point-max)))
-      (compilation--flush-directory-cache start end)
-      (while
-          (progn
-            (setq next (or (next-single-property-change
-                            start 'compilation-message nil end)
-                           end))
-            (when (get-text-property start 'compilation-message)
-              (remove-list-of-text-properties
-               start next
-               '(compilation-debug compilation-directory compilation-message
-                 font-lock-face help-echo mouse-face)))
-            (< next end))
-        (setq start next)))))
+    (remove-list-of-text-properties
+     (or start (point-min)) (or end (point-max))
+     '( compilation-debug compilation-directory compilation-message
+        compilation-face compilation-help-echo compilation-keymap
+        compilation-mouse-face))))
 
 (defun compilation--parse-region (start end)
   (goto-char end)
@@ -1609,21 +1590,21 @@ compilation-parse-errors
                 (compilation--note-type this-type)
 
                 (compilation--put-prop
-                 file 'font-lock-face
+                 file 'compilation-face
                  (symbol-value (aref [compilation-info-face
                                       compilation-warning-face
                                       compilation-error-face]
                                      this-type)))))
 
             (compilation--put-prop
-             line 'font-lock-face compilation-line-face)
+             line 'compilation-face compilation-line-face)
             (compilation--put-prop
-             end-line 'font-lock-face compilation-line-face)
+             end-line 'compilation-face compilation-line-face)
 
             (compilation--put-prop
-             col 'font-lock-face compilation-column-face)
+             col 'compilation-face compilation-column-face)
             (compilation--put-prop
-             end-col 'font-lock-face compilation-column-face)
+             end-col 'compilation-face compilation-column-face)
 
             ;; Obey HIGHLIGHT.
             (dolist (extra-item (nthcdr 6 item))
@@ -1635,12 +1616,12 @@ compilation-parse-errors
                      ((or (symbolp face) (stringp face))
                       (put-text-property
                        (match-beginning mn) (match-end mn)
-                       'font-lock-face face))
+                       'compilation-face face))
 		     ((and (listp face)
 			   (eq (car face) 'face)
 			   (or (symbolp (cadr face))
 			       (stringp (cadr face))))
-                      (compilation--put-prop mn 'font-lock-face (cadr face))
+                      (compilation--put-prop mn 'compilation-face (cadr face))
                       (add-text-properties
                        (match-beginning mn) (match-end mn)
                        (nthcdr 2 face)))
@@ -1657,7 +1638,7 @@ compilation-parse-errors
                (cddr props))
               (font-lock-append-text-property
                (match-beginning mn) (match-end mn)
-               'font-lock-face (cadr props)))))))))
+               'compilation-face (cadr props)))))))))
 
 (defvar-local compilation--parsed -1)
 
@@ -2385,6 +2366,13 @@ compilation-setup
   (add-hook 'before-change-functions #'compilation--flush-parse nil t)
   ;; Also for minor mode, since it's not permanent-local.
   (add-hook 'change-major-mode-hook #'compilation--remove-properties nil t)
+
+  (let ((alist (copy-alist char-property-alias-alist)))
+    (cl-pushnew 'compilation-face (alist-get 'face alist))
+    (cl-pushnew 'compilation-mouse-face (alist-get 'mouse-face alist))
+    (cl-pushnew 'compilation-help-echo (alist-get 'help-echo alist))
+    (cl-pushnew 'compilation-keymap (alist-get 'keymap alist))
+    (setq-local char-property-alias-alist alist))
   (if minor
       (progn
 	(font-lock-add-keywords nil (compilation-mode-font-lock-keywords))
@@ -2394,6 +2382,12 @@ compilation-setup
 (defun compilation--unsetup ()
   ;; Only for minor mode.
   (font-lock-remove-keywords nil (compilation-mode-font-lock-keywords))
+  (let ((alist (copy-alist char-property-alias-alist)))
+    (when-let ((as (assq 'face alist))) (delq 'compilation-face as))
+    (when-let ((as (assq 'mouse-face alist))) (delq 'compilation-mose-face as))
+    (when-let ((as (assq 'help-echo alist))) (delq 'compilation-help-echo as))
+    (when-let ((as (assq 'keymap alist))) (delq 'compilation-keymap as))
+    (setq-local char-property-alias-alist alist))
   (remove-hook 'before-change-functions #'compilation--flush-parse t)
   (kill-local-variable 'compilation--parsed)
   (compilation--remove-properties)
-- 
2.38.0


[-- Attachment #2: signature.asc --]
[-- Type: application/pgp-signature, Size: 861 bytes --]

bug#58518: 29.0.50; [PATCH] Turning off compilation-minor-mode removes fontification of other modes

[Lars Ingebrigtsen]

miha@kamnitnik.top writes:

> The attached patch makes them return to the face they had after step 2,
> as specified by the grep command.
[...]

> -    `(font-lock-face ,(if leave
> -                          compilation-leave-directory-face
> -                        compilation-enter-directory-face)
> +    `(compilation-face ,(if leave
> +                            compilation-leave-directory-face

[...]

> +  (let ((alist (copy-alist char-property-alias-alist)))
> +    (cl-pushnew 'compilation-face (alist-get 'face alist))

Hm, it's an interesting approach -- we don't use this trick elsewhere in
other mode (I mean, except for `font-lock-face'), but this seems like a
good solution.

But since it's so unusual, I wonder whether there's any reason we don't
use this more in general.  Are there performance impacts, for instance?
(I don't think so, since it's a buffer-local variable.)  But I've added
Stefan and Eli to the CCs; perhaps they have comments.

bug#58518: 29.0.50; [PATCH] Turning off compilation-minor-mode removes fontification of other modes

[Stefan Monnier via Bug reports for GNU Emacs, the Swiss army knife of text editors]

> But since it's so unusual, I wonder whether there's any reason we don't
> use this more in general.  Are there performance impacts, for instance?
> (I don't think so, since it's a buffer-local variable.)  But I've added
> Stefan and Eli to the CCs; perhaps they have comments.

I can't remember anyone measuring the performance impact, but it does
come at a cost since every time we call `lookup_char_property` it takes
significantly more work.

This is called at every text-property (or overlay) boundary in things
like `next-single-property-change` and similar operations used by the
redisplay.

The "more work" is the `assq` itself whose time is proportional to the
length of this alist, plus a `plist-get` per alias listed, whenever
the `assq` finds a match (i.e. whenever we're looking for a property
which has aliases).

FWIW, in the past I suggested maybe we should introduce a notion of
"property planes".  So `compilation` could use one property plane,
`font-lock` could use another and they could just blindly remove all the
properties in their plane without affecting others.

The idea is similar to using the approach suggested by "miha", except
that the intention is to implement the hard work of merging the planes
in the code that adds/removes properties rather than in the code which
looks it up (and it would probably only apply to text properties, not to
overlays).
The idea of doing it when adding/removing properties is:
- Should keep the important lookup path used during redisplay fast.
- Should make it possible to run ELisp while merging, thus allowing
  "smart" merging (e.g. concatenating faces, or composing keymaps)
  rather than only choosing the value with highest priority and ignoring
  all the others.

BTW, another option is to use overlays rather than
text-properties :-)


        Stefan

bug#58518: 29.0.50; [PATCH] Turning off compilation-minor-mode removes fontification of other modes

[Lars Ingebrigtsen]

Stefan Monnier <monnier@iro.umontreal.ca> writes:

> I can't remember anyone measuring the performance impact, but it does
> come at a cost since every time we call `lookup_char_property` it takes
> significantly more work.
>
> This is called at every text-property (or overlay) boundary in things
> like `next-single-property-change` and similar operations used by the
> redisplay.
>
> The "more work" is the `assq` itself whose time is proportional to the
> length of this alist, plus a `plist-get` per alias listed, whenever
> the `assq` finds a match (i.e. whenever we're looking for a property
> which has aliases).

But this would be for the *compilation* buffer only, so perhaps that's
fine...

> FWIW, in the past I suggested maybe we should introduce a notion of
> "property planes".  So `compilation` could use one property plane,
> `font-lock` could use another and they could just blindly remove all the
> properties in their plane without affecting others.

Yes, it's implementing planes, only manually.  Having real planes would
be great.

> BTW, another option is to use overlays rather than
> text-properties :-)

I'd rather not -- things are confusing enough in this area already.