diff --git a/extra/fuel/fuel.factor b/extra/fuel/fuel.factor index b5fc84dcf7..1770f320eb 100644 --- a/extra/fuel/fuel.factor +++ b/extra/fuel/fuel.factor @@ -6,7 +6,7 @@ compiler.units continuations debugger definitions help help.crossref help.markup help.topics io io.pathnames io.streams.string kernel lexer make math math.order memoize namespaces parser quotations prettyprint 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 @@ -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-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 ) \ article swap dup >vocab-link [ - [ summary [ , ] [ "No summary available" , ] if* ] - [ drop \ $nl , ] - [ vocab-help article [ content>> % ] when* ] tri + { + [ summary [ , ] [ "No summary available" , ] if* ] + [ drop \ $nl , ] + [ vocab-help [ article content>> % ] when* ] + [ name>> fuel-vocab-children-help % ] + } cleave ] { } make 3array ; : 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 ) [ [ >link name>> ] [ article-title ] bi 2array \ $subsection prefix ] map ; diff --git a/misc/fuel/fuel-edit.el b/misc/fuel/fuel-edit.el index ab81f46684..e5988d1392 100644 --- a/misc/fuel/fuel-edit.el +++ b/misc/fuel/fuel-edit.el @@ -34,7 +34,7 @@ (let* ((vocabs (fuel-completion--vocabs refresh)) (prompt "Vocabulary name: ")) (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)))) (defun fuel-edit--edit-article (name) diff --git a/misc/fuel/fuel-markup.el b/misc/fuel/fuel-markup.el index 319fb23b5a..a251f35ddd 100644 --- a/misc/fuel/fuel-markup.el +++ b/misc/fuel/fuel-markup.el @@ -90,6 +90,7 @@ ($contract . fuel-markup--contract) ($curious . fuel-markup--curious) ($definition . fuel-markup--definition) + ($describe-vocab . fuel-markup--describe-vocab) ($description . fuel-markup--description) ($doc-path . fuel-markup--doc-path) ($emphasis . fuel-markup--emphasis) @@ -138,7 +139,8 @@ ($vocab-subsection . fuel-markup--vocab-subsection) ($vocabulary . fuel-markup--vocabulary) ($warning . fuel-markup--warning) - (article . fuel-markup--article))) + (article . fuel-markup--article) + (vocab-list . fuel-markup--vocab-list))) (make-variable-buffer-local (defvar fuel-markup--maybe-nl nil)) @@ -164,10 +166,11 @@ (defun fuel-markup--maybe-nl () (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)) (point) - (or justification 'left)) + (or justification 'left) + nosqueeze) (newline)) (defsubst fuel-markup--insert-nl-if-nb (&optional no-fill) @@ -314,6 +317,18 @@ (fuel-markup--vocab-link (list '$vocab-link link)) (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) (fuel-markup--insert-heading "Vocabulary: " t) (fuel-markup--vocab-link (cons '$vocab-link (cdr e))) @@ -328,20 +343,29 @@ (defun fuel-markup--table (e) (fuel-markup--insert-newline) + (delete-blank-lines) (newline) - (let ((start (point)) - (col-delim "<~end-of-col~>") - (col-no (length (cadr e)))) + (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))) - (table-capture start (point) - col-delim nil nil - (/ (- (window-width) 10) col-no) col-no)) - (goto-char (point-max)) - (table-recognize -1) - (newline)) + (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) (insert " an instance of ")