How to better align tags in Org Mode using variable-width font

Question

I prefer using variable-width fonts in Emacs whenever I can. That said, Org Mode tags are horribly aligned when headings use variable-width fonts, even if the tags themselves use fixed-width fonts. Is it possible to continue using variable-width fonts for org headings and have tags properly aligned?

Another acceptable solution would be to customize Org Mode faces by file extension. This would allow the use of fixed-width fonts for org headings in .txt files, where I use a lot of tags, and variable-width fonts for .org files, where I rarely use tags. I just don't know how to customize faces based on file extension.

The first situation, where I continue using variable-width fonts, is preferred; I'm just not hopeful that such a solution exists.

Answer 1

In the Org mode mailing list a patch for this has been suggested in September 2020. All that has to be done is redefine the function org--align-tags-here. Below I reproduce the new function definition suggested in the patch, with some adjustments to make it work with org-indent-mode, ensure that there is always visible space between heading and tag, adapt it for use with override advice, and with code to (re-)align tags when opening a file. It works best for non-negative values of org-tags-column.

Note that the (org-align-tags t) in the Org mode hook slows down opening large Org files: To align tags in a file with 3400 headings (all with tags) and 11000 lines takes me around two seconds.

The code below makes it impossible to type space at the end of a headline with tags in the usual way. However, to type a space at the end of a headline you can either use C-q SPC, or org-edit-headline. You can also uncomment the line (org-fix-tags-on-the-fly) in the source of org-self-insert-command. Use org-set-tags-command to align tags upon creation.

(defun my-org--align-tags-here (to-col)
  "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."
  ;; source: https://list.orgmode.org/[email protected]/
  (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)))
             ;; use this to avoid a 0-width space before tags on long lines:
             (blank-start-col (progn
                                (goto-char blank-start)
                                (current-column)))
             ;; this is to makes it work with org-indent-mode:
             (lpref (if (org-fold-folded-p) 0
                      (length (get-text-property (point) 'line-prefix)))))
        ;; 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 (or (= to-col 0) (< (abs to-col) (1- blank-start-col)))
            ;; Just leave one normal space width
            (remove-text-properties blank-start (1+  blank-start)
                                    '(my-display nil))
          (message "In here: %s" lpref)
          (let ((align-expr
                 (if (> to-col 0)
                     ;; Left-align positive values
                     (+ to-col lpref)
                   ;; 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.
                   `(-  ,(- lpref to-col) (,tags-pixel-width)))))
            (put-text-property blank-start (1+  blank-start)
                               'my-display
                               `(space . (:align-to ,align-expr)))))))))

(defun my-fix-tag-alignment ()
  (setq org-tags-column 70) ;; adjust this
  (advice-add 'org--align-tags-here :override #'my-org--align-tags-here)
  ;; this is needed to make it work with https://github.com/minad/org-modern:
  (add-to-list 'char-property-alias-alist '(display my-display))
  ;; this is needed to align tags upon opening an org file:
  (org-align-tags t))

(add-hook 'org-mode-hook #'my-fix-tag-alignment)

Answer 2

Below is a faster way to align tags, based on this answer in the Org mode mailing list.

(defcustom my-org-tags-right nil
  "When non-nil, align tags according to its value.
Values are like for `org-tags-column', but counting from the
windows right edge instead of from the left."
  :type 'integer)

(defun my-org-align-tags (limit &optional force)
  "Align all the tags in Org buffer up to position LIMIT.
How tags are aligned is determined by `org-tags-column' unless
`my-org-tags-right' is non-nil, in which case it controls alignment."
  (save-match-data
    (when (eq major-mode 'org-mode)
      (let* ((col org-tags-column)
             (rcol my-org-tags-right)
             (charw (frame-char-width))
             (ellipsis-px (my-string-display-pixel-width org-ellipsis))
             (regx "^\\*+ \\(.+?\\)\\([ \t]+\\)\\(:\\(?:[^ \n]+:\\)+\\)$"))
    (while (re-search-forward regx limit t)
          (let* ((blanks (match-string 2))
                 (bstart (match-beginning 2))
                 (bend (match-end 2)))
        (when (and blanks
               (or force
               (not (get-text-property bstart
                                                   'org-tag-aligned))))
          (with-silent-modifications
                (put-text-property
                 bstart bend
                 'org-tag-aligned t)
            (put-text-property
             bstart bend           
             'display
                 (my-org-align-tags--display col rcol charw
                                             ellipsis-px))))))))))

(defun my-org-align-tags--display (col rcol charw ellipsis-px)
  "Constructs the display property for `my-org-align-tags'."
  (cons 'space
        (cond
         (rcol
          (list :align-to
                (list '- 'right
                      (list
                       (+ (* (1+ (abs rcol)) charw)
                          (if (> rcol 0) 0
                            (+ (my-org-align-tags--tags-px)
                               ellipsis-px)))))))
         ((and col (not (equal col 0)))
          (list :align-to
                (list '+ 'left
                      (list
                       (- (* (abs col) charw)
                          (if (> col 0) 0
                            (my-org-align-tags--tags-px)))))))
         (t
          (list :width 1)))))

(defun my-org-align-tags--tags-px ()
  "Calculate pixel width of the regex part matching tags.
Uses match data from `my-org-align-tags'."
  (car (window-text-pixel-size
        (selected-window)
        (match-beginning 3)
        (match-end 3))))

(defun my-string-display-pixel-width (string &optional mode)
  "Calculate pixel width of STRING.
Optional MODE specifies major mode used for display."
  (with-temp-buffer
    (with-silent-modifications
      ;; (setf (buffer-string) string)
      (insert string))
    (when (fboundp mode)
      (funcall mode)
      (font-lock-fontify-buffer))
    (if (get-buffer-window (current-buffer))
    (car (window-text-pixel-size nil (line-beginning-position) (point)))
      (set-window-buffer nil (current-buffer))
      (car (window-text-pixel-size nil (line-beginning-position) (point))))))

(defun my-fix-tag-alignment ()
  (setq org-tags-column -77) ;; adjust this
  (setq my-org-tags-right 0) ;; or this
  (font-lock-add-keywords 'org-mode '(my-org-align-tags) t)
  (add-to-list 'font-lock-extra-managed-props 'org-tag-aligned))

(add-hook 'org-mode-hook  #'my-fix-tag-alignment 91)