Emacs Lisp: rcd-box.el package for table drawings

;;; rcd-box.el --- RCD Box Drawings  -*- lexical-binding: t; -*-

;; Copyright (C) 2022 by Jean Louis

;; Author: Jean Louis <bugs@gnu.support>
;; Version: 0.11
;; Package-Requires: (seq)
;; Keywords: data lisp tools
;; URL: https://hyperscope.link/7/3/9/8/1/Emacs-Lisp-rcd-box-el-package-for-table-drawings-73981.html

;; This file is not part of GNU Emacs.

;; This program is free software: you can redistribute it and/or
;; modify it under the terms of the GNU General Public License as
;; published by the Free Software Foundation, either version 3 of the
;; License, or (at your option) any later version.
;;
;; This program is distributed in the hope that it will be useful, but
;; WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
;; General Public License for more details.
;;
;; You should have received a copy of the GNU General Public License
;; along with this program. If not, see <http://www.gnu.org/licenses/>.

;;; Commentary:

;;
;; (rcd-box-table '(("Transport to Makindye" 1 20.00)
;; 		 ("Mobile charges" 1 2000))
;; 	        '("Description" "Quantity" "Subtotal")
;; 	        '("left" "center" "right")) ⇒ "
;; ╔═══════════════════════╦══════════╦══════════╗
;; ║ Description           ║ Quantity ║ Subtotal ║
;; ╠═══════════════════════╬══════════╬══════════╣
;; ║ Transport to Makindye ║    1     ║     20.0 ║
;; ╠═══════════════════════╬══════════╬══════════╣
;; ║ Mobile charges        ║    1     ║     2000 ║
;; ╚═══════════════════════╩══════════╩══════════╝
;;
;; "
;; Available box drawing types: DOUBLE, HEAVY, LIGHT
;;

;;; Change Log:

;;; Code:

;;; Requires

