From: Ihor Radchenko <yantar92@gmail.com>
To: William Xu <william.xwl@gmail.com>
Cc: emacs-orgmode@gnu.org
Subject: Re: prettify-symbols-mode in org agenda?
Date: Fri, 02 Jul 2021 22:11:07 +0800 [thread overview]
Message-ID: <87v95slsas.fsf@localhost> (raw)
In-Reply-To: <m2a6nhdb7v.fsf@gmail.com>
[-- Attachment #1: Type: text/plain, Size: 489 bytes --]
William Xu <william.xwl@gmail.com> writes:
> I need to make below additional change, otherwise it works perfectly.
Incorporated in the attached final version of the patch.
> Looking at the changes, I see you changed below `concat' call to
> `format'. Is this in the end some bug in the `concat' implementation?
It is complex. I am not sure if it is a bug or just some obscure
implementation detail. See Emacs bug#48740
https://debbugs.gnu.org/cgi/bugreport.cgi?bug=48740
Best,
Ihor
[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: 0001-Make-sure-that-fontification-is-preserved-in-agenda.patch --]
[-- Type: text/x-diff, Size: 28348 bytes --]
From 3f3b2780e5dea3a04eee869a46bf4662103b8143 Mon Sep 17 00:00:00 2001
Message-Id: <3f3b2780e5dea3a04eee869a46bf4662103b8143.1625234837.git.yantar92@gmail.com>
From: Ihor Radchenko <yantar92@gmail.com>
Date: Tue, 22 Jun 2021 23:38:29 +0800
Subject: [PATCH] Make sure that fontification is preserved in agenda
* lisp/org-macs.el (org-string-width): Refactor old code and add
optional argument to return pixel width. The old code used manual
parsing of text properties to find which parts of string are visible.
The new code defers this work to Emacs display engine via
`window-text-pixel-size'. The visibility settings of current buffer
are taken into account.
(org--string-from-props): Removed. It was only used by old
`org-string-width' code.
(org-buffer-substring-fontified): New function. Like
`buffer-substring', but make sure that the substring is fontified.
(org-looking-at-fontified): New function. Like `looking-at', but make
sure that the match is fontified.
* lisp/org.el (org-get-heading): Make sure that heading is fontified.
(org--get-local-tags, org-get-tags, org-scan-tags): Add optional
argument `fontified'. When non-nil, the returned tags are fontified.
* lisp/org-agenda.el (org-agenda-get-todos, org-agenda-get-progress,
org-agenda-get-deadlines, org-agenda-get-scheduled,
org-agenda-fix-displayed-tags, org-search-view, org-agenda-get-todos,
org-agenda-get-timestamps, org-agenda-get-sexps,
org-agenda-get-deadlines, org-agenda-get-progress,
org-agenda-get-blocks, org-tags-view, org-agenda-list, org-todo-list,
org-agenda-highlight-todo): Make sure that fontification is the same
with original Org buffers. All the buffer-substring and match-data
queries are changed to ensure that region of interest is fontified.
Also, preserve composition properties, used i.e. by
`prettify-symbols-mode'. The composition is usually set to be removed
on text change, so we do the changes inside
`with-silent-modifications'.
(org-agenda-align-tags): Use pixel width and (space . :align-to)
'display property to align tags in agenda.
(org-agenda-highlight-todo): Use `format' instead of `concat' to
update the headline in agenda. `concat' may sometimes copy
composition property (see the C code) breaking the composed regions in
agenda view. See Emacs bug#48740 for more details.
Preserve fontification and composition of headlines and tags in
agenda. If the headlines/tags are not yet fontified when building
agenda, make sure that they are fontified in the original Org mode
buffers first.
In addition, tags alignment is now done pixel-wise to avoid alignment
issues with variable-pitch symbols that may appear in fontified Org
mode buffers. The alignment is utilising :align-to specification,
which means that the alignment will be automatically updated as the
agenda buffer is resized.
---
lisp/org-agenda.el | 146 +++++++++++++++++++++++++++------------------
lisp/org-macs.el | 134 +++++++++++++++++++++--------------------
lisp/org.el | 36 +++++++----
3 files changed, 181 insertions(+), 135 deletions(-)
diff --git a/lisp/org-agenda.el b/lisp/org-agenda.el
index 44acd035a..3dff2b926 100644
--- a/lisp/org-agenda.el
+++ b/lisp/org-agenda.el
@@ -3984,7 +3984,7 @@ (defun org-agenda-finalize ()
(put-text-property (point-at-bol) (point-at-eol)
'tags
(org-with-point-at mrk
- (org-get-tags))))))))
+ (org-get-tags nil nil t))))))))
(setq org-agenda-represented-tags nil
org-agenda-represented-categories nil)
(when org-agenda-top-headline-filter
@@ -4444,9 +4444,12 @@ (defun org-agenda-list (&optional arg start-day span with-hour)
(put-text-property s (1- (point)) 'org-today t))
(setq rtnall
(org-agenda-add-time-grid-maybe rtnall ndays todayp))
- (when rtnall (insert ;; all entries
- (org-agenda-finalize-entries rtnall 'agenda)
- "\n"))
+ (with-silent-modifications
+ ;; Composition property in entries may be self-destructed
+ ;; on change. Suppress the self-destruction.
+ (when rtnall (insert ;; all entries
+ (org-agenda-finalize-entries rtnall 'agenda)
+ "\n")))
(put-text-property s (1- (point)) 'day d)
(put-text-property s (1- (point)) 'org-day-cnt day-cnt)))
(when (and org-agenda-clockreport-mode clocktable-start)
@@ -4778,10 +4781,11 @@ (defun org-search-view (&optional todo-only string edit-at)
(and (eq org-agenda-show-inherited-tags t)
(or (eq org-agenda-use-tag-inheritance t)
(memq 'todo org-agenda-use-tag-inheritance))))
- tags (org-get-tags nil (not inherited-tags))
+ tags (org-get-tags
+ nil (not inherited-tags) t)
txt (org-agenda-format-item
""
- (buffer-substring-no-properties
+ (org-buffer-substring-fontified
beg1 (point-at-eol))
level category tags t))
(org-add-props txt props
@@ -4815,8 +4819,11 @@ (defun org-search-view (&optional todo-only string edit-at)
(list 'face 'org-agenda-structure)))
(buffer-string)))
(org-agenda-mark-header-line (point-min))
- (when rtnall
- (insert (org-agenda-finalize-entries rtnall 'search) "\n"))
+ (with-silent-modifications
+ ;; Composition property in entries may be self-destructed
+ ;; on change. Suppress the self-destruction.
+ (when rtnall
+ (insert (org-agenda-finalize-entries rtnall 'search) "\n")))
(goto-char (point-min))
(or org-agenda-multi (org-agenda-fit-window-to-buffer))
(add-text-properties (point-min) (point-max)
@@ -4924,8 +4931,11 @@ (defun org-todo-list (&optional arg)
(add-text-properties pos (1- (point)) (list 'face 'org-agenda-structure))
(buffer-string)))
(org-agenda-mark-header-line (point-min))
- (when rtnall
- (insert (org-agenda-finalize-entries rtnall 'todo) "\n"))
+ (with-silent-modifications
+ ;; Composition property in entries may be self-destructed
+ ;; on change. Suppress the self-destruction.
+ (when rtnall
+ (insert (org-agenda-finalize-entries rtnall 'todo) "\n")))
(goto-char (point-min))
(or org-agenda-multi (org-agenda-fit-window-to-buffer))
(add-text-properties (point-min) (point-max)
@@ -5001,7 +5011,9 @@ (defun org-tags-view (&optional todo-only match)
(widen))
(setq rtn (org-scan-tags 'agenda
matcher
- org--matcher-tags-todo-only))
+ org--matcher-tags-todo-only
+ nil
+ 'fontify))
(setq rtnall (append rtnall rtn))))))))
(org-agenda--insert-overriding-header
(with-temp-buffer
@@ -5023,8 +5035,11 @@ (defun org-tags-view (&optional todo-only match)
(list 'face 'org-agenda-structure))
(buffer-string)))
(org-agenda-mark-header-line (point-min))
- (when rtnall
- (insert (org-agenda-finalize-entries rtnall 'tags) "\n"))
+ (with-silent-modifications
+ ;; Composition property in entries may be self-destructed
+ ;; on change. Suppress the self-destruction.
+ (when rtnall
+ (insert (org-agenda-finalize-entries rtnall 'tags) "\n")))
(goto-char (point-min))
(or org-agenda-multi (org-agenda-fit-window-to-buffer))
(add-text-properties
@@ -5562,7 +5577,8 @@ (defun org-agenda-get-todos ()
ts-date-pair (org-agenda-entry-get-agenda-timestamp (point))
ts-date (car ts-date-pair)
ts-date-type (cdr ts-date-pair)
- txt (org-trim (buffer-substring (match-beginning 2) (match-end 0)))
+ txt (org-trim (org-buffer-substring-fontified
+ (match-beginning 2) (match-end 0)))
inherited-tags
(or (eq org-agenda-show-inherited-tags 'always)
(and (listp org-agenda-show-inherited-tags)
@@ -5570,7 +5586,7 @@ (defun org-agenda-get-todos ()
(and (eq org-agenda-show-inherited-tags t)
(or (eq org-agenda-use-tag-inheritance t)
(memq 'todo org-agenda-use-tag-inheritance))))
- tags (org-get-tags nil (not inherited-tags))
+ tags (org-get-tags nil (not inherited-tags) t)
level (make-string (org-reduced-level (org-outline-level)) ? )
txt (org-agenda-format-item "" txt level category tags t)
priority (1+ (org-get-priority txt)))
@@ -5787,10 +5803,10 @@ (defun org-agenda-get-timestamps (&optional deadlines)
(or (eq org-agenda-use-tag-inheritance t)
(memq 'agenda
org-agenda-use-tag-inheritance)))))
- (tags (org-get-tags nil (not inherited-tags)))
+ (tags (org-get-tags nil (not inherited-tags) t))
(level (make-string (org-reduced-level (org-outline-level))
?\s))
- (head (and (looking-at "\\*+[ \t]+\\(.*\\)")
+ (head (and (org-looking-at-fontified "\\*+[ \t]+\\(.*\\)")
(match-string 1)))
(inactive? (= (char-after pos) ?\[))
(habit? (and (fboundp 'org-is-habit-p) (org-is-habit-p)))
@@ -5839,7 +5855,7 @@ (defun org-agenda-get-sexps ()
(setq b (point))
(forward-sexp 1)
(setq sexp (buffer-substring b (point)))
- (setq sexp-entry (if (looking-at "[ \t]*\\(\\S-.*\\)")
+ (setq sexp-entry (if (org-looking-at-fontified "[ \t]*\\(\\S-.*\\)")
(org-trim (match-string 1))
""))
(setq result (org-diary-sexp-entry sexp sexp-entry date))
@@ -5854,7 +5870,7 @@ (defun org-agenda-get-sexps ()
(and (eq org-agenda-show-inherited-tags t)
(or (eq org-agenda-use-tag-inheritance t)
(memq 'agenda org-agenda-use-tag-inheritance))))
- tags (org-get-tags nil (not inherited-tags))
+ tags (org-get-tags nil (not inherited-tags) t)
todo-state (org-get-todo-state)
warntime (get-text-property (point) 'org-appt-warntime)
extra nil)
@@ -5973,7 +5989,8 @@ (defun org-agenda-get-progress ()
clockp (not (or closedp statep))
state (and statep (match-string 2))
category (org-get-category (match-beginning 0))
- timestr (buffer-substring (match-beginning 0) (point-at-eol)))
+ timestr (org-buffer-substring-fontified
+ (match-beginning 0) (point-at-eol)))
(when (string-match "\\]" timestr)
;; substring should only run to end of time stamp
(setq rest (substring timestr (match-end 0))
@@ -5990,10 +6007,12 @@ (defun org-agenda-get-progress ()
(cond
((not org-agenda-log-mode-add-notes) nil)
(statep
- (and (looking-at ".*\\\\\n[ \t]*\\([^-\n \t].*?\\)[ \t]*$")
+ (and (org-looking-at-fontified
+ ".*\\\\\n[ \t]*\\([^-\n \t].*?\\)[ \t]*$")
(match-string 1)))
(clockp
- (and (looking-at ".*\n[ \t]*-[ \t]+\\([^-\n \t].*?\\)[ \t]*$")
+ (and (org-looking-at-fontified
+ ".*\n[ \t]*-[ \t]+\\([^-\n \t].*?\\)[ \t]*$")
(match-string 1)))))
(if (not (re-search-backward org-outline-regexp-bol nil t))
(throw :skip nil)
@@ -6006,9 +6025,9 @@ (defun org-agenda-get-progress ()
(and (eq org-agenda-show-inherited-tags t)
(or (eq org-agenda-use-tag-inheritance t)
(memq 'todo org-agenda-use-tag-inheritance))))
- tags (org-get-tags nil (not inherited-tags))
+ tags (org-get-tags nil (not inherited-tags) t)
level (make-string (org-reduced-level (org-outline-level)) ? ))
- (looking-at "\\*+[ \t]+\\([^\r\n]+\\)")
+ (org-looking-at-fontified "\\*+[ \t]+\\([^\r\n]+\\)")
(setq txt (match-string 1))
(when extra
(if (string-match "\\([ \t]+\\)\\(:[^ \n\t]*?:\\)[ \t]*$" txt)
@@ -6254,7 +6273,8 @@ (defun org-agenda-get-deadlines (&optional with-hour)
(let* ((category (org-get-category))
(level (make-string (org-reduced-level (org-outline-level))
?\s))
- (head (buffer-substring (point) (line-end-position)))
+ (head (org-buffer-substring-fontified
+ (point) (line-end-position)))
(inherited-tags
(or (eq org-agenda-show-inherited-tags 'always)
(and (listp org-agenda-show-inherited-tags)
@@ -6263,7 +6283,7 @@ (defun org-agenda-get-deadlines (&optional with-hour)
(or (eq org-agenda-use-tag-inheritance t)
(memq 'agenda
org-agenda-use-tag-inheritance)))))
- (tags (org-get-tags nil (not inherited-tags)))
+ (tags (org-get-tags nil (not inherited-tags) t))
(time
(cond
;; No time of day designation if it is only
@@ -6466,10 +6486,11 @@ (defun org-agenda-get-scheduled (&optional deadlines with-hour)
(or (eq org-agenda-use-tag-inheritance t)
(memq 'agenda
org-agenda-use-tag-inheritance)))))
- (tags (org-get-tags nil (not inherited-tags)))
+ (tags (org-get-tags nil (not inherited-tags) t))
(level (make-string (org-reduced-level (org-outline-level))
?\s))
- (head (buffer-substring (point) (line-end-position)))
+ (head (org-buffer-substring-fontified
+ (point) (line-end-position)))
(time
(cond
;; No time of day designation if it is only a
@@ -6585,7 +6606,7 @@ (defun org-agenda-get-blocks ()
(memq 'agenda org-agenda-use-tag-inheritance))))
tags (org-get-tags nil (not inherited-tags)))
(setq level (make-string (org-reduced-level (org-outline-level)) ? ))
- (looking-at "\\*+[ \t]+\\(.*\\)")
+ (org-looking-at-fontified "\\*+[ \t]+\\(.*\\)")
(setq head (match-string 1))
(let ((remove-re
(if org-agenda-remove-timeranges-from-blocks
@@ -7133,10 +7154,11 @@ (defun org-agenda-highlight-todo (x)
(when (looking-at (concat "[ \t]*\\.*\\(" re "\\) +"))
(add-text-properties (match-beginning 0) (match-end 1)
(list 'face (org-get-todo-face 1)))
- (let ((s (buffer-substring (match-beginning 1) (match-end 1))))
- (delete-region (match-beginning 1) (1- (match-end 0)))
- (goto-char (match-beginning 1))
- (insert (format org-agenda-todo-keyword-format s)))))
+ (let ((s (buffer-substring (match-beginning 1) (match-end 1))))
+ (with-silent-modifications
+ (setf (buffer-substring (match-beginning 1)
+ (1- (match-end 0)))
+ (format org-agenda-todo-keyword-format s))))))
(let ((pl (text-property-any 0 (length x) 'org-heading t x)))
(setq re (get-text-property 0 'org-todo-regexp x))
(when (and re
@@ -7159,16 +7181,16 @@ (defun org-agenda-highlight-todo (x)
x)
(when (match-end 1)
(setq x
- (concat
- (substring x 0 (match-end 1))
- (unless (string-empty-p org-agenda-todo-keyword-format)
- (format org-agenda-todo-keyword-format
- (match-string 2 x)))
- ;; Remove `display' property as the icon could leak
- ;; on the white space.
- (org-add-props " " (org-plist-delete (text-properties-at 0 x)
- 'display))
- (substring x (match-end 3)))))))
+ (format "%s%s%s%s"
+ (substring x 0 (match-end 1))
+ (unless (string-empty-p org-agenda-todo-keyword-format)
+ (format org-agenda-todo-keyword-format
+ (match-string 2 x)))
+ ;; Remove `display' property as the icon could leak
+ ;; on the white space.
+ (org-add-props " " (org-plist-delete (text-properties-at 0 x)
+ 'display))
+ (substring x (match-end 3)))))))
x)))
(defsubst org-cmp-values (a b property)
@@ -9545,33 +9567,39 @@ (defun org-agenda-align-tags (&optional line)
When optional argument LINE is non-nil, align tags only on the
current line."
(let ((inhibit-read-only t)
- (org-agenda-tags-column (if (eq 'auto org-agenda-tags-column)
- (- (window-text-width))
- org-agenda-tags-column))
(end (and line (line-end-position)))
- l c)
+ l lp c)
(save-excursion
(goto-char (if line (line-beginning-position) (point-min)))
(while (re-search-forward org-tag-group-re end t)
(add-text-properties
(match-beginning 1) (match-end 1)
(list 'face (delq nil (let ((prop (get-text-property
- (match-beginning 1) 'face)))
- (or (listp prop) (setq prop (list prop)))
- (if (memq 'org-tag prop)
- prop
- (cons 'org-tag prop))))))
- (setq l (string-width (match-string 1))
- c (if (< org-agenda-tags-column 0)
- (- (abs org-agenda-tags-column) l)
- org-agenda-tags-column))
+ (match-beginning 1) 'face)))
+ (or (listp prop) (setq prop (list prop)))
+ (if (memq 'org-tag prop)
+ prop
+ (cons 'org-tag prop))))))
+ (setq l (org-string-width (match-string 1))
+ lp (org-string-width (match-string 1) 'pixel)
+ c (unless (eq org-agenda-tags-column 'auto)
+ (if (< org-agenda-tags-column 0)
+ (- (abs org-agenda-tags-column) l)
+ org-agenda-tags-column)))
(goto-char (match-beginning 1))
(delete-region (save-excursion (skip-chars-backward " \t") (point))
(point))
(insert (org-add-props
- (make-string (max 1 (- c (current-column))) ?\s)
- (plist-put (copy-sequence (text-properties-at (point)))
- 'face nil))))
+ " "
+ (copy-sequence (text-properties-at (point)))
+ 'face nil
+ 'display
+ `(space
+ .
+ (:align-to
+ ,(cond
+ ((eq org-agenda-tags-column 'auto) `(- right (,lp) 1))
+ (t `(+ left ,c))))))))
(goto-char (point-min))
(org-font-lock-add-tag-faces (point-max)))))
diff --git a/lisp/org-macs.el b/lisp/org-macs.el
index 77458db96..b9f2a2718 100644
--- a/lisp/org-macs.el
+++ b/lisp/org-macs.el
@@ -873,71 +873,63 @@ (defun org-split-string (string &optional separators)
results ;skip trailing separator
(cons (substring string i) results)))))))
-(defun org--string-from-props (s property beg end)
- "Return the visible part of string S.
-Visible part is determined according to text PROPERTY, which is
-either `invisible' or `display'. BEG and END are 0-indices
-delimiting S."
- (let ((width 0)
- (cursor beg))
- (while (setq beg (text-property-not-all beg end property nil s))
- (let* ((next (next-single-property-change beg property s end))
- (props (text-properties-at beg s))
- (spec (plist-get props property))
- (value
- (pcase property
- (`invisible
- ;; If `invisible' property in PROPS means text is to
- ;; be invisible, return 0. Otherwise return nil so
- ;; as to resume search.
- (and (or (eq t buffer-invisibility-spec)
- (assoc-string spec buffer-invisibility-spec))
- 0))
- (`display
- (pcase spec
- (`nil nil)
- (`(space . ,props)
- (let ((width (plist-get props :width)))
- (and (wholenump width) width)))
- (`(image . ,_)
- (and (fboundp 'image-size)
- (ceiling (car (image-size spec)))))
- ((pred stringp)
- ;; Displayed string could contain invisible parts,
- ;; but no nested display.
- (org--string-from-props spec 'invisible 0 (length spec)))
- (_
- ;; Un-handled `display' value. Ignore it.
- ;; Consider the original string instead.
- nil)))
- (_ (error "Unknown property: %S" property)))))
- (when value
- (cl-incf width
- ;; When looking for `display' parts, we still need
- ;; to look for `invisible' property elsewhere.
- (+ (cond ((eq property 'display)
- (org--string-from-props s 'invisible cursor beg))
- ((= cursor beg) 0)
- (t (string-width (substring s cursor beg))))
- value))
- (setq cursor next))
- (setq beg next)))
- (+ width
- ;; Look for `invisible' property in the last part of the
- ;; string. See above.
- (cond ((eq property 'display)
- (org--string-from-props s 'invisible cursor end))
- ((= cursor end) 0)
- (t (string-width (substring s cursor end)))))))
-
-(defun org-string-width (string)
+(defun org-string-width (string &optional pixels)
"Return width of STRING when displayed in the current buffer.
-Unlike `string-width', this function takes into consideration
-`invisible' and `display' text properties. It supports the
-latter in a limited way, mostly for combinations used in Org.
-Results may be off sometimes if it cannot handle a given
-`display' value."
- (org--string-from-props string 'display 0 (length string)))
+Return width in pixels when PIXELS is non-nil."
+ ;; Wrap/line prefix will make `window-text-pizel-size' return too
+ ;; large value including the prefix.
+ ;; Face should be removed to make sure that all the string symbols
+ ;; are using default face with constant width. Constant char width
+ ;; is critical to get right string width from pixel width.
+ (remove-text-properties 0 (length string)
+ '(wrap-prefix t line-prefix t face t)
+ string)
+ (let (;; We need to remove the folds to make sure that folded table
+ ;; alignment is not messed up.
+ (current-invisibility-spec
+ (or (and (not (listp buffer-invisibility-spec))
+ buffer-invisibility-spec)
+ (let (result)
+ (dolist (el buffer-invisibility-spec)
+ (unless (or (memq el
+ '(org-fold-drawer
+ org-fold-block
+ org-fold-outline))
+ (and (listp el)
+ (memq (car el)
+ '(org-fold-drawer
+ org-fold-block
+ org-fold-outline))))
+ (push el result)))
+ result)))
+ (current-char-property-alias-alist char-property-alias-alist))
+ (with-temp-buffer
+ (setq-local buffer-invisibility-spec
+ current-invisibility-spec)
+ (setq-local char-property-alias-alist
+ current-char-property-alias-alist)
+ (let (pixel-width symbol-width)
+ (with-silent-modifications
+ (setf (buffer-string) string)
+ (setq pixel-width
+ (if (get-buffer-window (current-buffer))
+ (car (window-text-pixel-size
+ nil (line-beginning-position) (point-max)))
+ (set-window-buffer nil (current-buffer))
+ (car (window-text-pixel-size
+ nil (line-beginning-position) (point-max)))))
+ (unless pixels
+ (setf (buffer-string) "a")
+ (setq symbol-width
+ (if (get-buffer-window (current-buffer))
+ (car (window-text-pixel-size
+ nil (line-beginning-position) (point-max)))
+ (set-window-buffer nil (current-buffer))
+ (car (window-text-pixel-size
+ nil (line-beginning-position) (point-max)))))))
+ (if pixels
+ pixel-width
+ (/ pixel-width symbol-width))))))
(defun org-not-nil (v)
"If V not nil, and also not the string \"nil\", then return V.
@@ -1086,6 +1078,20 @@ (defconst org-rm-props '(invisible t face t keymap t intangible t mouse-face t
org-emphasis t)
"Properties to remove when a string without properties is wanted.")
+(defun org-buffer-substring-fontified (beg end)
+ "Return fontified region between BEG and END."
+ (when (bound-and-true-p jit-lock-mode)
+ (save-match-data (jit-lock-fontify-now beg end)))
+ (buffer-substring beg end))
+
+(defun org-looking-at-fontified (re)
+ "Call `looking-at' and make sure that the match is fontified."
+ (prog1 (looking-at re)
+ (when (bound-and-true-p jit-lock-mode)
+ (save-match-data
+ (jit-lock-fontify-now (match-beginning 0)
+ (match-end 0))))))
+
(defsubst org-no-properties (s &optional restricted)
"Remove all text properties from string S.
When RESTRICTED is non-nil, only remove the properties listed
diff --git a/lisp/org.el b/lisp/org.el
index 4fd8b6fa6..a5b4601ce 100644
--- a/lisp/org.el
+++ b/lisp/org.el
@@ -7103,7 +7103,7 @@ (defun org-get-heading (&optional no-tags no-todo no-priority no-comment)
(save-excursion
(org-back-to-heading t)
(let ((case-fold-search nil))
- (looking-at org-complex-heading-regexp)
+ (org-looking-at-fontified org-complex-heading-regexp)
(let ((todo (and (not no-todo) (match-string 2)))
(priority (and (not no-priority) (match-string 3)))
(headline (pcase (match-string 4)
@@ -11436,7 +11436,7 @@ (defvar org-trust-scanner-tags nil
(defvar org--matcher-tags-todo-only nil)
-(defun org-scan-tags (action matcher todo-only &optional start-level)
+(defun org-scan-tags (action matcher todo-only &optional start-level fontify)
"Scan headline tags with inheritance and produce output ACTION.
ACTION can be `sparse-tree' to produce a sparse tree in the current buffer,
@@ -11454,7 +11454,9 @@ (defun org-scan-tags (action matcher todo-only &optional start-level)
included in the output.
START-LEVEL can be a string with asterisks, reducing the scope to
-headlines matching this string."
+headlines matching this string.
+
+When FONTIFY is non-nil, make sure that matches are fontified."
(require 'org-agenda)
(let* ((re (concat "^"
(if start-level
@@ -11495,8 +11497,12 @@ (defun org-scan-tags (action matcher todo-only &optional start-level)
;; Ignore closing parts of inline tasks.
(when (and (fboundp 'org-inlinetask-end-p) (org-inlinetask-end-p))
(throw :skip t))
+ (when (and fontify (bound-and-true-p jit-lock-mode))
+ (save-match-data
+ (jit-lock-fontify-now
+ (match-beginning 0) (match-end 0))))
(setq todo (and (match-end 1) (match-string-no-properties 1)))
- (setq tags (and (match-end 4) (org-trim (match-string-no-properties 4))))
+ (setq tags (and (match-end 4) (org-trim (match-string 4))))
(goto-char (setq lspos (match-beginning 0)))
(setq level (org-reduced-level (org-outline-level))
category (org-get-category))
@@ -12436,13 +12442,17 @@ (defun org-make-tag-string (tags)
(if (null tags) ""
(format ":%s:" (mapconcat #'identity tags ":"))))
-(defun org--get-local-tags ()
+(defun org--get-local-tags (&optional fontified)
"Return list of tags for the current headline.
-Assume point is at the beginning of the headline."
- (and (looking-at org-tag-line-re)
- (split-string (match-string-no-properties 2) ":" t)))
+Assume point is at the beginning of the headline.
+
+The tags are fontified when FONTIFY is non-nil."
+ (and (if fontified
+ (org-looking-at-fontified org-tag-line-re)
+ (looking-at org-tag-line-re))
+ (split-string (match-string 2) ":" t)))
-(defun org-get-tags (&optional pos local)
+(defun org-get-tags (&optional pos local fontify)
"Get the list of tags specified in the current headline.
When argument POS is non-nil, retrieve tags for headline at POS.
@@ -12457,7 +12467,9 @@ (defun org-get-tags (&optional pos local)
However, when optional argument LOCAL is non-nil, only return
tags specified at the headline.
-Inherited tags have the `inherited' text property."
+Inherited tags have the `inherited' text property.
+
+The tags are fontified when FONTIFY is non-nil."
(if (and org-trust-scanner-tags
(or (not pos) (eq pos (point)))
(not local))
@@ -12465,11 +12477,11 @@ (defun org-get-tags (&optional pos local)
(org-with-point-at (or pos (point))
(unless (org-before-first-heading-p)
(org-back-to-heading t)
- (let ((ltags (org--get-local-tags)) itags)
+ (let ((ltags (org--get-local-tags fontify)) itags)
(if (or local (not org-use-tag-inheritance)) ltags
(while (org-up-heading-safe)
(setq itags (nconc (mapcar #'org-add-prop-inherited
- (org--get-local-tags))
+ (org--get-local-tags fontify))
itags)))
(setq itags (append org-file-tags itags))
(nreverse
--
2.31.1
next prev parent reply other threads:[~2021-07-02 14:11 UTC|newest]
Thread overview: 31+ messages / expand[flat|nested] mbox.gz Atom feed top
2020-10-31 12:11 prettify-symbols-mode in org agenda? William Xu
2020-11-03 5:05 ` Ihor Radchenko
2020-11-03 19:05 ` William Xu
2020-11-04 1:47 ` Ihor Radchenko
2021-04-27 20:53 ` Bastien
2021-05-01 12:33 ` Ihor Radchenko
2021-05-01 13:33 ` William Xu
2021-05-01 14:37 ` Ihor Radchenko
2021-05-02 12:31 ` William Xu
2021-05-02 12:58 ` Ihor Radchenko
2021-05-02 13:56 ` William Xu
2021-05-03 17:16 ` Bastien
2021-05-04 4:23 ` Ihor Radchenko
2021-05-04 14:51 ` Ihor Radchenko
2021-05-05 15:23 ` Ihor Radchenko
2021-05-05 18:01 ` William Xu
2021-05-06 2:15 ` Ihor Radchenko
2021-05-14 15:35 ` William Xu
2021-05-15 12:15 ` Ihor Radchenko
2021-05-16 9:49 ` William Xu
2021-05-17 14:04 ` Ihor Radchenko
2021-05-17 17:44 ` William Xu
2021-06-20 11:27 ` Ihor Radchenko
2021-06-22 15:25 ` William Xu
2021-06-22 15:42 ` Ihor Radchenko
2021-06-22 18:07 ` William Xu
2021-07-02 14:11 ` Ihor Radchenko [this message]
2021-07-01 15:49 ` Timothy
2021-07-02 14:13 ` Ihor Radchenko
2021-10-26 9:03 ` William Xu
2021-10-27 6:50 ` Ihor Radchenko
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.orgmode.org/
* Reply using the --to, --cc, and --in-reply-to
switches of git-send-email(1):
git send-email \
--in-reply-to=87v95slsas.fsf@localhost \
--to=yantar92@gmail.com \
--cc=emacs-orgmode@gnu.org \
--cc=william.xwl@gmail.com \
/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/org-mode.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).