From mboxrd@z Thu Jan 1 00:00:00 1970 Return-Path: Received: from mp2 ([2001:41d0:2:4a6f::]) (using TLSv1.3 with cipher TLS_AES_256_GCM_SHA384 (256/256 bits)) by ms0.migadu.com with LMTPS id kCOMKe5ekWAhKwEAgWs5BA (envelope-from ) for ; Tue, 04 May 2021 16:49:18 +0200 Received: from aspmx1.migadu.com ([2001:41d0:2:4a6f::]) (using TLSv1.3 with cipher TLS_AES_256_GCM_SHA384 (256/256 bits)) by mp2 with LMTPS id uIxFJe5ekWAzKwAAB5/wlQ (envelope-from ) for ; Tue, 04 May 2021 14:49:18 +0000 Received: from lists.gnu.org (lists.gnu.org [209.51.188.17]) (using TLSv1.2 with cipher ECDHE-RSA-AES256-GCM-SHA384 (256/256 bits)) (No client certificate requested) by aspmx1.migadu.com (Postfix) with ESMTPS id 86C2D14884 for ; Tue, 4 May 2021 16:49:17 +0200 (CEST) Received: from localhost ([::1]:38926 helo=lists1p.gnu.org) by lists.gnu.org with esmtp (Exim 4.90_1) (envelope-from ) id 1ldwMO-0006YF-MY for larch@yhetil.org; Tue, 04 May 2021 10:49:16 -0400 Received: from eggs.gnu.org ([2001:470:142:3::10]:33030) by lists.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.90_1) (envelope-from ) id 1ldwKN-0004xL-5l for emacs-orgmode@gnu.org; Tue, 04 May 2021 10:47:11 -0400 Received: from mail-pf1-x42f.google.com ([2607:f8b0:4864:20::42f]:45817) by eggs.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_128_GCM_SHA256:128) (Exim 4.90_1) (envelope-from ) id 1ldwKJ-0003r1-NY; Tue, 04 May 2021 10:47:10 -0400 Received: by mail-pf1-x42f.google.com with SMTP id i190so7624371pfc.12; Tue, 04 May 2021 07:47:06 -0700 (PDT) DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=gmail.com; s=20161025; h=from:to:subject:in-reply-to:references:cc:date:message-id :mime-version; bh=whrcW5YFAcUv/nUCobzp/abXFO6h1m9ru1s5dVbIlhY=; b=SRO/0KQMuXkwEzoGmaD0hRlW96dnvuVF3uNfWLzGpOugHjMfb0Vm8bdEi1IoNWb/tw CbepBoaO8Cm0x2CSukZKeE63riFPbs3SnAgxiIUaA2VVJ88xgZt4wtIWFaOcBzsm8Psk MxAH9bNuSscZTJvUoJVpj54DWj9E7qDWpkBUkhd1E3M7Z1aPv9V8UM2EIF8oG/yjhV8h 52nD/V19TuKY9WEOgmRUrHclW8FWqmBEGdTS/fvU45l0p6YsMPmeVtchueJJRg9gpkoW DN5sX1HIZubr/Nv36hz2Md4jHptwE/mFuyDXwRbwQnyQEl3g0lX3Aa5UGXN0JZVmGZdJ +ZZQ== X-Google-DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=1e100.net; s=20161025; h=x-gm-message-state:from:to:subject:in-reply-to:references:cc:date :message-id:mime-version; bh=whrcW5YFAcUv/nUCobzp/abXFO6h1m9ru1s5dVbIlhY=; b=Lm81b5aWYHXQvVckUqnsw/i7W/CSoKCnCwOaTAGO2y5AnoQQhe2A+d2phhuewUrymo Jh9L0g07XmG8qHbUiztwF44+TertJ/b1Rqk5kXw55+o/uVL87XngdTfigrLjQWmfuo2s r5iztZXozHXXSrKFn8KkNtNJ3egjTUznxsyohSk7LZq0qwlGIm4aGCd4OhVI/FWKfjdn 16LkqoTVmz8lhF9owpCvkLumuZbu3a7Hhu2/z+ml7G+8IWkp31LCm/1L/RNRGPu1KPs3 uWjV/cZvjhVoYI/ugYsAlzgi+W3PkMz2FU1v5ayH5WzjuZ3UQzl5B4MCE36RqlNAB+xS pUWA== X-Gm-Message-State: AOAM533vnFeOaD597BP4CBbB8pDa8HRU7BUeHUioRIMe+VZWdjLAdWEy 7NGM0r9qTvA2Fr4VmiQ6ymPHkuRouI3lew== X-Google-Smtp-Source: ABdhPJxOsh0+51qCJtkZvMM5TzWI5LobNorHwNsyfUznLbeqoG3YVJHCzy+i0SPwvJmgSp/6al14/w== X-Received: by 2002:a17:90a:d90c:: with SMTP id c12mr5666917pjv.129.1620139625134; Tue, 04 May 2021 07:47:05 -0700 (PDT) Received: from localhost ([158.255.2.9]) by smtp.gmail.com with ESMTPSA id h19sm3577986pgm.40.2021.05.04.07.46.59 (version=TLS1_3 cipher=TLS_AES_256_GCM_SHA384 bits=256/256); Tue, 04 May 2021 07:47:04 -0700 (PDT) From: Ihor Radchenko To: Bastien , William Xu Subject: Re: prettify-symbols-mode in org agenda? In-Reply-To: <87y2cvyvo9.fsf@localhost> References: <87o8kf81yq.fsf@localhost> <87im474fgy.fsf@gnu.org> <87v98263bg.fsf@localhost> <87mtteo6zq.fsf@localhost> <87h7jl1eds.fsf@localhost> <87k0ofn3er.fsf@gnu.org> <87y2cvyvo9.fsf@localhost> Date: Tue, 04 May 2021 22:51:25 +0800 Message-ID: <877dkeeemq.fsf@localhost> MIME-Version: 1.0 Content-Type: multipart/mixed; boundary="=-=-=" Received-SPF: pass client-ip=2607:f8b0:4864:20::42f; envelope-from=yantar92@gmail.com; helo=mail-pf1-x42f.google.com X-Spam_score_int: -17 X-Spam_score: -1.8 X-Spam_bar: - X-Spam_report: (-1.8 / 5.0 requ) BAYES_00=-1.9, DKIM_SIGNED=0.1, DKIM_VALID=-0.1, DKIM_VALID_AU=-0.1, DKIM_VALID_EF=-0.1, FREEMAIL_ENVFROM_END_DIGIT=0.25, FREEMAIL_FROM=0.001, RCVD_IN_DNSWL_NONE=-0.0001, SPF_HELO_NONE=0.001, SPF_PASS=-0.001 autolearn=ham autolearn_force=no X-Spam_action: no action X-BeenThere: emacs-orgmode@gnu.org X-Mailman-Version: 2.1.23 Precedence: list List-Id: "General discussions about Org-mode." List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Cc: William Xu , emacs-orgmode@gnu.org Errors-To: emacs-orgmode-bounces+larch=yhetil.org@gnu.org Sender: "Emacs-orgmode" X-Migadu-Flow: FLOW_IN ARC-Message-Signature: i=1; a=rsa-sha256; c=relaxed/relaxed; d=yhetil.org; s=key1; t=1620139757; h=from:from:sender:sender:reply-to:subject:subject:date:date: message-id:message-id:to:to:cc:cc:mime-version:mime-version: content-type:content-type:in-reply-to:in-reply-to: references:references:list-id:list-help:list-unsubscribe: list-subscribe:list-post:dkim-signature; bh=whrcW5YFAcUv/nUCobzp/abXFO6h1m9ru1s5dVbIlhY=; b=t6RkB0Kp5G1YcK+0F/wBiQvq+k7QAenbEiwJk6BGiWtAxBV6xtZ1oAyxU5oJuEALiBH1tf /6U6CWz8Rz+m8leRYfWFP63MdPYTI5yv6ajNzTHDEtMUP2L8Cen3Qf/qyI7/2+U5UTj/zF XkHdgR3rrskJHeg7XO9OS81ZCvxXJvlRvMVJ9Atp72wMZS587jMHOWMq/1tp0nCySjm8tZ OBAo1G5+9yCx2W4BABeJ0YMY1Vth25JFAWO89Qpfsf67g8DwifFyWtkdZ6PNKQGCHpjd7e 2wb2m/m8RlNGNx2LWPH8kZZhuKh7GgMj1E8Y2zp92iuZOvdk0Hhr904aD/sJMA== ARC-Seal: i=1; s=key1; d=yhetil.org; t=1620139757; a=rsa-sha256; cv=none; b=V9PZsQm98JMyFpMGTKuTmbo3G9/Aif4qGXPokOedVXQ3PYL8jdRApBJ+9bdLv9/l5Jhbu/ unxDH3yHpjh7mXhnaeBjQNA+p4Gsm+cTeXareY73vUmT9SID4qaQ6WRtqp2xkoQe+2bpwb D5Fy02I0+7yzChvNYO/FC2BQjQ6y1XgCpEv5Zboe57zWe1sWJ61QjxROX0M3k0yLUgkOWJ ppbgNX7sPCsNzsDsjK+MtHci+OYgvNMHlkHPN2NpiyKiPcg32NuqPwfA/cBouahb6I3vC8 k3tNVZUK0PO3hE8n0T+IdNVP7KpydkXzE37JRqIDp3KR9a5k2nZbswRxwTcvAg== ARC-Authentication-Results: i=1; aspmx1.migadu.com; dkim=pass header.d=gmail.com header.s=20161025 header.b="SRO/0KQM"; dmarc=pass (policy=none) header.from=gmail.com; spf=pass (aspmx1.migadu.com: domain of emacs-orgmode-bounces@gnu.org designates 209.51.188.17 as permitted sender) smtp.mailfrom=emacs-orgmode-bounces@gnu.org X-Migadu-Spam-Score: -0.16 Authentication-Results: aspmx1.migadu.com; dkim=pass header.d=gmail.com header.s=20161025 header.b="SRO/0KQM"; dmarc=pass (policy=none) header.from=gmail.com; spf=pass (aspmx1.migadu.com: domain of emacs-orgmode-bounces@gnu.org designates 209.51.188.17 as permitted sender) smtp.mailfrom=emacs-orgmode-bounces@gnu.org X-Migadu-Queue-Id: 86C2D14884 X-Spam-Score: -0.16 X-Migadu-Scanner: scn0.migadu.com X-TUID: hBESJ9f3FRKc --=-=-= Content-Type: text/plain Ihor Radchenko writes: > Bastien writes: >> Could it slow down agenda generation for some configurations? > The total slowdown is ~30%, though the second part will only be slow > before the headings are fontified first time by > org-buffer-substring-fontified. Subsequent agenda rebuilds will be > faster. I have updated the code to avoid creating temporary org buffers. Now, I got 8% slowdown during first agenda run. The slowdown diminishes as the headlines contributing to agenda get fontified (i.e. for all next org-agenda-redo). > Please move the comments after the change log themselves. Done. > Here and for the rest of the patch: please try to keep lines below 80 > characters. I'm aware this is not always feasible, especially given > long functions with many nested s-exps, but let's try to come as close > as possible to 80. Done. William Xu writes: > The only issue I still see, is that when you org-agenda-redo-all, or > org-agenda-log-mode (which triggers org-agenda-redo-all), the > prettify gets lost again. Maybe org-buffer-substring-fontified call is > also required somewhere during org-agenda-redo-all? I managed to reproduce it. This time, I went through all the agenda.el and updated places where the strings are fetched from Org buffers into agenda. The updated patch is attached. Best, Ihor --=-=-= Content-Type: text/x-diff Content-Disposition: inline; filename=0001-Make-sure-that-fontification-is-preserved-in-agenda.patch >From 8a6f629669772ff4561180ace320eb0a6365969f Mon Sep 17 00:00:00 2001 Message-Id: <8a6f629669772ff4561180ace320eb0a6365969f.1620134057.git.yantar92@gmail.com> From: Ihor Radchenko Date: Tue, 4 May 2021 20:33:10 +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): 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): Make sure that fontification is the same with original Org buffers. (org-agenda-highlight-todo): Preserve composition property 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. 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 | 92 ++++++++++++++++++------------- lisp/org-macs.el | 134 +++++++++++++++++++++++---------------------- lisp/org.el | 24 +++++--- 3 files changed, 138 insertions(+), 112 deletions(-) diff --git a/lisp/org-agenda.el b/lisp/org-agenda.el index 4c34ca5fe..420579ecf 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 @@ -4778,10 +4778,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 @@ -5562,7 +5563,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 +5572,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 +5789,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 +5841,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 +5856,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 +5975,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 +5993,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 +6011,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 +6259,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 +6269,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 +6472,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 +6592,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 @@ -7119,10 +7126,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 @@ -9530,33 +9538,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 dc0c42b6f..79e9012b7 100644 --- a/lisp/org-macs.el +++ b/lisp/org-macs.el @@ -868,71 +868,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. @@ -1081,6 +1073,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 f3a33d8b3..43f9dc25d 100644 --- a/lisp/org.el +++ b/lisp/org.el @@ -7073,7 +7073,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) @@ -12372,13 +12372,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. -(defun org-get-tags (&optional pos local) +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 fontify) "Get the list of tags specified in the current headline. When argument POS is non-nil, retrieve tags for headline at POS. @@ -12393,7 +12397,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)) @@ -12401,11 +12407,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.26.3 --=-=-=--