From: miha--- via "Bug reports for GNU Emacs, the Swiss army knife of text editors" <bug-gnu-emacs@gnu.org>
To: 58518@debbugs.gnu.org
Subject: bug#58518: 29.0.50; [PATCH] Turning off compilation-minor-mode removes fontification of other modes
Date: Fri, 14 Oct 2022 17:15:24 +0200 [thread overview]
Message-ID: <87pmeue8s3.fsf@miha-pc> (raw)
[-- 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 --]
next reply other threads:[~2022-10-14 15:15 UTC|newest]
Thread overview: 4+ messages / expand[flat|nested] mbox.gz Atom feed top
2022-10-14 15:15 miha--- via Bug reports for GNU Emacs, the Swiss army knife of text editors [this message]
2022-10-15 10:25 ` bug#58518: 29.0.50; [PATCH] Turning off compilation-minor-mode removes fontification of other modes Lars Ingebrigtsen
2022-10-15 14:45 ` Stefan Monnier via Bug reports for GNU Emacs, the Swiss army knife of text editors
2022-10-16 8:24 ` Lars Ingebrigtsen
Reply instructions:
You may reply publicly to this message via plain-text email
using any one of the following methods:
* Save the following mbox file, import it into your mail client,
and reply-to-all from there: mbox
Avoid top-posting and favor interleaved quoting:
https://en.wikipedia.org/wiki/Posting_style#Interleaved_style
List information: https://www.gnu.org/software/emacs/
* Reply using the --to, --cc, and --in-reply-to
switches of git-send-email(1):
git send-email \
--in-reply-to=87pmeue8s3.fsf@miha-pc \
--to=bug-gnu-emacs@gnu.org \
--cc=58518@debbugs.gnu.org \
--cc=miha@kamnitnik.top \
/path/to/YOUR_REPLY
https://kernel.org/pub/software/scm/git/docs/git-send-email.html
* If your mail client supports setting the In-Reply-To header
via mailto: links, try the mailto: link
Be sure your reply has a Subject: header at the top and a blank line
before the message body.
Code repositories for project(s) associated with this public inbox
https://git.savannah.gnu.org/cgit/emacs.git
This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).