FUEL: $describe-vocab and child vocab lists implemented.

db4
Jose A. Ortega Ruiz 2009-01-06 07:05:42 +01:00
parent 76dcfc6c2b
commit 956492447c
3 changed files with 72 additions and 19 deletions

View File

@ -6,7 +6,7 @@ compiler.units continuations debugger definitions help help.crossref
help.markup help.topics io io.pathnames io.streams.string kernel lexer help.markup help.topics io io.pathnames io.streams.string kernel lexer
make math math.order memoize namespaces parser quotations prettyprint make math math.order memoize namespaces parser quotations prettyprint
sequences sets sorting source-files strings summary tools.crossref sequences sets sorting source-files strings summary tools.crossref
tools.vocabs vectors vocabs vocabs.parser words ; tools.vocabs tools.vocabs.browser vectors vocabs vocabs.parser words ;
IN: fuel IN: fuel
@ -298,16 +298,45 @@ MEMO: fuel-find-word ( name -- word/f )
fuel-find-word [ [ auto-use? on (fuel-word-see) ] with-scope ] [ f ] if* fuel-find-word [ [ auto-use? on (fuel-word-see) ] with-scope ] [ f ] if*
fuel-eval-set-result ; inline fuel-eval-set-result ; inline
: fuel-vocab-help-row ( vocab -- element )
[ vocab-name ]
[ dup summary " " append swap vocab-status-string append ]
bi 2array ;
: fuel-vocab-help-root-heading ( root -- element )
[ "Children from " prepend ] [ "Other children" ] if* \ $heading swap 2array ;
SYMBOL: vocab-list
: fuel-vocab-children-table ( vocabs -- element )
[ fuel-vocab-help-row ] map vocab-list prefix ;
: fuel-vocab-children ( assoc -- seq )
[
[ drop f ] [
[ fuel-vocab-help-root-heading ]
[ fuel-vocab-children-table ] bi*
[ 2array ] [ drop f ] if*
] if-empty
] { } assoc>map [ ] filter ;
: fuel-vocab-children-help ( name -- element )
all-child-vocabs fuel-vocab-children ;
: (fuel-vocab-help) ( name -- element ) : (fuel-vocab-help) ( name -- element )
\ article swap dup >vocab-link \ article swap dup >vocab-link
[ [
{
[ summary [ , ] [ "No summary available" , ] if* ] [ summary [ , ] [ "No summary available" , ] if* ]
[ drop \ $nl , ] [ drop \ $nl , ]
[ vocab-help article [ content>> % ] when* ] tri [ vocab-help [ article content>> % ] when* ]
[ name>> fuel-vocab-children-help % ]
} cleave
] { } make 3array ; ] { } make 3array ;
: fuel-vocab-help ( name -- ) : fuel-vocab-help ( name -- )
(fuel-vocab-help) fuel-eval-set-result ; inline dup empty? [ fuel-vocab-children-help ] [ (fuel-vocab-help) ] if
fuel-eval-set-result ; inline
: (fuel-index) ( seq -- seq ) : (fuel-index) ( seq -- seq )
[ [ >link name>> ] [ article-title ] bi 2array \ $subsection prefix ] map ; [ [ >link name>> ] [ article-title ] bi 2array \ $subsection prefix ] map ;

View File

