FUEL: Much faster and nicer table rendering.

extra/fuel/fuel.factor

@@ -299,9 +299,7 @@ MEMO: fuel-find-word ( name -- word/f )
     fuel-eval-set-result ; inline
 
 : fuel-vocab-help-row ( vocab -- element )
-    [ vocab-name ]
-    [ dup summary " " append swap vocab-status-string append ]
-    bi 2array ;
+    [ vocab-status-string ] [ vocab-name ] [ summary ] tri 3array ;
 
 : fuel-vocab-help-root-heading ( root -- element )
     [ "Children from " prepend ] [ "Other children" ] if* \ $heading swap 2array ;

misc/fuel/fuel-markup.el

@@ -16,9 +16,9 @@
 (require 'fuel-eval)
 (require 'fuel-font-lock)
 (require 'fuel-base)
+(require 'fuel-table)
 
 (require 'button)
-(require 'table)
 
 
 ;;; Customization:
@@ -319,7 +319,9 @@
 
 (defun fuel-markup--vocab-list (e)
   (let ((rows (mapcar '(lambda (elem)
-                         (list (list '$vocab-link (car elem)) (cadr elem)))
+                         (list (car elem)
+                               (list '$vocab-link (cadr elem))
+                               (caddr elem)))
                       (cdr e))))
     (fuel-markup--table (cons '$table rows))))
 
@@ -345,27 +347,9 @@
   (fuel-markup--insert-newline)
   (delete-blank-lines)
   (newline)
-  (let* ((table-time-before-update 0)
-         (table-time-before-reformat 0)
-         (start (point))
-         (col-delim "<~end-of-col~>")
-         (col-no (length (cadr e)))
-         (width (/ (- (window-width) 10) col-no))
-         (step 100)
-         (count 0)
-         (inst '(lambda ()
-                  (table-capture start (point) col-delim nil nil width col-no)
-                  (goto-char (point-max))
-                  (table-recognize -1)
-                  (newline)
-                  (setq start (point)))))
-    (dolist (row (cdr e))
-      (dolist (col row)
-        (fuel-markup--print col)
-        (insert col-delim)
-        (setq count (1+ count))
-        (when (zerop (mod count step)) (funcall inst))))
-    (unless (zerop (mod count step)) (funcall inst))))
+  (fuel-table--insert
+   (mapcar '(lambda (row) (mapcar 'fuel-markup--print-str row)) (cdr e)))
+  (newline))
 
 (defun fuel-markup--instance (e)
   (insert " an instance of ")

misc/fuel/fuel-table.el

@@ -0,0 +1,91 @@
+;;; fuel-table.el -- table creation
+
+;; Copyright (C) 2009 Jose Antonio Ortega Ruiz
+;; See http://factorcode.org/license.txt for BSD license.
+
+;; Author: Jose Antonio Ortega Ruiz <jao@gnu.org>
+;; Keywords: languages, fuel, factor
+;; Start date: Tue Jan 06, 2009 13:44
+
+;;; Comentary:
+
+;; Utilities to insert ascii tables.
+
+;;; Code:
+
+(defun fuel-table--col-widths (rows)
+  (let* ((col-no (length (car rows)))
+         (available (- (window-width) 10 (* 2 col-no)))
+         (widths)
+         (c 0))
+    (while (< c col-no)
+      (let ((width 0)
+            (av-width (/ available (- col-no c))))
+        (dolist (row rows)
+          (setq width (min av-width
+                           (max width (length (nth c row))))))
+        (push width widths)
+        (setq available (- available width)))
+      (setq c (1+ c)))
+    (reverse widths)))
+
+(defsubst fuel-table--pad-str (str width)
+  (if (>= (length str) width)
+      str
+    (concat str (make-string (- width (length str)) ?\ ))))
+
+(defun fuel-table--str-lines (str width)
+  (if (<= (length str) width)
+      (list (fuel-table--pad-str str width))
+    (with-temp-buffer
+      (let ((fill-column width))
+        (insert str)
+        (fill-region (point-min) (point-max))
+        (mapcar '(lambda (s) (fuel-table--pad-str s width))
+                (split-string (buffer-string) "\n"))))))
+
+(defun fuel-table--pad-row (row)
+  (let* ((max-ln (apply 'max (mapcar 'length row)))
+         (result))
+    (dolist (lines row)
+      (let ((ln (length lines)))
+        (if (= ln max-ln) (push lines result)
+          (let ((lines (reverse lines))
+                (l 0)
+                (blank (make-string (length (car lines)) ?\ )))
+            (while (< l ln)
+              (push blank lines)
+              (setq l (1+ l)))
+            (push (reverse lines) result)))))
+    (reverse result)))
+
+(defun fuel-table--format-rows (rows widths)
+  (let ((col-no (length (car rows)))
+        (frows))
+    (dolist (row rows)
+      (let ((c 0) (frow))
+        (while (< c col-no)
+          (push (fuel-table--str-lines (nth c row) (nth c widths)) frow)
+          (setq c (1+ c)))
+        (push (fuel-table--pad-row (reverse frow)) frows)))
+    (reverse frows)))
+
+(defun fuel-table--insert (rows)
+  (let* ((widths (fuel-table--col-widths rows))
+         (rows (fuel-table--format-rows rows widths))
+         (ls (concat "+" (mapconcat (lambda (n) (make-string n ?-)) widths "-+") "-+")))
+    (insert ls "\n")
+    (dolist (r rows)
+      (let ((ln (length (car r)))
+            (l 0))
+        (while (< l ln)
+          (insert (concat "|" (mapconcat 'identity
+                                         (mapcar `(lambda (x) (nth ,l x)) r)
+                                         " |")
+                          " |\n"))
+          (setq l (1+ l))))
+      (insert ls "\n"))))
+
+
+(provide 'fuel-table)
+;;; fuel-table.el ends here