FUEL: Much faster and nicer table rendering.
parent
956492447c
commit
af78443832
|
@ -299,9 +299,7 @@ MEMO: fuel-find-word ( name -- word/f )
|
||||||
fuel-eval-set-result ; inline
|
fuel-eval-set-result ; inline
|
||||||
|
|
||||||
: fuel-vocab-help-row ( vocab -- element )
|
: fuel-vocab-help-row ( vocab -- element )
|
||||||
[ vocab-name ]
|
[ vocab-status-string ] [ vocab-name ] [ summary ] tri 3array ;
|
||||||
[ dup summary " " append swap vocab-status-string append ]
|
|
||||||
bi 2array ;
|
|
||||||
|
|
||||||
: fuel-vocab-help-root-heading ( root -- element )
|
: fuel-vocab-help-root-heading ( root -- element )
|
||||||
[ "Children from " prepend ] [ "Other children" ] if* \ $heading swap 2array ;
|
[ "Children from " prepend ] [ "Other children" ] if* \ $heading swap 2array ;
|
||||||
|
|
|
@ -16,9 +16,9 @@
|
||||||
(require 'fuel-eval)
|
(require 'fuel-eval)
|
||||||
(require 'fuel-font-lock)
|
(require 'fuel-font-lock)
|
||||||
(require 'fuel-base)
|
(require 'fuel-base)
|
||||||
|
(require 'fuel-table)
|
||||||
|
|
||||||
(require 'button)
|
(require 'button)
|
||||||
(require 'table)
|
|
||||||
|
|
||||||
|
|
||||||
;;; Customization:
|
;;; Customization:
|
||||||
|
@ -319,7 +319,9 @@
|
||||||
|
|
||||||
(defun fuel-markup--vocab-list (e)
|
(defun fuel-markup--vocab-list (e)
|
||||||
(let ((rows (mapcar '(lambda (elem)
|
(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))))
|
(cdr e))))
|
||||||
(fuel-markup--table (cons '$table rows))))
|
(fuel-markup--table (cons '$table rows))))
|
||||||
|
|
||||||
|
@ -345,27 +347,9 @@
|
||||||
(fuel-markup--insert-newline)
|
(fuel-markup--insert-newline)
|
||||||
(delete-blank-lines)
|
(delete-blank-lines)
|
||||||
(newline)
|
(newline)
|
||||||
(let* ((table-time-before-update 0)
|
(fuel-table--insert
|
||||||
(table-time-before-reformat 0)
|
(mapcar '(lambda (row) (mapcar 'fuel-markup--print-str row)) (cdr e)))
|
||||||
(start (point))
|
(newline))
|
||||||
(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))))
|
|
||||||
|
|
||||||
(defun fuel-markup--instance (e)
|
(defun fuel-markup--instance (e)
|
||||||
(insert " an instance of ")
|
(insert " an instance of ")
|
||||||
|
|
|
@ -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
|
Loading…
Reference in New Issue