branch: externals/ftable
commit 2b08dc96d287517d02bf49c1ca785e765a92f0fb
Author: Yuan Fu <caso...@gmail.com>
Commit: Yuan Fu <caso...@gmail.com>
Init
* README.org: New file.
* ftable.gif: New file.
* ftable.el: New file.
---
README.org | 23 +++
ftable.el | 626 +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
ftable.gif | Bin 0 -> 368933 bytes
3 files changed, 649 insertions(+)
diff --git a/README.org b/README.org
new file mode 100644
index 0000000..5f68a96
--- /dev/null
+++ b/README.org
@@ -0,0 +1,23 @@
+#+TITLE: ftable.el
+
+This package provides some convenient commands for filling a table, i.e.,
adjusting the layout of the table so it can fit in n columns.
+
+[[./ftable.gif]]
+
+Commands provided:
+
+- ftable-fill :: Fill the table at point
+- ftable-reformat :: Change the style of the table. For example, from
+#+begin_example
+ ASCII +--+--+ to Unicode ┌──┬──┐
+ | | | │ │ │
+ +--+--+ └──┴──┘
+#+end_example
+
+- ftable-edit-cell :: Edit the cell at point
+
+There are some limitations. Currently ftable doesn’t support tables with
compound cells (cells that span multiple rows/columns) because they are more
complicated to handle. If the need arises in the future (unlikely), I might
improve ftable to handle more complex tables. Also, after filling, any manual
line breaks in a cell is discarded.
+
+* Customization
+
+- ftable-fill-column :: ~fill-column~ for ftable.
diff --git a/ftable.el b/ftable.el
new file mode 100644
index 0000000..df01b4d
--- /dev/null
+++ b/ftable.el
@@ -0,0 +1,626 @@
+;;; ftable.el --- Fill a table to fit in n columns -*- lexical-binding:
t; -*-
+
+;; Author: Yuan Fu <caso...@gmail.com>
+
+;;; This file is NOT part of GNU Emacs
+
+;;; Commentary:
+;;
+;; This package provides some convenient commands for filling a table,
+;; i.e., adjusting the layout of the table so it can fit in n columns.
+;;
+;; Commands provided:
+;;
+;; - ftable-fill Fill the table at point
+;; - ftable-reformat Change the style of the table. For example, from
+;; ASCII +--+--+ to Unicode ┌──┬──┐
+;; | | | │ │ │
+;; +--+--+ └──┴──┘
+;; - ftable-edit-cell Edit the cell at point
+;;
+;; There are some limitations. Currently ftable doesn’t support tables
+;; with compound cells (cells that span multiple rows/columns) because
+;; they are more complicated to handle. If the need arises in the
+;; future (unlikely), I might improve ftable to handle more complex
+;; tables. Also, after filling, any manual line breaks in a cell is
+;; discarded.
+;;
+;; Customization:
+;;
+;; - ftable-fill-column
+
+;;; Code:
+
+(require 'cl-lib)
+(require 'cl-generic)
+(require 'pcase)
+;; (require 'fill) fill.el doesn’t have a provide form.
+
+;;; Customization
+
+(defvar-local ftable-fill-column fill-column
+ "Basically `fill-column' for fill-table.")
+
+;;; Table structure
+
+(cl-defstruct ftable
+ "A table.
+
+COLUMN-WIDTH-LIST A list that records the width (in characters)
+ of each column.
+MIN-WIDTH-LIST A list that records the minimum width (in
+ characters) of each column.
+CELL-MATRIX A list of list of strings. Each string is a cell.
+ Cells don’t contain newlines.
+
+Each cell is a string, the cell doesn’t contain newlines. Column
+width can be smaller than the string length of a cell, in which
+case means the line cell is filled to that width."
+ column-width-list
+ min-width-list
+ matrix)
+
+(cl-deftype ftable-cell () '(satisfies stringp))
+
+(cl-defmethod ftable--row-count ((table ftable))
+ "Return the number of rows in TABLE."
+ (length (ftable-matrix table)))
+
+(cl-defmethod ftable--column-count ((table ftable))
+ "Return the number of columns in TABLE."
+ (length (car (ftable-matrix table))))
+
+;;; Parse
+;;
+;; Transforming between text and table structure
+
+(defvar ftable-box-charset-alist
+ '((ascii . "
++-++
+| ||
++-++
++-++")
+ (unicode . "
+┌─┬┐
+│ ││
+├─┼┤
+└─┴┘"))
+ "An alist of (NAME . CHARSET).
+A charset tells ftable how to parse the table. I.e., what are the
+box drawing characters to use. Don’t forget the first newline.
+NAME is the mnemonic for that charset.")
+
+(defun ftable-box-char (code charset)
+ "Return a specific box drawing character in CHARSET.
+
+Return a string. CHARSET should be like `ftable-box-char-set'.
+Mapping between CODE and position:
+
+ ┌┬┐ 123
+ ├┼┤ <-> 456
+ └┴┘ 789
+
+ ┌─┐ 1 H 3 H: horizontal
+ │ │ <-> V V V: vertical
+ └─┘ 7 H 9
+
+Examples:
+
+ (ftable-box-char 'h charset) => \"─\"
+ (ftable-box-char 2 charset) => \"┬\""
+ (let ((index (pcase code
+ ('h 10)
+ ('v 11)
+ ('n 12)
+ ('s 13)
+ (_ code))))
+
+ (char-to-string
+ (aref charset ; 1 2 3 4 5 6 7 8 9 H V N S
+ (nth index '(nil 1 3 4 11 13 14 16 18 19 2 6 0 7))))))
+
+;; Check `ftable-box-char' with the following form, you should see:
+;; ┌─┬┐
+;; │ ││
+;; ├─┼┤
+;; └─┴┘
+;; (dolist (code '(
+;; 1 h 2 3 n
+;; v s v v n
+;; 4 h 5 6 n
+;; 7 h 8 9 n))
+;; (insert (ftable-box-char code (cdadr ftable-box-charset-alist))))
+
+(cl-defmethod ftable--parse-to ((table-type (eql ftable)) text
+ &optional box-charset)
+ "Parse TEXT into a table of TABLE-TYPE.
+For BOX-CHARSET, see documentation of `ftable-box-charset-alist'.
+It defaults to the first charset."
+ (ignore table-type)
+ ;; TODO Handle parse error.
+ (let ((charset (or box-charset (cdar ftable-box-charset-alist)))
+ line-list
+ matrix
+ buffer)
+ ;; TEXT:
+ ;; ┌──┬─┐
+ ;; │ab│c│
+ ;; ├──┼─┤
+ ;; │de│f│
+ ;; │gh│i│
+ ;; └──┴─┘
+ ;; 1. Split into lines.
+ (setq line-list (split-string text "\n"))
+ ;; LINE-LIST:
+ ;; ("┌──┬─┐" "│ab│c│" "├──┼─┤" "│de│f│" "│gh│i│" "└──┴─┘")
+ ;;
+ ;; 2. Group each line into columns.
+ (dolist (line line-list)
+ (setq line (string-trim line))
+ (if (or (string-prefix-p (ftable-box-char 1 charset) line)
+ (string-prefix-p (ftable-box-char 4 charset) line)
+ (string-prefix-p (ftable-box-char 7 charset) line))
+ ;; Delimiter line, i.e. ┌──┬─┐, ├──┼─┤, etc.
+ (progn (when buffer
+ (push (reverse buffer) matrix))
+ (setq buffer nil))
+ (push (ftable--tokenize-line line charset) buffer)))
+ (setq matrix (reverse matrix))
+ ;; MATRIX:
+ ;; ((("ab" "c")) (("de" "f") ("gh" "i")))
+ ;;
+ ;; 3. Merge lines that belongs to the same row.
+ (setq matrix (mapcar #'ftable--merge-lines matrix))
+ ;; MATRIX:
+ ;; (("ab" "c") ("de gh" "f i"))
+ (make-ftable
+ :column-width-list
+ (mapcar (lambda (column)
+ (apply #'max (mapcar #'length column)))
+ (cl-loop for n from 0 to (1- (length (car matrix)))
+ collect (ftable--nth-column n matrix)))
+ :min-width-list
+ (ftable--min-column-width matrix)
+ :matrix matrix)))
+
+(defun ftable--tokenize-line (text-line box-charset)
+ "Tokenize TEXT-LINE into a list of tokens.
+
+Each token belongs to a cell. I.e.,
+
+ (ftable--tokenize-line \"│a│b│c│\") => (\"a\" \"b\" \"c\")
+
+BOX-CHARSET is the same as in `ftable--parse-to'.
+
+Assumes each line begines with box drawing characters, i.e., no
+white space characters."
+ (cl-assert (string-prefix-p (ftable-box-char 'v box-charset) text-line)
+ t "TEXT-LINE doesn’t begin with box drawing char")
+ (mapcar #'string-trim
+ (split-string (string-trim
+ text-line
+ (ftable-box-char 'v box-charset)
+ (ftable-box-char 'v box-charset))
+ (ftable-box-char 'v box-charset))))
+
+(defun ftable--merge-lines (line-list)
+ "Merge lines in LINE-LIST together.
+
+ (ftable--merge-lines '((\"1\" \"2\" \"3\") (\"a\" \"b\" \"c\")))
+ => (\"1 a\" \"2 b\" \"3 c\")
+
+Assumes each line in LINE-LIST has the same length."
+ (let (row)
+ ;; Initialize ROW.
+ (dotimes (_ (length (nth 0 line-list)))
+ (push "" row))
+ ;; Append cell contents.
+ (dolist (line line-list)
+ (dotimes (col-idx (length line))
+ (setf (nth col-idx row)
+ (concat (nth col-idx row) " "
+ (nth col-idx line)))))
+ (mapcar #'string-trim row)))
+
+(defun ftable--nth-column (n matrix)
+ "Return the Nth column of MATRIX."
+ (mapcar (lambda (row) (nth n row)) matrix))
+
+(defun ftable--min-column-width (matrix)
+ "Return the minimum width of each column in MATRIX."
+ (with-temp-buffer
+ (mapcar (lambda (column)
+ (cl-loop for cell in column
+ maximize
+ (progn
+ (erase-buffer)
+ (insert cell)
+ (let ((fill-column 1))
+ (fill-region-as-paragraph
+ (point-min) (point-max)))
+ (ftable--max-line-width))))
+ (cl-loop for col from 0 to (1- (length (car matrix)))
+ collect (ftable--nth-column col matrix)))))
+
+
+;;; Fill
+
+(cl-defmethod ftable--fill ((table ftable) table-max-width)
+ "Return a new TABLE that fits in TABLE-MAX-WIDTH.
+Try to fit in TABLE-MAX-WIDTH, if not possible, return the
+mininum width table."
+ (let ((desired-width table-max-width)
+ table-height)
+ (when (< table-max-width (ftable--min-width table))
+ (setq desired-width (ftable--min-width table)))
+ ;; While we haven’t satisfied the requirement and there is still
+ ;; room for improvement:
+ (while (< desired-width (ftable--width table))
+ (setq table-height (ftable--height table))
+ (let ((candidate-list
+ ;; A list of (delta of height . new table).
+ (cl-loop
+ for col = 0 then (1+ col)
+ for col-width in (ftable-column-width-list table)
+ for min-width in (ftable-min-width-list table)
+ if (> col-width min-width)
+ collect
+ (let ((new-table
+ (ftable--shrink-column table col 1)))
+ (cons (- (ftable--height new-table)
+ table-height)
+ new-table)))))
+ (if (= 0 (length candidate-list))
+ (debug))
+ (setq table
+ (if (< (length candidate-list) 2)
+ (cdar candidate-list)
+ (cdr
+ (cl-reduce
+ ;; Find argmin(delta of height).
+ (lambda (a b)
+ (if (< (car a) (car b)) a b))
+ candidate-list))))))
+ table))
+
+(cl-defmethod ftable--width ((table ftable))
+ "Return the width of TABLE in characters.
+This width includes all the box drawing characters."
+ (let ((lst (ftable-column-width-list table)))
+ (+ (apply #'+ lst)
+ ;; Plus the horizontal bars.
+ (1+ (length lst))
+ ;; Plus one space padding for each column.
+ (1+ (length lst)))))
+
+(cl-defmethod ftable--min-width ((table ftable))
+ "Return the smallest possible width of TABLE."
+ (let ((lst (ftable-min-width-list table)))
+ (+ (apply #'+ lst)
+ ;; Plus the horizontal bars.
+ (1+ (length lst))
+ ;; Plus one space padding for each column.
+ (1+ (length lst)))))
+
+(cl-defmethod ftable--height ((table ftable))
+ "Return the height of TABLE in chracters.
+This height includes all the box drawing characters."
+ (let ((width-list (ftable-column-width-list table))
+ (matrix (ftable-matrix table)))
+ (+ (cl-loop for row in matrix
+ sum (ftable--row-height row width-list))
+ (1+ (length (ftable-matrix table))))))
+
+(defun ftable--row-height (row column-width-list)
+ "Return the height of ROW.
+Each cell in ROW is first filled according to COLUMN-WIDTH-LIST,
+then the height is calculated."
+ (with-temp-buffer
+ (cl-loop
+ for col from 0 to (1- (length row))
+ ;; For each cell, fill the cell and count lines.
+ maximize (let ((cell (nth col row))
+ (width (nth col column-width-list)))
+ (erase-buffer)
+ (insert cell)
+ (let ((fill-column width))
+ (fill-region-as-paragraph (point-min) (point-max))
+ (count-lines (point-min) (point-max)))))))
+
+(cl-defmethod ftable--shrink-column ((table ftable) n step)
+ "Shrink column N of TABLE by STEP character.
+Return a new table with shrinked column."
+ (let ((width-list (ftable-column-width-list table))
+ (min-list (ftable-min-width-list table))
+ (matrix (ftable-matrix table)))
+ (setf (nth n width-list)
+ (- (nth n width-list) step))
+ (make-ftable
+ :column-width-list width-list
+ :min-width-list min-list
+ :matrix matrix)))
+
+(defun ftable--max-line-width ()
+ "Return the maximum line width in buffer."
+ (apply #'max
+ (mapcar #'length
+ (split-string (buffer-string) "\n"))))
+
+;;; Unparse
+
+(cl-defmethod ftable--unparse ((table ftable) &optional box-charset)
+ "Export TABLE to text form.
+BOX-CHARSET is the same as in `ftable--parse-to'."
+ (let ((charset (or box-charset (cdar ftable-box-charset-alist)))
+ (matrix (ftable-matrix table))
+ (column-width-list (ftable-column-width-list table)))
+ ;; MATRIX:
+ ;; (("abc def" "123")
+ ;; ("ghi" "m"))
+ ;;
+ ;; WIDTH-LIST:
+ ;; (3 3)
+ ;;
+ ;; 1. Split each row into lines.
+ (setq matrix (mapcar (lambda (row)
+ (ftable--split-row row column-width-list))
+ matrix))
+ ;; MATRIX:
+ ;; ((("abc" "123")
+ ;; ("def" ""))
+ ;; (("ghi" "m")))
+ ;;
+ ;; We add a one-space padding to each column (only) when drawing
+ ;; the table.
+ (setq column-width-list (mapcar #'1+ column-width-list))
+ (with-temp-buffer
+ (cl-loop
+ ;; Draw the top border.
+ initially do
+ (ftable--insert-grid-line column-width-list '(1 2 3) charset)
+ for row in matrix
+ ;; Draw lines of each row.
+ do (cl-loop
+ for line in row do
+ (cl-loop initially do
+ (insert (ftable-box-char 'v charset))
+ for column in line
+ for width in column-width-list
+ do (insert (ftable--pad-to column width))
+ do (insert (ftable-box-char 'v charset))
+ finally do (insert "\n")))
+ ;; Draw the separator line.
+ (ftable--insert-grid-line column-width-list '(4 5 6) charset)
+ ;; Draw the bottom border.
+ finally do
+ (progn
+ (forward-line -1)
+ (delete-region (line-beginning-position) (line-end-position))
+ (ftable--insert-grid-line
+ column-width-list '(7 8 9) charset)))
+
+ (string-trim (buffer-string)))))
+
+;; (defun ftable--transpose (matrix)
+;; "Transpose MATRIX."
+;; (cl-loop for col-idx from 0 to (1- (length (car matrix)))
+;; collect
+;; (cl-loop for row in matrix
+;; collect (nth col-idx row))))
+
+(defun ftable--insert-grid-line (column-width-list codeset charset)
+ "Insert a grid line that separates cells vertically.
+For example, ├──┼─┤. COLUMN-WIDTH-LIST is the one in `ftable'
+struct. CODESET is a list of codes that corresponds to the left,
+middle and right box drawing character codes to pass to
+`ftable-box-char'. It can be (1 2 3), (4 5 6), or (7 8 9).
+CHARSET is the same as BOX-CHARSET in `ftable--parse'."
+ (let ((left (ftable-box-char (nth 0 codeset) charset))
+ (middle (ftable-box-char (nth 1 codeset) charset))
+ (right (ftable-box-char (nth 2 codeset) charset)))
+ (cl-loop
+ initially do (insert left)
+ for width in column-width-list
+ do (dotimes (_ width) (insert (ftable-box-char 'h charset)))
+ do (insert middle)
+ finally do (progn (backward-delete-char 1)
+ (insert right "\n")))))
+
+(defun ftable--split-row (row column-width-list)
+ "Split ROW into several lines according to COLUMN-WIDTH-LIST.
+This is the opposite of `ftable--merge-lines'.
+
+Return value has the form of:
+
+ ((abc 123 ...) (def 456 ...) ...)
+
+which corresponds to
+
+ |abc|123|...|
+ |def|456|...|
+ ..."
+ (let (line-count line-list line)
+ (with-temp-buffer
+ (setq row (cl-loop
+ for cell in row
+ for width in column-width-list
+ collect (progn
+ (erase-buffer)
+ (insert cell)
+ (let ((fill-column width))
+ (fill-region-as-paragraph
+ (point-min) (point-max)))
+ (split-string (string-trim (buffer-string))
+ "\n"))))
+ (setq line-count (apply #'max (mapcar #'length row)))
+ (dotimes (idx line-count)
+ (setq line nil)
+ (dolist (cell row)
+ (push (or (nth idx cell) "") line))
+ (push (reverse line) line-list))
+ (reverse line-list))))
+
+(defun ftable--pad-to (text width)
+ "Append padding to TEXT until it is WIDTH characters long.
+Return a new string."
+ (if (< (length text) width)
+ (concat text (make-vector (- width (length text)) ?\s))
+ text))
+
+;;; Convenience
+
+(defun ftable-fill ()
+ "Fill the table (or paragraph) at point."
+ (interactive)
+ (pcase-let ((`(,text ,beg ,end ,tablep , charset)
+ (ftable--table-info)))
+ (if tablep
+ (ftable--replace-text
+ beg end text
+ (string-trim
+ (ftable--unparse
+ (ftable--fill (ftable--parse-to
+ 'ftable text charset)
+ ftable-fill-column)
+ charset)))
+ (fill-paragraph))))
+
+(defun ftable-edit-cell ()
+ "Edit the cell at point."
+ (interactive)
+ (pcase-let* ((pt (point))
+ (p-column (- (point) (line-beginning-position)))
+ (`(,text ,beg ,end ,tablep ,charset) (ftable--table-info))
+ (x -1)
+ ;; If these two characters are the same, we will count
+ ;; one extra.
+ (y (if (equal (ftable-box-char 3 charset)
+ (ftable-box-char 6 charset))
+ -1 0)))
+ (if (not tablep)
+ (user-error "There is no table at point")
+ (save-excursion
+ (goto-char beg)
+ ;; Parse out the coordinate of the cell at point.
+ (while (search-forward
+ (format "%s\n" (ftable-box-char 6 charset))
+ pt t)
+ (cl-incf y))
+ (while (search-forward
+ (ftable-box-char 'v charset)
+ (+ (line-beginning-position) p-column) t)
+ (cl-incf x)))
+ ;; Prompt user to edit.
+ (let* ((table (ftable--parse-to 'ftable text charset))
+ (cell (nth x (nth y (ftable-matrix table))))
+ (new-cell (read-string "Edit: " cell)))
+ (setf (nth x (nth y (ftable-matrix table))) new-cell)
+ ;; Apply change.
+ (ftable--replace-text
+ beg end text
+ (ftable--unparse
+ (ftable--fill table ftable-fill-column)
+ charset))))))
+
+(defun ftable-reformat (style)
+ "Change box drawing STYLE for table at point.
+STYLE can be ’ascii or ’unicode."
+ (interactive (list (intern
+ (downcase
+ (completing-read "Style: "
+ '("ASCII" "Unicode"))))))
+ (pcase-let ((`(,text ,beg ,end ,tablep ,charset)
+ (ftable--table-info)))
+ (if (not tablep)
+ (user-error "There is no table at point")
+ (ftable--replace-text
+ beg end text
+ (ftable--unparse
+ ;; We still need to fill the table, otherwise it will be
+ ;; the widest table layout.
+ (ftable--fill
+ (ftable--parse-to 'ftable text charset)
+ ftable-fill-column)
+ (alist-get style ftable-box-charset-alist))))))
+
+(defun ftable--table-info ()
+ "Return (TEXT BEG END TABLEP CHARSET) for the table at point.
+TEXT is the table’s text. BEG and END are the beginning and end
+position of the table, not including any newlines. TABLEP is t if
+point is on a table, nil if not. CHARSET is the box drawing
+charset used by the table (if there is a table).
+\(See `ftable-box-charset-alist'.)"
+ (let* ((beg (save-excursion (forward-paragraph -1)
+ (skip-chars-forward "\n")
+ (point)))
+ (end (save-excursion (forward-paragraph 1)
+ (skip-chars-backward "\n")
+ (point)))
+ (text (buffer-substring-no-properties
+ beg end)))
+ (append (list text beg end)
+ (cl-loop for charset
+ in (mapcar #'cdr ftable-box-charset-alist)
+ if (equal (substring text 0 1)
+ (ftable-box-char 1 charset))
+ return (list t charset)
+ finally return (list nil nil)))))
+
+(defun ftable--replace-text (beg end text new-text)
+ "Replace TEXT between BEG and END with NEW-TEXT."
+ (unless (equal text new-text)
+ (let ((p (point)))
+ (delete-region beg end)
+ (insert new-text)
+ ;; Go back to roughly where we were.
+ (goto-char p))))
+
+;;; Test
+
+(with-eval-after-load 'ert
+ (ert-deftest ftable--misc-test ()
+ (let ((text (string-trim "
+┌──┬─┐
+│ab│c│
+├──┼─┤
+│de│f│
+│gh│i│
+└──┴─┘")))
+ (should (equal
+ (ftable--parse-to 'ftable text
+ (cdadr ftable-box-charset-alist))
+ (make-ftable
+ :column-width-list '(5 3)
+ :min-width-list '(2 1)
+ :matrix '(("ab" "c") ("de gh" "f i"))))))
+ ;; ftable--tokenize-line
+ (should (equal (mapcar (lambda (x)
+ (ftable--tokenize-line
+ x (cdadr ftable-box-charset-alist)))
+ '( "│ab│c│" "│de│f│" "│gh│i│"))
+ '(("ab" "c") ("de" "f") ("gh" "i") )))
+ (should (equal (ftable--tokenize-line
+ "|fgh| | z|" (cdadr ftable-box-charset-alist))
+ '("fgh" "" "z")))
+ ;; ftable--merge-lines
+ (should (equal (mapcar #'ftable--merge-lines
+ '((("ab" "c")) (("de" "f") ("gh" "i"))))
+ '(("ab" "c") ("de gh" "f i"))))
+ ;; ftable--nth-column
+ (should (equal (ftable--nth-column 1 '((1 2 3) (4 5 6) (7 8 9)))
+ '(2 5 8)))
+ ;; ftable--row-height
+ (should (equal (ftable--row-height '("ab c" "def" "ghi") '(2 3 3))
+ 2))
+ ;; ftable--split-row
+ (should (equal (ftable--split-row '("abc de" "12" "xy z")
+ '(3 2 2))
+ '(("abc" "12" "xy") ("de" "" "z"))))
+ ;; ftable--pad-to
+ (should (equal (ftable--pad-to "123" 5)
+ "123 "))))
+
+
+(provide 'ftable)
+
+;;; ftable.el ends here
diff --git a/ftable.gif b/ftable.gif
new file mode 100644
index 0000000..2cf8552
Binary files /dev/null and b/ftable.gif differ
