/misc/fuel/fuel-table.el

http://github.com/abeaumont/factor · Emacs Lisp · 139 lines · 111 code · 18 blank · 10 comment · 0 complexity · 22dfd76f809dd19ebb9b4f0f0ecff589 MD5 · raw file

  1. ;;; fuel-table.el -- table creation
  2. ;; Copyright (C) 2009 Jose Antonio Ortega Ruiz
  3. ;; See http://factorcode.org/license.txt for BSD license.
  4. ;; Author: Jose Antonio Ortega Ruiz <jao@gnu.org>
  5. ;; Keywords: languages, fuel, factor
  6. ;; Start date: Tue Jan 06, 2009 13:44
  7. ;;; Comentary:
  8. ;; Utilities to insert ascii tables.
  9. ;;; Code:
  10. (defun fuel-table--col-widths (rows)
  11. (let* ((col-no (length (car rows)))
  12. (available (- (window-width) 2 (* 2 col-no)))
  13. (widths)
  14. (c 0))
  15. (while (< c col-no)
  16. (let ((width 0)
  17. (av-width (- available (* 5 (- col-no c)))))
  18. (dolist (row rows)
  19. (setq width
  20. (min av-width
  21. (max width (length (nth c row))))))
  22. (push width widths)
  23. (setq available (- available width)))
  24. (setq c (1+ c)))
  25. (reverse widths)))
  26. (defun fuel-table--pad-str (str width)
  27. (let ((len (length str)))
  28. (cond ((= len width) str)
  29. ((> len width) (concat (substring str 0 (- width 3)) "..."))
  30. (t (concat str (make-string (- width (length str)) ?\ ))))))
  31. (defun fuel-table--str-lines (str width)
  32. (if (<= (length str) width)
  33. (list (fuel-table--pad-str str width))
  34. (with-temp-buffer
  35. (let ((fill-column width))
  36. (insert str)
  37. (fill-region (point-min) (point-max))
  38. (mapcar '(lambda (s) (fuel-table--pad-str s width))
  39. (split-string (buffer-string) "\n"))))))
  40. (defun fuel-table--pad-row (row)
  41. (let* ((max-ln (apply 'max (mapcar 'length row)))
  42. (result))
  43. (dolist (lines row)
  44. (let ((ln (length lines)))
  45. (if (= ln max-ln) (push lines result)
  46. (let ((lines (reverse lines))
  47. (l 0)
  48. (blank (make-string (length (car lines)) ?\ )))
  49. (while (< l ln)
  50. (push blank lines)
  51. (setq l (1+ l)))
  52. (push (reverse lines) result)))))
  53. (reverse result)))
  54. (defun fuel-table--format-rows (rows widths)
  55. (let ((col-no (length (car rows)))
  56. (frows))
  57. (dolist (row rows)
  58. (let ((c 0) (frow))
  59. (while (< c col-no)
  60. (push (fuel-table--str-lines (nth c row) (nth c widths)) frow)
  61. (setq c (1+ c)))
  62. (push (fuel-table--pad-row (reverse frow)) frows)))
  63. (reverse frows)))
  64. (defvar fuel-table-corner-lt "┌")
  65. (defvar fuel-table-corner-lb "└")
  66. (defvar fuel-table-corner-rt "┐")
  67. (defvar fuel-table-corner-rb "┘")
  68. (defvar fuel-table-line "─")
  69. (defvar fuel-table-tee-t "┬")
  70. (defvar fuel-table-tee-b "┴")
  71. (defvar fuel-table-tee-l "├")
  72. (defvar fuel-table-tee-r "┤")
  73. (defvar fuel-table-crux "┼")
  74. (defvar fuel-table-sep "│")
  75. (defun fuel-table--insert-line (widths first last sep)
  76. (insert first fuel-table-line)
  77. (dolist (w widths)
  78. (while (> w 0)
  79. (insert fuel-table-line)
  80. (setq w (1- w)))
  81. (insert fuel-table-line sep fuel-table-line))
  82. (delete-char -2)
  83. (insert fuel-table-line last)
  84. (newline))
  85. (defun fuel-table--insert-first-line (widths)
  86. (fuel-table--insert-line widths
  87. fuel-table-corner-lt
  88. fuel-table-corner-rt
  89. fuel-table-tee-t))
  90. (defun fuel-table--insert-middle-line (widths)
  91. (fuel-table--insert-line widths
  92. fuel-table-tee-l
  93. fuel-table-tee-r
  94. fuel-table-crux))
  95. (defun fuel-table--insert-last-line (widths)
  96. (fuel-table--insert-line widths
  97. fuel-table-corner-lb
  98. fuel-table-corner-rb
  99. fuel-table-tee-b))
  100. (defun fuel-table--insert-row (r)
  101. (let ((ln (length (car r)))
  102. (l 0))
  103. (while (< l ln)
  104. (insert (concat fuel-table-sep " "
  105. (mapconcat 'identity
  106. (mapcar `(lambda (x) (nth ,l x)) r)
  107. (concat " " fuel-table-sep " "))
  108. " " fuel-table-sep "\n"))
  109. (setq l (1+ l)))))
  110. (defun fuel-table--insert (rows)
  111. (let* ((widths (fuel-table--col-widths rows))
  112. (rows (fuel-table--format-rows rows widths)))
  113. (fuel-table--insert-first-line widths)
  114. (dolist (r rows)
  115. (fuel-table--insert-row r)
  116. (fuel-table--insert-middle-line widths))
  117. (kill-line -1)
  118. (fuel-table--insert-last-line widths)))
  119. (provide 'fuel-table)
  120. ;;; fuel-table.el ends here