@ -34,7 +34,7 @@
(let* ((vocabs (fuel-completion--vocabs refresh)) (let* ((vocabs (fuel-completion--vocabs refresh))
(prompt "Vocabulary name: ")) (prompt "Vocabulary name: "))
(if vocabs (if vocabs
(completing-read prompt vocabs nil t nil fuel-edit--vocab-history) (completing-read prompt vocabs nil nil nil fuel-edit--vocab-history)
(read-string prompt nil fuel-edit--vocab-history)))) (read-string prompt nil fuel-edit--vocab-history))))
(defun fuel-edit--edit-article (name) (defun fuel-edit--edit-article (name)

View File

@ -90,6 +90,7 @@
($contract . fuel-markup--contract) ($contract . fuel-markup--contract)
($curious . fuel-markup--curious) ($curious . fuel-markup--curious)
($definition . fuel-markup--definition) ($definition . fuel-markup--definition)
($describe-vocab . fuel-markup--describe-vocab)
($description . fuel-markup--description) ($description . fuel-markup--description)
($doc-path . fuel-markup--doc-path) ($doc-path . fuel-markup--doc-path)
($emphasis . fuel-markup--emphasis) ($emphasis . fuel-markup--emphasis)
@ -138,7 +139,8 @@
($vocab-subsection . fuel-markup--vocab-subsection) ($vocab-subsection . fuel-markup--vocab-subsection)
($vocabulary . fuel-markup--vocabulary) ($vocabulary . fuel-markup--vocabulary)
($warning . fuel-markup--warning) ($warning . fuel-markup--warning)
(article . fuel-markup--article))) (article . fuel-markup--article)
(vocab-list . fuel-markup--vocab-list)))
(make-variable-buffer-local (make-variable-buffer-local
(defvar fuel-markup--maybe-nl nil)) (defvar fuel-markup--maybe-nl nil))
@ -164,10 +166,11 @@
(defun fuel-markup--maybe-nl () (defun fuel-markup--maybe-nl ()
(setq fuel-markup--maybe-nl (point))) (setq fuel-markup--maybe-nl (point)))
(defun fuel-markup--insert-newline (&optional justification) (defun fuel-markup--insert-newline (&optional justification nosqueeze)
(fill-region (save-excursion (beginning-of-line) (point)) (fill-region (save-excursion (beginning-of-line) (point))
(point) (point)
(or justification 'left)) (or justification 'left)
nosqueeze)
(newline)) (newline))
(defsubst fuel-markup--insert-nl-if-nb (&optional no-fill) (defsubst fuel-markup--insert-nl-if-nb (&optional no-fill)
@ -314,6 +317,18 @@
(fuel-markup--vocab-link (list '$vocab-link link)) (fuel-markup--vocab-link (list '$vocab-link link))
(insert " "))) (insert " ")))
(defun fuel-markup--vocab-list (e)
(let ((rows (mapcar '(lambda (elem)
(list (list '$vocab-link (car elem)) (cadr elem)))
(cdr e))))
(fuel-markup--table (cons '$table rows))))
(defun fuel-markup--describe-vocab (e)
(fuel-markup--insert-nl-if-nb)
(let* ((cmd `(:fuel* ((,(cadr e) fuel-vocab-help)) "fuel" t))
(res (fuel-eval--retort-result (fuel-eval--send/wait cmd))))
(when res (fuel-markup--print res))))
(defun fuel-markup--vocabulary (e) (defun fuel-markup--vocabulary (e)
(fuel-markup--insert-heading "Vocabulary: " t) (fuel-markup--insert-heading "Vocabulary: " t)
(fuel-markup--vocab-link (cons '$vocab-link (cdr e))) (fuel-markup--vocab-link (cons '$vocab-link (cdr e)))
@ -328,20 +343,29 @@
(defun fuel-markup--table (e) (defun fuel-markup--table (e)
(fuel-markup--insert-newline) (fuel-markup--insert-newline)
(delete-blank-lines)
(newline) (newline)
(let ((start (point)) (let* ((table-time-before-update 0)
(table-time-before-reformat 0)
(start (point))
(col-delim "<~end-of-col~>") (col-delim "<~end-of-col~>")
(col-no (length (cadr e)))) (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 (row (cdr e))
(dolist (col row) (dolist (col row)
(fuel-markup--print col) (fuel-markup--print col)
(insert col-delim))) (insert col-delim)
(table-capture start (point) (setq count (1+ count))
col-delim nil nil (when (zerop (mod count step)) (funcall inst))))
(/ (- (window-width) 10) col-no) col-no)) (unless (zerop (mod count step)) (funcall inst))))
(goto-char (point-max))
(table-recognize -1)
(newline))
(defun fuel-markup--instance (e) (defun fuel-markup--instance (e)
(insert " an instance of ") (insert " an instance of ")