Using font-lock to align tags in org buffers

Using font-lock to align tags in org buffers

[Ihor Radchenko]

Hello,

Currently, org does tag alignment by adding a number of spaces before
the tags. This becomes messy when one changes the window size and turns
off line truncation.

I came up with an experimental code utilising 'display text property and
font-lock to align tags dynamically, as you resize the Emacs frame.

If anyone is interested, the code is below:

-------------------------------------------------------------------------
  (defun 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))
      (when (fboundp mode)
        (funcall mode)
        (font-lock-fontify-buffer))
      (if (not (get-buffer-window (current-buffer)))
  	(save-window-excursion
            ;; Avoid errors if the selected window is a dedicated one,
            ;; and they just want to insert a document into it.
            (set-window-dedicated-p nil nil)
  	  (set-window-buffer nil (current-buffer))
  	  (car (window-text-pixel-size nil (line-beginning-position) (point))))
        (car (window-text-pixel-size nil (line-beginning-position) (point))))))

  (setq org-auto-align-tags nil)
  (add-hook 'org-mode-hook (lambda () (font-lock-add-keywords nil '(yant/org-align-tags) t)) 100)
  (add-hook 'org-mode-hook (lambda () (add-to-list 'font-lock-extra-managed-props 'org-tag-aligned)))

  (defun yant/org-align-tags (limit)
    "Align all the tags in org buffer."
    (while (re-search-forward "^\\*+ \\(.+?\\)\\([ \t]+\\)\\(:\\(?:[^ \n]+:\\)+\\)$" limit t)
      (when (and (match-string 2)
		 (not (get-text-property (match-beginning 2) 'org-tag-aligned)))
	(with-silent-modifications
          (put-text-property (match-beginning 2) (match-end 2) 'org-tag-aligned t)
	  (put-text-property (match-beginning 2)
			     (match-end 2)
			     'display
			     `(space . (:align-to (- right
						     (,(+ (string-display-pixel-width org-ellipsis)
							  (string-display-pixel-width (or (match-string 3)
											  ""))))))))))))
-------------------------------------------------------------------------

The same approach can be used to align tags in agenda:

-------------------------------------------------------------------------
  (defun org-agenda-fix-tag-alignment ()
    "Use 'display :align-to instead of spaces in agenda."
    (goto-char (point-min))
    (setq-local word-wrap nil) ; tags would be moved to next line if `word-wrap'` is non-nil and `truncate-lines' is nil
    (while (re-search-forward org-tag-group-re nil 'noerror)
      (put-text-property (match-beginning 0) (match-beginning 1) 'display `(space . (:align-to (- right (,(string-display-pixel-width (match-string 1)))))))))
  
  (add-hook 'org-agenda-finalize-hook #'org-agenda-fix-tag-alignment)
-------------------------------------------------------------------------

Best,
Ihor


-- 
Ihor Radchenko,
PhD,
Center for Advancing Materials Performance from the Nanoscale (CAMP-nano)
State Key Laboratory for Mechanical Behavior of Materials, Xi'an Jiaotong University, Xi'an, China
Email: yantar92@gmail.com, ihor_radchenko@alumni.sutd.edu.sg