[elpa] externals/valign 29bf04f 001/198: Init

[Stefan Monnier]

branch: externals/valign
commit 29bf04f12f1e95de62510d6b7e87b31d736f35cf
Author: Yuan Fu <casouri@gmail.com>
Commit: Yuan Fu <casouri@gmail.com>

    Init
---
 valign.el | 334 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
 1 file changed, 334 insertions(+)

diff --git a/valign.el b/valign.el
new file mode 100644
index 0000000..4f813c4
--- /dev/null
+++ b/valign.el
@@ -0,0 +1,334 @@
+;;; valign.el --- Visually align tables      -*- lexical-binding: t; -*-
+
+;; Author: Yuan Fu <casouri@gmail.com>
+
+;;; This file is NOT part of GNU Emacs
+
+;;; Commentary:
+;;
+;; This package provides visual alignment for Org tables on GUI Emacs.
+;; It can properly align tables containing variable font, CJK
+;; character and images. In the meantime, the text-based alignment
+;; generated by Org mode is left untouched.
+;;
+;; To use this package, load it and run M-x valign-setup RET. And any
+;; Org tables in Org mode should be automatically aligned. If you want
+;; to align a table manually, run M-x valign-table RET on a Org table.
+
+;;; Code:
+;;
+
+(require 'cl-lib)
+
+;;; Backstage
+
+(define-error 'valign-bad-cell "Valign encountered a invalid table cell")
+(define-error 'valign-werid-alignment
+  "Valign expects one space between the cell’s content and either the left bar 
or the right bar, but this cell seems to violate that assumption")
+
+(defun valign--cell-alignment ()
+  "Return how is current cell aligned.
+Return 'left if aligned left, 'right if aligned right.
+Assumes point is after the left bar (“|”).
+Doesn’t check if we are in a cell."
+  (save-excursion
+    (let ((p (point)))
+      (if (looking-at " [^ ]")
+          'left
+        (if (not (search-forward "|" nil t))
+            (signal 'valign-bad-cell nil)
+          (if (looking-back
+               "[^ ] |" (max (- (point) 3) (point-min)))
+              'right
+            (signal 'valign-werid-alignment nil)))))))
+
+;; (if (string-match (rx (seq (* " ")
+;;                            ;; e.g., “5.”, “5.4”
+;;                            (or (seq (? (or "-" "+"))
+;;                                     (+ digit)
+;;                                     (? "\\.")
+;;                                     (* digit))
+;;                                ;; e.g., “.5”
+;;                                (seq (? (or "-" "+"))
+;;                                     "\\."
+;;                                     (* digit)))
+;;                            (* " ")))
+;;                   (buffer-substring p (1- (point))))
+;;     'right 'left)
+
+(defun valign--cell-width ()
+  "Return the pixel width of the cell at point.
+Assumes point is after the left bar (“|”).
+Return nil if not in a cell."
+  (let (start)
+    (save-excursion
+      (valign--skip-space-forward)
+      (setq start (point))
+      (if (not (search-forward "|" nil t))
+          (signal 'valign-bad-cell nil)
+        ;; We are at the right “|”
+        (backward-char)
+        (valign--skip-space-backward)
+        (valign--glyph-width-from-to start (point))))))
+
+(defun valign--glyph-width-at-point (&optional point)
+  "Return the pixel width of the glyph at POINT.
+The buffer has to be visible. If point is at an image, this
+function doens’t return the image’s width, but the underlining
+character’s glyph width."
+  (let* ((p (or point (point))))
+    ;; car + mapcar to translate the vector to a list.
+    (aref (car (mapcar
+                #'identity (font-get-glyphs (font-at p) p (1+ p))))
+          4)))
+
+(defun valign--pixel-width-from-to (from to)
+  "Return the width of the glyphs from FROM (inclusive) to TO (exclusive).
+The buffer has to be visible. FROM has to be less than TO. Unlike
+‘valign--glyph-width-at-point’, this function can properly
+calculate images pixel width."
+  (let ((width 0))
+    (save-excursion
+      (goto-char from)
+      (while (< (point) to)
+        (let ((display (plist-get (text-properties-at (point))
+                                  'display)))
+          ;; This is an image, add image width.
+          (if (and (consp display) (eq (car display) 'image))
+              (progn (setq width (+ width (car (image-size display t))))
+                     (goto-char
+                      (next-single-property-change (point) 'display)))
+            ;; This is a normal character, add glyph width.
+            (setq width (+ width (valign--glyph-width-at-point)))
+            (forward-char)))))
+    width))
+
+(defun valign--skip-space-backward ()
+  "Like (skip-chars-forward \" \").
+But we don’t skip over chars with display property."
+  (while (and (eq (char-before) ?\s)
+              (let ((display
+                     (plist-get (text-properties-at (1- (point)))
+                                'display)))
+                ;; When do we stop: when there is a display property
+                ;; and it’s not a stretch property.
+                (not (and display
+                          (consp display)
+                          (not (eq (car display) 'space))))))
+    (backward-char)))
+
+(defun valign--skip-space-forward ()
+  "Like (skip-chars-backward \" \").
+But we don’t skip over chars with display property."
+  (while (and (eq (char-after) ?\s)
+              (let ((display
+                     (plist-get (text-properties-at (point))
+                                'display)))
+                ;; When do we stop: when there is a display property
+                ;; and it’s not a stretch property.
+                (not (and display
+                          (consp display)
+                          (not (eq (car display) 'space))))))
+    (forward-char)))
+
+(defun valign--sperator-p ()
+  "If the current cell is actually a separator.
+Assume point is after the left bar (“|”)."
+  (and (eq (char-before) ?|)
+       (eq (char-after) ?-)))
+
+(defmacro valign--do-table (column-idx-sym limit &rest body)
+  "Go to each cell of a table and evaluate BODY.
+In each cell point stops after the left “|”.
+Bind COLUMN-IDX-SYM to the column index (0-based).
+Don’t go over LIMIT."
+  (declare (indent 2))
+  `(progn
+     (setq ,column-idx-sym -1)
+     (while (and (cl-incf ,column-idx-sym)
+                 (search-forward "|" nil t)
+                 (< (point) ,limit))
+       (if (eq (char-after (point)) ?\n)
+           ;; We are after the last “|” of a line.
+           (setq ,column-idx-sym -1)
+         ;; Point is after the left “|”.
+         (progn ,@body)))))
+
+(defun valign--calculate-column-width-list (limit)
+  "Return a list of column widths.
+Each column width is the largest cell width of the column.
+Start from point, stop at LIMIT."
+  (let (column-width-alist
+        column-idx)
+    (save-excursion
+      (valign--do-table column-idx limit
+        ;; Point is after the left “|”.
+        ;;
+        ;; Calculate this column’s pixel width, record it if it
+        ;; is the largest one for this column.
+        (unless (valign--sperator-p)
+          (let ((oldmax (alist-get column-idx column-width-alist))
+                (cell-width (valign--cell-width)))
+            (if (> cell-width (or oldmax 0))
+                (setf (alist-get column-idx column-width-alist)
+                      cell-width))))))
+    ;; Turn alist into a list.
+    (let ((inc 0) return-list)
+      (while (alist-get inc column-width-alist)
+        ;; Add 16 pixels of padding.
+        (push (+ (alist-get inc column-width-alist) 16)
+              return-list)
+        (cl-incf inc))
+      (nreverse return-list))))
+
+(defun valign--beginning-of-table ()
+  "Go backward to the beginning of the table at point.
+Assumes point is on a table. Return nil if failed, point
+otherwise."
+  (beginning-of-line)
+  (if (not (eq (char-after) ?|))
+      nil
+    (while (eq (char-after) ?|)
+      (forward-line -1))
+    (unless (eq (char-after) ?|)
+      (forward-line))
+    (point)))
+
+(defun valign--end-of-table ()
+  "Go forward to the end of the table at point.
+Assumes point is on a table. Return nil if failed, point
+otherwise."
+  (beginning-of-line)
+  (if (not (eq (char-after) ?|))
+      nil
+    (while (eq (char-after) ?|)
+      (forward-line 1))
+    (backward-char)
+    (point)))
+
+(defun valign--put-text-property (beg end xpos)
+  "Put text property on text from BEG to END.
+The text property asks Emacs do display the text as
+white space stretching to XPOS, a pixel x position."
+  (with-silent-modifications
+    (put-text-property
+     beg end 'display
+     `(space :align-to (,xpos)))))
+
+(defun valign-initial-alignment (beg end)
+  "Perform initial alignment for tables between BEG and END.
+Supposed to be called from jit-lock."
+  (if (text-property-any beg end 'valign-init nil)
+      (save-excursion
+        (goto-char beg)
+        (while (and (search-forward "|" nil t)
+                    (< (point) end))
+          (valign-table)
+          (valign--end-of-table))
+        (put-text-property beg (point) 'valign-init t)))
+  (cons 'jit-lock-bounds (cons beg end)))
+
+(defun valign--align-separator-row (total-width)
+  "Align the separator row (|---+---|).
+Assumes the point is after the left bar (“|”). TOTAL-WIDTH is the
+pixel width counting from the left of the left bar to the left of
+the right bar."
+  (let ((p (point)))
+    (when (search-forward "|" nil t)
+      (valign--put-text-property
+       p (1- (point)) total-width)
+      ;; Why do we have to add an overlay? Because text property
+      ;; doens’t work. First, font-lock overwrites what ever face
+      ;; property you add; second, even if you are sneaky and added a
+      ;; font-lock-face property, it is overwritten by the face
+      ;; property (org-table, in this case).
+      (dolist (ov (overlays-in p (1- (point))))
+        (if (overlay-get ov 'valign)
+            (delete-overlay ov)))
+      (let ((ov (make-overlay p (1- (point)))))
+        (overlay-put ov 'face '(:strike-through t))
+        (overlay-put ov 'valign t)))))
+
+;;; Userland
+
+(defun valign-table ()
+  "Visually align the table at point."
+  (interactive)
+  (condition-case err
+      (save-excursion
+        (let (end column-width-list column-idx pos ssw bar-width
+                  separator-row-point separator-row-end-pos)
+          (if (not (valign--end-of-table))
+              (user-error "Not on a table"))
+          (setq end (point))
+          (valign--beginning-of-table)
+          (setq column-width-list
+                (valign--calculate-column-width-list end))
+          ;; Iterate each line and apply tab stops.
+          (valign--do-table column-idx end
+            (if (valign--sperator-p)
+                (setq separator-row-point (point))
+              (save-excursion
+                (when (save-excursion (search-forward "|" nil t))
+                  ;; We are after the left bar (“|”).
+                  ;; Start aligning this cell.
+                  (let* ((col-width (or (nth column-idx column-width-list)
+                                        0))
+                         (cell-width (valign--cell-width))
+                         ;; single-space-width
+                         (ssw (or ssw (valign--glyph-width-at-point)))
+                         (bar-width (or bar-width
+                                        (valign--glyph-width-at-point
+                                         (1- (point)))))
+                         tab-width tab-start tab-end)
+                    ;; Initialize some numbers.
+                    (if (eq column-idx 0)
+                        (setq pos (valign--pixel-width-from-to
+                                   (line-beginning-position) (point))))
+                    ;; Align an empty cell.
+                    (if (eq cell-width 0)
+                        (progn
+                          (setq tab-start (point))
+                          (valign--skip-space-forward)
+                          (valign--put-text-property
+                           tab-start (point) (+ pos col-width ssw)))
+                      ;; Align a left-aligned cell.
+                      (pcase (valign--cell-alignment)
+                        ('left (search-forward "|" nil t)
+                               (backward-char)
+                               (setq tab-end (point))
+                               (valign--skip-space-backward)
+                               (valign--put-text-property
+                                (point) tab-end
+                                (+ pos col-width ssw)))
+                        ;; Align a right-aligned cell.
+                        ('right (setq tab-width
+                                      (- col-width cell-width))
+                                (setq tab-start (point))
+                                (valign--skip-space-forward)
+                                (valign--put-text-property
+                                 tab-start (point)
+                                 (+ pos tab-width)))))
+                    (setq pos (+ pos col-width bar-width ssw))
+                    (setq separator-row-end-pos (- pos bar-width)))))))
+          ;; After aligning all rows, align the separator row.
+          (goto-char separator-row-point)
+          (valign--align-separator-row separator-row-end-pos)))
+    
+    (valign-bad-cell (message (error-message-string err)))
+    (valign-werid-alignment (message (error-message-string err)))))
+
+(defun valign-setup ()
+  "Enable visual table alignment."
+  (interactive)
+  (when window-system
+    (add-hook 'org-mode-hook
+              (lambda ()
+                (add-hook 'jit-lock-functions
+                          #'valign-initial-alignment 90 t)))
+    (advice-add #'org-table-next-field :after #'valign-table)
+    (advice-add #'org-table-previous-field :after #'valign-table)))
+
+(provide 'valign)
+
+;;; valign.el ends here