From 8743cee4d7ee266076cfcccca0a2772aac597ee0 Mon Sep 17 00:00:00 2001 Message-Id: <8743cee4d7ee266076cfcccca0a2772aac597ee0.1621069602.git.yantar92@gmail.com> From: Ihor Radchenko Date: Sat, 15 May 2021 16:58:54 +0800 Subject: [PATCH] Align table columns pixel-wise * lisp/org-macs.el (org-string-width): Rewrite manual width calculation using `window-text-pixel-size'. Add extra optional argument to get string width in pixels. (org--string-from-props): Removed, as it is no longer needed for `org-string-width'. * lisp/org-table.el (org-table--align-field): Align field pixel-wise. The WIDTH argument should now be in pixel units. The alignment is done by setting 'display text property. (org-table-align): Align fields pixel-wise using new `org-table--align-field' and the same ideas with 'display property. --- lisp/org-macs.el | 121 ++++++++++++++++++++++------------------------ lisp/org-table.el | 69 ++++++++++++++++++++------ 2 files changed, 112 insertions(+), 78 deletions(-) diff --git a/lisp/org-macs.el b/lisp/org-macs.el index cd9fd1d83..ae79ab16c 100644 --- a/lisp/org-macs.el +++ b/lisp/org-macs.el @@ -868,71 +868,64 @@ (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 display-line-numbers nil) + (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. diff --git a/lisp/org-table.el b/lisp/org-table.el index cc69542f9..e8b5add8a 100644 --- a/lisp/org-table.el +++ b/lisp/org-table.el @@ -4313,12 +4313,34 @@ (defun org-table--align-field (field width align) "Format FIELD according to column WIDTH and alignment ALIGN. FIELD is a string. WIDTH is a number. ALIGN is either \"c\", \"l\" or\"r\"." - (let* ((spaces (- width (org-string-width field))) + (let* ((spaces (- width (org-string-width field 'pixels))) + (symbol-width (org-string-width " " 'pixels)) + (right-spaces (/ spaces symbol-width)) + (right-pixels (- spaces (* symbol-width right-spaces))) + (centered-spaces (/ (/ spaces 2) symbol-width)) + (centered-pixels (- (/ spaces 2) (* symbol-width centered-spaces))) (prefix (pcase align ("l" "") - ("r" (make-string spaces ?\s)) - ("c" (make-string (/ spaces 2) ?\s)))) - (suffix (make-string (- spaces (length prefix)) ?\s))) + ("r" (concat (make-string right-spaces ?\s) + ;; Align to non-fixed width. + (if (zerop right-pixels) "" + (propertize " " + 'display + `(space . (:width (,right-pixels))))))) + ("c" (concat (make-string centered-spaces ?\s) + ;; Align to non-fixed width. + (if (zerop centered-pixels) "" + (propertize " " + 'display + `(space . (:width (,centered-pixels))))))))) + (suffix-spaces (/ (- spaces (org-string-width prefix 'pixel)) symbol-width)) + (suffix-pixels (- (- spaces (org-string-width prefix 'pixel)) (* symbol-width suffix-spaces))) + (suffix (concat (make-string suffix-spaces ?\s) + ;; Align to non-fixed width. + (if (zerop suffix-pixels) "" + (propertize " " + 'display + `(space . (:width (,suffix-pixels)))))))) (concat org-table-separator-space prefix field @@ -4342,7 +4364,8 @@ (defun org-table-align () (rows (remq 'hline table)) (widths nil) (alignments nil) - (columns-number 1)) + (columns-number 1) + (symbol-width (org-string-width "-" 'pixels))) (if (null rows) ;; Table contains only horizontal rules. Compute the ;; number of columns anyway, and choose an arbitrary width @@ -4352,17 +4375,17 @@ (defun org-table-align () (while (search-forward "+" end t) (cl-incf columns-number))) (setq widths (make-list columns-number 1)) - (setq alignments (make-list columns-number "l"))) + (setq alignments (make-list (* columns-number symbol-width) "l"))) ;; Compute alignment and width for each column. (setq columns-number (apply #'max (mapcar #'length rows))) (dotimes (i columns-number) - (let ((max-width 1) + (let ((max-width symbol-width) (fixed-align? nil) (numbers 0) (non-empty 0)) (dolist (row rows) (let ((cell (or (nth i row) ""))) - (setq max-width (max max-width (org-string-width cell))) + (setq max-width (max max-width (org-string-width cell 'pixels))) (cond (fixed-align? nil) ((equal cell "") nil) ((string-match "\\`<\\([lrc]\\)[0-9]*>\\'" cell) @@ -4386,9 +4409,18 @@ (defun org-table-align () ;; Build new table rows. Only replace rows that actually ;; changed. (let ((rule (and (memq 'hline table) - (mapconcat (lambda (w) (make-string (+ 2 w) ?-)) - widths - "+"))) + (mapconcat + (lambda (w) + (let* ((hline-dahes (+ 2 (/ w symbol-width))) + (hline-pixels (- w (* symbol-width (/ w symbol-width))))) + (concat (make-string hline-dahes ?-) + ;; Align to non-fixed width. + (if (zerop hline-pixels) "" + (propertize " " + 'display + `(:width (,hline-pixels))))))) + widths + "+"))) (indent (progn (looking-at "[ \t]*|") (match-string 0)))) (dolist (row table) (let ((previous (buffer-substring (point) (line-end-position))) @@ -4408,9 +4440,18 @@ (defun org-table-align () "|"))) "|"))) (if (equal new previous) - (forward-line) - (insert new "\n") - (delete-region (point) (line-beginning-position 2)))))) + (if (equal-including-properties new previous) + (forward-line) + (let ((pos 0) next) + (while (< pos (length new)) + (setq next (or (next-single-property-change pos 'display new) + (length new))) + (when (get-text-property pos 'display new) + (put-text-property (+ pos (point)) (+ next (point)) 'display (get-text-property pos 'display new))) + (setq pos next))) + (forward-line)) + (insert new "\n") + (delete-region (point) (line-beginning-position 2)))))) (set-marker end nil) (when org-table-overlay-coordinates (org-table-overlay-coordinates)) (setq org-table-may-need-update nil)))))) -- 2.26.3