The attached patch seems to fix the issue.
Can anyone test?
Best,
Ihor
>From 7a5bfe2f514af1f6af48652155732dbcb9fe22d0 Mon Sep 17 00:00:00 2001
From: Ihor Radchenko <yanta...@gmail.com>
Date: Thu, 17 Sep 2020 16:14:11 +0800
Subject: [PATCH] Make sure that headline faces take precedence
* lisp/org.el (org-activate-links): Prepend instead of overriding
existing face.
(org-set-font-lock-defaults): Prepend keyword, `org-headline-todo', and
`org-headline-done' faces instead of overriding.
(org-font-lock-add-priority-faces): Prepend priority face instead of
overriding.
(org-font-lock-add-tag-faces): Prepend tag faces instead of
overriding.
Fix bug when org-level-N headline face is overridden while fontifying
smaller elements within headline. Prepend the element faces instead.
---
lisp/org.el | 62 ++++++++++++++++++++++++++++++-----------------------
1 file changed, 35 insertions(+), 27 deletions(-)
diff --git a/lisp/org.el b/lisp/org.el
index bc74cedc7..69040a540 100644
--- a/lisp/org.el
+++ b/lisp/org.el
@@ -5142,30 +5142,31 @@ This includes angle, plain, and bracket links."
(link (org-element-property :raw-link link-object))
(type (org-element-property :type link-object))
(path (org-element-property :path link-object))
+ (face-property (pcase (org-link-get-parameter type :face)
+ ((and (pred functionp) face) (funcall face path))
+ ((and (pred facep) face) face)
+ ((and (pred consp) face) face) ;anonymous
+ (_ 'org-link)))
(properties ;for link's visible part
- (list
- 'face (pcase (org-link-get-parameter type :face)
- ((and (pred functionp) face) (funcall face path))
- ((and (pred facep) face) face)
- ((and (pred consp) face) face) ;anonymous
- (_ 'org-link))
- 'mouse-face (or (org-link-get-parameter type :mouse-face)
- 'highlight)
- 'keymap (or (org-link-get-parameter type :keymap)
- org-mouse-map)
- 'help-echo (pcase (org-link-get-parameter type :help-echo)
- ((and (pred stringp) echo) echo)
- ((and (pred functionp) echo) echo)
- (_ (concat "LINK: " link)))
- 'htmlize-link (pcase (org-link-get-parameter type
- :htmlize-link)
- ((and (pred functionp) f) (funcall f))
- (_ `(:uri ,link)))
- 'font-lock-multiline t)))
+ (list 'mouse-face (or (org-link-get-parameter type :mouse-face)
+ 'highlight)
+ 'keymap (or (org-link-get-parameter type :keymap)
+ org-mouse-map)
+ 'help-echo (pcase (org-link-get-parameter type :help-echo)
+ ((and (pred stringp) echo) echo)
+ ((and (pred functionp) echo) echo)
+ (_ (concat "LINK: " link)))
+ 'htmlize-link (pcase (org-link-get-parameter type
+ :htmlize-link)
+ ((and (pred functionp) f) (funcall f))
+ (_ `(:uri ,link)))
+ 'font-lock-multiline t)))
(org-remove-flyspell-overlays-in start end)
(org-rear-nonsticky-at end)
(if (not (eq 'bracket style))
- (add-text-properties start end properties)
+ (progn
+ (add-face-text-property start end face-property)
+ (add-text-properties start end properties))
;; Handle invisible parts in bracket links.
(remove-text-properties start end '(invisible nil))
(let ((hidden
@@ -5174,6 +5175,7 @@ This includes angle, plain, and bracket links."
'org-link))
properties)))
(add-text-properties start visible-start hidden)
+ (add-face-text-property visible-start visible-end face-property)
(add-text-properties visible-start visible-end properties)
(add-text-properties visible-end end hidden)
(org-rear-nonsticky-at visible-start)
@@ -5641,7 +5643,7 @@ needs to be inserted at a specific position in the font-lock sequence.")
;; TODO keyword
(list (format org-heading-keyword-regexp-format
org-todo-regexp)
- '(2 (org-get-todo-face 2) t))
+ '(2 (org-get-todo-face 2) prepend))
;; TODO
(when org-fontify-todo-headline
(list (format org-heading-keyword-regexp-format
@@ -5649,7 +5651,7 @@ needs to be inserted at a specific position in the font-lock sequence.")
"\\(?:"
(mapconcat 'regexp-quote org-not-done-keywords "\\|")
"\\)"))
- '(2 'org-headline-todo t)))
+ '(2 'org-headline-todo prepend)))
;; DONE
(when org-fontify-done-headline
(list (format org-heading-keyword-regexp-format
@@ -5657,7 +5659,7 @@ needs to be inserted at a specific position in the font-lock sequence.")
"\\(?:"
(mapconcat 'regexp-quote org-done-keywords "\\|")
"\\)"))
- '(2 'org-headline-done t)))
+ '(2 'org-headline-done prepend)))
;; Priorities
'(org-font-lock-add-priority-faces)
;; Tags
@@ -5841,18 +5843,24 @@ If TAG is a number, get the corresponding match group."
(defun org-font-lock-add-priority-faces (limit)
"Add the special priority faces."
(while (re-search-forward org-priority-regexp limit t)
+ (add-face-text-property
+ (match-beginning 1)
+ (match-end 1)
+ (org-get-priority-face (string-to-char (match-string 2))))
(add-text-properties
(match-beginning 1) (match-end 1)
- (list 'face (org-get-priority-face (string-to-char (match-string 2)))
- 'font-lock-fontified t))))
+ (list 'font-lock-fontified t))))
(defun org-font-lock-add-tag-faces (limit)
"Add the special tag faces."
(when (and org-tag-faces org-tags-special-faces-re)
(while (re-search-forward org-tags-special-faces-re limit t)
+ (add-face-text-property
+ (match-beginning 1)
+ (match-end 1)
+ (org-get-tag-face 1))
(add-text-properties (match-beginning 1) (match-end 1)
- (list 'face (org-get-tag-face 1)
- 'font-lock-fontified t))
+ (list 'font-lock-fontified t))
(backward-char 1))))
(defun org-unfontify-region (beg end &optional _maybe_loudly)
--
2.26.2
Protesilaos Stavrou <i...@protesilaos.com> writes:
> Bastien <b...@gnu.org> [2020-09-09, 10:49 +0200]:
>
>> Protesilaos Stavrou <i...@protesilaos.com> writes:
>>
>>> Diego Zamboni <di...@zzamboni.org> [2020-09-05, 23:39 +0200]:
>>>
>>>> I had seen the same in my setup. I recently started using Doom Emacs
>>>> (https://github.com/hlissner/doom-emacs/) and was pleasantly surprised
>>>> to discover that todo and tag faces scale according to the headline in
>>>> which they are. I don't know precisely how this is done, but there are
>>>> some hints here, you might use it as a starting point:
>>>> https://github.com/hlissner/doom-emacs/blob/develop/modules/lang/org/config.el#L146-L175
>>>
>>> I noticed that the doom-themes have some extra code to fontify Org.[0]
>>> It also has some opinionated extras that do not belong to the issue I
>>> raised. I am curious whether this was ever shared/discussed on this
>>> mailing list.
>>
>> I can't remember any such discussion.
>>
>> (In general, it would be good if downstream enhancements like these
>> could be shared upstream, we are generally quite grateful for help!)
>>
>> In any case, thanks for reporting this issue, I confirm we should
>> work on it for a future release.
>>
>> Patches welcome,
>
> Hello again!
>
> I am not sure I can help with the patch, but at least I can share some
> more user feedback.
>
> Please see the attached screenshots that could help improve our
> understanding of the issue. The gist is that Org already has working
> code that adapts some faces to the underlying heading style (in this
> case font height and weight).
>
> To reproduce this demo on emacs -Q:
>
> + Open an org-mode file, e.g. C-x C-f /tmp/test.org
> + Insert a level 1 heading:
>
> * TODO [#A] Do they adapt ~test-heading-faces~ and =another-test=?
>
> + Evaluate each of the expressions in the code block and notice how the
> heading's faces adapt to it:
>
> #+begin_src emacs-lisp
> (set-face-attribute 'org-level-1 nil :height 3.0 :weight 'normal)
> (set-face-attribute 'org-level-1 nil :weight 'bold)
> #+end_src
>
> This is in addition to what I noted in a previous message:
> https://lists.gnu.org/archive/html/emacs-orgmode/2020-09/msg00331.html
>
> Best regards,
> Protesilaos
>
> --
> Protesilaos Stavrou
> protesilaos.com
