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