From mboxrd@z Thu Jan 1 00:00:00 1970 Return-Path: Received: from mp0 ([2001:41d0:8:6d80::]) (using TLSv1.3 with cipher TLS_AES_256_GCM_SHA384 (256/256 bits)) by ms0.migadu.com with LMTPS id EN4OA9tmjWBxewAAgWs5BA (envelope-from ) for ; Sat, 01 May 2021 16:34:03 +0200 Received: from aspmx1.migadu.com ([2001:41d0:8:6d80::]) (using TLSv1.3 with cipher TLS_AES_256_GCM_SHA384 (256/256 bits)) by mp0 with LMTPS id AJFrOtpmjWCGLQAA1q6Kng (envelope-from ) for ; Sat, 01 May 2021 14:34:02 +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 23E751CB65 for ; Sat, 1 May 2021 16:34:02 +0200 (CEST) Received: from localhost ([::1]:38222 helo=lists1p.gnu.org) by lists.gnu.org with esmtp (Exim 4.90_1) (envelope-from ) id 1lcqgz-0001G5-5Q for larch@yhetil.org; Sat, 01 May 2021 10:34:01 -0400 Received: from eggs.gnu.org ([2001:470:142:3::10]:46322) by lists.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.90_1) (envelope-from ) id 1lcqfu-0001Fz-9P for emacs-orgmode@gnu.org; Sat, 01 May 2021 10:32:54 -0400 Received: from mail-lf1-x12f.google.com ([2a00:1450:4864:20::12f]:35529) by eggs.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_128_GCM_SHA256:128) (Exim 4.90_1) (envelope-from ) id 1lcqfr-0002Qz-Qx for emacs-orgmode@gnu.org; Sat, 01 May 2021 10:32:53 -0400 Received: by mail-lf1-x12f.google.com with SMTP id x19so1469723lfa.2 for ; Sat, 01 May 2021 07:32:51 -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=AGcYiCgHVa4Fz0WfJ5F6MBTtYI9s5A0Gy5PqpiSViN0=; b=AulcP3nFzaicO6IEIwz+5DyrR/RxjSfNjOZDISoUw0HvHSOY9eMCpg4bjoVUW0W1Z5 n0HmfxFKQfNMT7Lo64jIpoVXvseNpqFOCe7sRwk3zz+GP4AZ9CJABwrnCCFRdAbSMYB0 hayTXS1/KxiBMu+4G7bdm608wdK3za8S9Or8VRc4rNr3hSIxWTji66nfEhdexl+Qxdsn MKek97HXNH7TkpaQtCE137+JyIjxUNPdypEPYh8ju7k5AjT2OePGj8i6pGIqnSOm6KTo KpUitIhCyrWcF9CTa/eZRUTc19ArYYCDRsRucp8p+LOP3YmX3OtJ0cmmYJFlCriyuS8J YaGA== 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=AGcYiCgHVa4Fz0WfJ5F6MBTtYI9s5A0Gy5PqpiSViN0=; b=oEIc1nL3pT8hjIe2IULbWZodr7UU/dv8XUtw7gTBEuCBl6sQgVee7vd/9FK9VfflU9 AapC4K2Y9Tj8/tsrHCiN0jUMyrBprBKtPF40EXtvP6q03PMsriFCfw4ULwVZ7pEo7agr QXzEe9Io50sGf3frhXxeKNi0dp6h/1XK2iwclnawIRZ6PVkJvEHKkc814IVxq9J3iMy/ NQq6LGJ9xRjfdSxZTlKT2vcBTb3eKvzNLEQ1ur2yWDPfBmiGB51XqsJh7EmQaSPAkRzx 8LoskEIDixdR4U72RreUffmI6iQyFXt3a3rg0odTxGwAp9s3stEzRRZv4Go8dZRwnlV+ 7wCg== X-Gm-Message-State: AOAM532d+qMfrtJSUImBFGBic6U4uhCDol3LJMteBnXZg8sHTgRCEFak 8g8WCyYl7cluiA7jHazN54k= X-Google-Smtp-Source: ABdhPJxaDtKo0jsLkTIPJnpaxdlNAXkNr6w0BycOqwg6NPel0jGv8323evBDmhBF7GAKZaGBUv5Hdg== X-Received: by 2002:a05:6512:344d:: with SMTP id j13mr6966277lfr.369.1619879569924; Sat, 01 May 2021 07:32:49 -0700 (PDT) Received: from localhost ([141.105.67.194]) by smtp.gmail.com with ESMTPSA id h8sm586490lfc.101.2021.05.01.07.32.47 (version=TLS1_3 cipher=TLS_AES_256_GCM_SHA384 bits=256/256); Sat, 01 May 2021 07:32:48 -0700 (PDT) From: Ihor Radchenko To: William Xu Subject: Re: prettify-symbols-mode in org agenda? In-Reply-To: References: <87o8kf81yq.fsf@localhost> <87im474fgy.fsf@gnu.org> <87v98263bg.fsf@localhost> X-Woof-Patch: yes Date: Sat, 01 May 2021 22:37:13 +0800 Message-ID: <87mtteo6zq.fsf@localhost> MIME-Version: 1.0 Content-Type: multipart/mixed; boundary="=-=-=" Received-SPF: pass client-ip=2a00:1450:4864:20::12f; envelope-from=yantar92@gmail.com; helo=mail-lf1-x12f.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: 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=1619879642; 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=AGcYiCgHVa4Fz0WfJ5F6MBTtYI9s5A0Gy5PqpiSViN0=; b=H+1Y5Gsj3GSanTQpsklXVQyzDChD63eeNCR2LBOdkqKcbsvCrIlmlDDS6Fa4yuvJ5yEUcO ZBDPzUh2anWZLOstFMSq7Jz25XKgg9TBAHvAQOYGX5BSRe3iH/V7OuCtPsVgYY7oT4ad6d FFHi6irow6n5WCTwokNLFdKo8BbjROY8L52L/I8RJfrXHzIa0xqV+11R1MkrgmVGymH5n5 YUOf1+6D5vrWFk8G2PIZ6JVg9x/sTy8vBCc+uerrOQAbfVENujWURRj3dvbt2Fl9lGej4F ir6k7pRQ/xwL3yDKgReMLvuifGkjG20Jz3rhh5QDvvy+w5TAJVbpo4skydF+Ww== ARC-Seal: i=1; s=key1; d=yhetil.org; t=1619879642; a=rsa-sha256; cv=none; b=S/Qa0hbHII5aNY18F7m63zqIy2b3Xrn8MM1NXfs9cQNdkH8OmPy+DewVGDB7v+65Fk9t9k jyGcTPrnliENOvynSAP2UJvQcerOxvgWfZPzceHVJpyujzb8V5GEtCHGsQLlMJPTjfUjE8 cpguM8gs/y9kcwxTP3Q2YY1m6bL+UrcFSpBjZE1FPxOkfbi2LLJusGgo1JVZ5eEU+xMeBr oQiDNNnnuMosQL3/KfPF3KOduJBHO3vqFvR/p56M3oeXtoK+zmezWxKskxdslt4VxFUe2y EqnERxdVIeN1U9vpmDv7OBFn16jC2661GhsMIIb21ASTVDyaTQ1ueSlEOGfZyw== ARC-Authentication-Results: i=1; aspmx1.migadu.com; dkim=pass header.d=gmail.com header.s=20161025 header.b=AulcP3nF; 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: -1.66 Authentication-Results: aspmx1.migadu.com; dkim=pass header.d=gmail.com header.s=20161025 header.b=AulcP3nF; 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: 23E751CB65 X-Spam-Score: -1.66 X-Migadu-Scanner: scn0.migadu.com X-TUID: XjOeCYWEmE6T --=-=-= Content-Type: text/plain William Xu writes: >> (org-agenda-highlight-todo): Preserve composition property used, >> i.e. by `prettify-symbols-mode'. > > It looks like this change is not really needed, my emacs is built from > git master. Maybe the 'composition property is now preserved > automatically in the buffer? This change is needed, for example, when you change todo-state using `org-agenda-todo'. Refreshing the agenda line in org-agenda-highlight-todo involves (insert (format org-agenda-todo-keyword-format s)) `insert' will destroy the 'composition as 'composition is set by pretty-symbols to be self-destructed on change. Having said that, I can now see an easier approach to deal with the problem: simply wrap insert into `with-silent-modifications' Amended patch with some minor refactoring is attached. Best, Ihor --=-=-= Content-Type: text/x-diff Content-Disposition: inline; filename=0001-Make-sure-that-fontification-is-preserved-in-agenda.patch >From b6edd24d4477467e05b69258eccef58d48b39676 Mon Sep 17 00:00:00 2001 Message-Id: From: Ihor Radchenko Date: Sat, 1 May 2021 20:09:10 +0800 Subject: [PATCH] Make sure that fontification is preserved 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 pixelwise 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-macs.el (org-string-width): Refactor old code and add optional argument to return pixel width. The old code used manual parsing of text proerpties 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-buffer-substring-fontified): New function getting fontified substring from current buffer. * lisp/org-agenda.el (org-agenda-get-todos, org-agenda-get-progress, org-agenda-get-deadlines, org-agenda-get-scheduled): Use org-buffer-substring-fontified to get fontified heading. (org-agenda-fix-displayed-tags): Fontify tags. (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. --- lisp/org-agenda.el | 63 ++++++++++++++++---------- lisp/org-macs.el | 108 ++++++++++++++++++--------------------------- 2 files changed, 83 insertions(+), 88 deletions(-) diff --git a/lisp/org-agenda.el b/lisp/org-agenda.el index bd9d466a6..5add0e092 100644 --- a/lisp/org-agenda.el +++ b/lisp/org-agenda.el @@ -5562,7 +5562,7 @@ (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) @@ -5973,7 +5973,7 @@ (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)) @@ -6254,7 +6254,7 @@ (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) @@ -6469,7 +6469,7 @@ (defun org-agenda-get-scheduled (&optional deadlines with-hour) (tags (org-get-tags nil (not inherited-tags))) (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 @@ -6856,6 +6856,15 @@ (defun org-agenda-fix-displayed-tags (txt tags add-inherited hide-re) x)) tags ":") (if have-i "::" ":")))))) + (let ((tag-string (when (string-match org-tag-group-re txt) + (match-string 0 txt)))) + (when tag-string + (with-temp-buffer + (save-match-data + (let ((org-inhibit-startup t)) (org-mode)) + (insert "* X" tag-string) + (font-lock-ensure)) + (setf (substring txt (match-beginning 0) (match-end 0)) (buffer-substring 4 (point-max)))))) txt) (defvar org-agenda-sorting-strategy) ;; because the def is in a let form @@ -7119,10 +7128,9 @@ (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 @@ -9528,33 +9536,40 @@ (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)))) + " " + ;; (make-string (max 1 (- c (current-column))) ?\s) + (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..0aff82cb0 100644 --- a/lisp/org-macs.el +++ b/lisp/org-macs.el @@ -868,71 +868,45 @@ (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 +1055,12 @@ (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) + (jit-lock-fontify-now beg end)) + (buffer-substring beg end)) + (defsubst org-no-properties (s &optional restricted) "Remove all text properties from string S. When RESTRICTED is non-nil, only remove the properties listed -- 2.26.3 --=-=-=--