[org] el-patch for alignment of the tag column

1 files changed, 37 insertions, 0 deletions

diff --git a/lisp/documents.el b/lisp/documents.el
index 33f8b29..4687ac3 100644
--- a/lisp/documents.el
+++ b/lisp/documents.el
@@ -262,6 +262,43 @@ Visits LINK, or if LINK names a subdirectory of
                        (org-agenda-skip-function ,subtree-is-habit)
                        (org-agenda-overriding-header "Week Ahead:"))))
              ((org-agenda-compact-blocks t)))))))
+    ;; Patch in an offset for tag alignment. (Without this, they will warp in a
+    ;; way which I do not like.)
+    :config/el-patch
+    (defun org-agenda-align-tags (&optional line)
+      "Align all tags in agenda items to `org-agenda-tags-column'.
+    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)
+                  (el-patch-swap (window-max-chars-per-line) (- 2 (window-max-chars-per-line)))
+                org-agenda-tags-column))
+        (end (and line (line-end-position)))
+        l 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))
+        (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))))
+          (goto-char (point-min))
+          (org-font-lock-add-tag-faces (point-max)))))))
 
 (use-package org-drill
   ;; org-drill in upstream Org is unmaintained, and as described in [1], no