(require 'seq)

;;; Text alignment

(defun rcd-align-left (text width)
  "Left align TEXT within WIDTH of spaces."
  (let ((length (length text)))
    (cond ((< width length) (user-error "Width less than length of string"))
	  ((= width length) text)
	  ((> (1+ width) length) (concat " " text (make-string (- width 1 length) (string-to-char " ")))))))

(defun rcd-align-right (text width)
  "Right align TEXT within WIDTH of spaces."
  (let ((length (length text)))
    (cond ((< width length) (user-error "Width less than length of string"))
	  ((= width length) text)
	  ((> (1+ width) length) (concat (make-string (- width 1 length) (string-to-char " ")) text " ")))))

(defun rcd-align-center (text width)
  "Center align TEXT within WIDTH of spaces."
  (let ((length (length text)))
    (cond ((< width length) (user-error "Width less than length of string"))
	  ((= width length) text)
	  ((= width (1+ length)) (concat " " text))
	  ((= width (+ 2 length)) (concat " " text " "))
	  ((= width (+ 3 length)) (concat " " text "  "))
	  ((>= width (+ 4 length)) (let* ((remainder (- width length))
					 (is-even (eq (logand remainder 1) 0))
					 (side-left (cond (is-even (/ remainder 2))
							  (t (truncate (/ remainder 2)))))
					 (side-right (cond (is-even (/ remainder 2))
							   (t (- remainder (/ remainder 2))))))
				    (concat (make-string side-left (string-to-char " "))
					    text
					    (make-string side-right (string-to-char " "))))))))

;;; Box drawings

(defun rcd-box-vertical (type)
  "Return box drawing vertical TYPE."
  (char-to-string (char-from-name (concat "BOX DRAWINGS " (upcase type) " VERTICAL"))))

(defun rcd-box-horizontal (type)
  "Return box drawing horizontal TYPE."
  (char-to-string (char-from-name (concat "BOX DRAWINGS " (upcase type) " HORIZONTAL"))))

(defun rcd-box-down-and-right (type)
  "Return box drawing horizontal and right TYPE."
  (char-to-string (char-from-name (concat "BOX DRAWINGS " (upcase type) " DOWN AND RIGHT"))))

(defun rcd-box-down-and-left (type)
  "Return box drawing down and left TYPE."
  (char-to-string (char-from-name (concat "BOX DRAWINGS " (upcase type) " DOWN AND LEFT"))))

(defun rcd-box-up-and-right (type)
  "Return box drawing up and right TYPE."
  (char-to-string (char-from-name (concat "BOX DRAWINGS " (upcase type) " UP AND RIGHT"))))

(defun rcd-box-up-and-left (type)
  "Return box drawing up and left TYPE."
  (char-to-string (char-from-name (concat "BOX DRAWINGS " (upcase type) " UP AND LEFT"))))

(defun rcd-box-down-and-horizontal (type)
  "Return box drawing down and horizontal TYPE."
  (char-to-string (char-from-name (concat "BOX DRAWINGS " (upcase type) " DOWN AND HORIZONTAL"))))

(defun rcd-box-up-and-horizontal (type)
  "Return box drawing up and horizontal TYPE."
  (char-to-string (char-from-name (concat "BOX DRAWINGS " (upcase type) " UP AND HORIZONTAL"))))

(defun rcd-box-vertical-and-right (type)
  "Return box drawing vertical and right TYPE."
  (char-to-string (char-from-name (concat "BOX DRAWINGS " (upcase type) " VERTICAL AND RIGHT"))))

(defun rcd-box-vertical-and-left (type)
  "Return box drawing vertical and left TYPE."
  (char-to-string (char-from-name (concat "BOX DRAWINGS " (upcase type) " VERTICAL AND LEFT"))))

(defun rcd-box-vertical-and-horizontal (type)
  "Return box drawing vertical and horizontal TYPE."
  (char-to-string (char-from-name (concat "BOX DRAWINGS " (upcase type) " VERTICAL AND HORIZONTAL"))))

;;; Box cell functions

(defun rcd-box-cell (text &optional align width type)
  "Return single cell with TEXT.

ALIGN is optional and may be string representing center, left or right.
WIDTH is the expected or fixed with of the cell.
TYPE by default is DOUBLE. This option may be removed later."
  (let* ((type (or type "DOUBLE"))
	 (vertical (rcd-box-vertical type))
	 (text (format "%s" text))
	 (width (or width (+ (length text) 2)))
	 (text (cond ((string= align "center") (rcd-align-center text width))
		     ((string= align "right") (rcd-align-right text width))
		     (t (rcd-align-left text width)))))
    (concat vertical text)))

;;; Box row functions

(defun rcd-box-row (row &optional align width type)
  "Return ROW of cells.

ROW must be list of cells.
ALIGN is optional and may be string representing center, left or right.
WIDTH is the expected or fixed with of the cell.
TYPE by default is DOUBLE. This option may be removed later."
  (let ((type (or type "DOUBLE")))
    (with-temp-buffer
      (while row
	(let ((text (pop row))
	      (align (cond ((listp align) (pop align))
			   (t align))))
	  (insert (rcd-box-cell text align (pop width) type))))
      (insert (rcd-box-vertical type) "\n")
      (buffer-string))))

;;; Box top drawing functions

(defun rcd-box-top-flat (type width)
  "Return flat top of box drawing using TYPE and WIDTH."
  (with-temp-buffer
    (insert (rcd-box-down-and-right type))
    (insert (make-string width (string-to-char (rcd-box-horizontal type))))
    (insert (rcd-box-down-and-left type))
    (insert "\n")
    (buffer-string)))

(defun rcd-box-top (type width columns)
  (with-temp-buffer
    (insert (rcd-box-down-and-right type))
    (while (not (= columns 0))
      (setq columns (1- columns))
      (insert (make-string (pop width) (string-to-char (rcd-box-horizontal type))))
      (when (not (= columns 0))
	(insert (rcd-box-down-and-horizontal type))))
    (insert (rcd-box-down-and-left type))
    (insert "\n")
    (buffer-string)))

;;; Box bottom drawing functions

(defun rcd-box-bottom-flat (type width)
  "Return flat bottom of box drawing using TYPE and WIDTH."
  (with-temp-buffer
    (insert (rcd-box-up-and-right type))
    (insert (make-string width (string-to-char (rcd-box-horizontal type))))
    (insert (rcd-box-up-and-left type))
    (insert "\n")
    (buffer-string)))

(defun rcd-box-bottom (type width columns)
  (with-temp-buffer
    (insert (rcd-box-up-and-right type))
    (while (not (= columns 0))
      (setq columns (1- columns))
      (insert (make-string (pop width) (string-to-char (rcd-box-horizontal type))))
      (when (not (= columns 0))
	(insert (rcd-box-up-and-horizontal type))))
    (insert (rcd-box-up-and-left type))
    (insert "\n")
    (buffer-string)))

;;; Box horizontal drawing functions

(defun rcd-box-horizontal-line (type width columns)
  "Return box drawing horizontal line.

TYPE is by default DOUBLE.
WIDTH relates to single cell width.
COLUMNS represent number of columns."
  (with-temp-buffer
    (insert (rcd-box-vertical-and-right type))
    (while (not (= columns 0))
      (setq columns (1- columns))
      (insert (make-string (pop width) (string-to-char (rcd-box-horizontal type))))
      (when (not (= columns 0))
	(insert (rcd-box-vertical-and-horizontal type))))
    (insert (rcd-box-vertical-and-left type))
    (insert "\n")
    (buffer-string)))

;;; Box calculations

(defun rcd-box-cell-width (list)
  "Calculate the maximum cell width for LIST."
  (let ((list (flatten-list list))
	(width 2))
    (mapc (lambda (cell)
	    (let ((string (format "%s" cell)))
	      (cond ((>= (length string) (1- width)) (setq width (+ 2 (length string)))))))
	  list)
    width))

(defun rcd-box-table-column (elt table)
  "Return column ELT from list of lists TABLE."
  (let ((column '()))
    (mapc (lambda (row)
	    (push (elt row elt) column))
	  table)
    (reverse column)))

(defun rcd-box-column-width (list)
  "Calculate the maximum column width for LIST."
  (let ((width 2))
    (mapc (lambda (elt)
	    (let ((string (format "%s" elt)))
	      (cond ((>= (length string) (1- width)) (setq width (+ 2 (length string)))))))
	  list)
    width))

(defun rcd-box-column-width-list (table)
  (let* ((columns (seq-length (car table)))
	 (column-width-list (make-list columns nil))
	 (count 0))
    (while (< count columns)
      (setf (nth count column-width-list) (rcd-box-column-width (rcd-box-table-column count table)))
      (setq count (1+ count)))
    column-width-list))

;;; Box table functions

(defun rcd-box-table (list &optional header align type)
  "Return table by using LIST data.

LIST shall be list of lists containing table rows. Each element
of the row is considered to be cell of the table.

HEADER must be of same length as single rows.  ALIGN may be
single string \"left\", \"right\" or \"center\", or it may be a
list of same length as header and row lengths containing aligning
specification for each column.

TYPE is by default DOUBLE, it may be HEAVY or LIGHT."
  (let* ((type (or type "DOUBLE"))
	 (length-first (seq-length (car list)))
	 (width (rcd-box-column-width-list (cond (header (append (list header) list))
						 (t list)))))
    (with-temp-buffer
      (insert "\n")
      (insert (rcd-box-top type width length-first))
      (when header
	(when (not (= length-first (seq-length header)))
	  (user-error "Not proper header width"))
	(insert (rcd-box-row header align width type))
	(insert (rcd-box-horizontal-line type width length-first)))
    (while list
      (let ((row (pop list)))
	(when (not (= length-first (seq-length row)))
	  (user-error "Not proper row width"))
	(insert (rcd-box-row row align width type))
	(when list
	  (insert (rcd-box-horizontal-line type width length-first)))))
    (insert (rcd-box-bottom type width length-first))
    (insert "\n")
    (buffer-string))))

(defun rcd-box-text (text &optional header align type)
  "Return box enclosed TEXT.

HEADER is optional.

ALIGN may be \"center\", \"left\" or \"right\" and is rather not
necessary in this function. But if header is longer than TEXT,
you may need it.

TYPE may be \"double\", \"heavy\" or \"light\"."
  (rcd-box-table (list (list text))
		 (cond (header (list header))
		       (t nil))
		       align type))

;;; rcd-box.el ends here