From 7655c32847d7abd9da7603b1a1a314b7d1b87ba5 Mon Sep 17 00:00:00 2001
From: Adam Spiers <orgmode@adamspiers.org>
Date: Wed, 16 Sep 2020 23:12:04 +0100
Subject: [PATCH] [WIP] org.el: Align tags using specified space display property
To: emacs-orgmode@gnu.org

Previously tags on heading lines were aligned using spaces, which
assumed a fixed width font.  However variable pitch fonts are becoming
increasingly popular, so ensure there is always a single space in
between the heading text and the (colon-delimited) list of tags, and
then if necessary use a display text property to specify the exact
width required by that space to align it in accordance with the value
of `org-tags-column' which the user has chosen:

  https://www.gnu.org/software/emacs/manual/html_node/elisp/Pixel-Specification.html#Pixel-Specification

If the value is positive, align flush-left; if negative, align
flush-right; and if zero, just leave a normal width space.

See the following links for the discussion threads leading to this
patch:

- https://lists.gnu.org/archive/html/emacs-orgmode/2020-09/msg00415.html
- https://gitlab.com/protesilaos/modus-themes/-/issues/85

Signed-off-by: Adam Spiers <orgmode@adamspiers.org>
Co-authored-by: Jeff Filipovits <jrfilipovits@gmail.com>
---
 lisp/org.el | 68 ++++++++++++++++++++++++++++++-----------------------
 1 file changed, 39 insertions(+), 29 deletions(-)

diff --git a/lisp/org.el b/lisp/org.el
index 053635c85..e800eb642 100644
--- a/lisp/org.el
+++ b/lisp/org.el
@@ -11831,35 +11831,45 @@ (defun org-toggle-tag (tag &optional onoff)
       res)))
 
 (defun org--align-tags-here (to-col)
-  "Align tags on the current headline to TO-COL.
-Assume point is on a headline.  Preserve point when aligning
-tags."
-  (when (org-match-line org-tag-line-re)
-    (let* ((tags-start (match-beginning 1))
-	   (blank-start (save-excursion
-			  (goto-char tags-start)
-			  (skip-chars-backward " \t")
-			  (point)))
-	   (new (max (if (>= to-col 0) to-col
-		       (- (abs to-col) (string-width (match-string 1))))
-		     ;; Introduce at least one space after the heading
-		     ;; or the stars.
-		     (save-excursion
-		       (goto-char blank-start)
-		       (1+ (current-column)))))
-	   (current
-	    (save-excursion (goto-char tags-start) (current-column)))
-	   (origin (point-marker))
-	   (column (current-column))
-	   (in-blank? (and (> origin blank-start) (<= origin tags-start))))
-      (when (/= new current)
-	(delete-region blank-start tags-start)
-	(goto-char blank-start)
-	(let ((indent-tabs-mode nil)) (indent-to new))
-	;; Try to move back to original position.  If point was in the
-	;; blanks before the tags, ORIGIN marker is of no use because
-	;; it now points to BLANK-START.  Use COLUMN instead.
-	(if in-blank? (org-move-to-column column) (goto-char origin))))))
+  "Align tags on the current headline to TO-COL.  Since TO-COL is
+derived from `org-tags-column', a negative value is interpreted as
+alignment flush-right, a positive value as flush-left, and 0 means
+insert a single space in between the headline and the tags.
+
+Assume point is on a headline.  Preserve point when aligning tags."
+  (save-excursion
+    (when (org-match-line org-tag-line-re)
+      (let* ((tags-start (match-beginning 1))
+             (tags-end (match-end 1))
+             (tags-pixel-width
+              (car (window-text-pixel-size (selected-window)
+                                           tags-start tags-end)))
+             (blank-start (progn
+                            (goto-char tags-start)
+                            (skip-chars-backward " \t")
+                            (point))))
+        ;; If there is more than one space between the headline and
+        ;; tags, delete the extra spaces.  Might be better to make the
+        ;; delete region one space smaller rather than inserting a new
+        ;; space?
+        (when (> tags-start (1+ blank-start))
+          (delete-region blank-start tags-start)
+          (goto-char blank-start)
+          (insert " "))
+        (if (= to-col 0)
+            ;; Just leave one normal space width
+            (remove-text-properties blank-start (1+ blank-start) '(display nil))
+          (let ((align-expr
+                 (if (> to-col 0)
+                     ;; Left-align positive values
+                     to-col
+                   ;; Right-align negative values by subtracting the
+                   ;; width of the tags.  Conveniently, the pixel
+                   ;; specification allows us to mix units,
+                   ;; subtracting a pixel width from a column number.
+                   `(- ,(- to-col) (,tags-pixel-width)))))
+            (put-text-property blank-start (1+ blank-start)
+                               'display `(space . (:align-to ,align-expr)))))))))
 
 (defun org-set-tags-command (&optional arg)
   "Set the tags for the current visible entry.
-- 
2.28.0