1 ;;; fuel-markup.el -- printing factor help markup
3 ;; Copyright (C) 2009 Jose Antonio Ortega Ruiz
4 ;; See http://factorcode.org/license.txt for BSD license.
6 ;; Author: Jose Antonio Ortega Ruiz <jao@gnu.org>
7 ;; Keywords: languages, fuel, factor
8 ;; Start date: Thu Jan 01, 2009 21:43
12 ;; Utilities for printing Factor's help markup.
17 (require 'fuel-font-lock)
26 (fuel-font-lock--defface fuel-font-lock-markup-title
27 'bold fuel-help "article titles in help buffers")
29 (fuel-font-lock--defface fuel-font-lock-markup-heading
30 'bold fuel-help "headlines in help buffers")
32 (fuel-font-lock--defface fuel-font-lock-markup-link
33 'link fuel-help "links to topics in help buffers")
35 (fuel-font-lock--defface fuel-font-lock-markup-emphasis
36 'italic fuel-help "emphasized words in help buffers")
38 (fuel-font-lock--defface fuel-font-lock-markup-strong
39 'link fuel-help "bold words in help buffers")
44 (make-variable-buffer-local
45 (defvar fuel-markup--follow-link-function 'fuel-markup--echo-link))
47 (define-button-type 'fuel-markup--button
48 'action 'fuel-markup--follow-link
49 'face 'fuel-font-lock-markup-link
52 (defun fuel-markup--follow-link (button)
53 (when fuel-markup--follow-link-function
54 (funcall fuel-markup--follow-link-function
55 (button-get button 'markup-link)
56 (button-get button 'markup-label)
57 (button-get button 'markup-link-type))))
59 (defun fuel-markup--echo-link (link label type)
60 (message "Link %s pointing to %s named %s" label type link))
62 (defun fuel-markup--insert-button (label link type)
63 (let ((label (format "%s" label))
64 (link (if (listp link) link (format "%s" link))))
65 (insert-text-button label
66 :type 'fuel-markup--button
69 'markup-link-type type
70 'help-echo (format "%s (%s)" label type))))
72 (defun fuel-markup--article-title (name)
73 (let ((name (if (listp name) (cons :seq name) name)))
74 (fuel-eval--retort-result
75 (fuel-eval--send/wait `(:fuel* ((,name fuel-get-article-title)) "fuel")))))
77 (defun fuel-markup--link-at-point ()
78 (let ((button (condition-case nil (forward-button 0) (error nil))))
80 (list (button-get button 'markup-link)
81 (button-get button 'markup-label)
82 (button-get button 'markup-link-type)))))
87 (defconst fuel-markup--printers
88 '(($all-tags . fuel-markup--all-tags)
89 ($all-authors . fuel-markup--all-authors)
90 ($author . fuel-markup--author)
91 ($authors . fuel-markup--authors)
92 ($class-description . fuel-markup--class-description)
93 ($code . fuel-markup--code)
94 ($command . fuel-markup--command)
95 ($command-map . fuel-markup--null)
96 ($contract . fuel-markup--contract)
97 ($curious . fuel-markup--curious)
98 ($definition . fuel-markup--definition)
99 ($describe-vocab . fuel-markup--describe-vocab)
100 ($description . fuel-markup--description)
101 ($doc-path . fuel-markup--doc-path)
102 ($emphasis . fuel-markup--emphasis)
103 ($error-description . fuel-markup--error-description)
104 ($errors . fuel-markup--errors)
105 ($example . fuel-markup--example)
106 ($examples . fuel-markup--examples)
107 ($heading . fuel-markup--heading)
108 ($index . fuel-markup--index)
109 ($instance . fuel-markup--instance)
110 ($io-error . fuel-markup--io-error)
111 ($link . fuel-markup--link)
112 ($links . fuel-markup--links)
113 ($list . fuel-markup--list)
114 ($low-level-note . fuel-markup--low-level-note)
115 ($markup-example . fuel-markup--markup-example)
116 ($maybe . fuel-markup--maybe)
117 ($methods . fuel-markup--methods)
118 ($nl . fuel-markup--newline)
119 ($notes . fuel-markup--notes)
120 ($operation . fuel-markup--link)
121 ($or . fuel-markup--or)
122 ($parsing-note . fuel-markup--parsing-note)
123 ($predicate . fuel-markup--predicate)
124 ($prettyprinting-note . fuel-markup--prettyprinting-note)
125 ($quotation . fuel-markup--quotation)
126 ($references . fuel-markup--references)
127 ($related . fuel-markup--related)
128 ($see . fuel-markup--see)
129 ($see-also . fuel-markup--see-also)
130 ($shuffle . fuel-markup--shuffle)
131 ($side-effects . fuel-markup--side-effects)
132 ($slot . fuel-markup--snippet)
133 ($snippet . fuel-markup--snippet)
134 ($strong . fuel-markup--strong)
135 ($subheading . fuel-markup--subheading)
136 ($subsection . fuel-markup--subsection)
137 ($synopsis . fuel-markup--synopsis)
138 ($syntax . fuel-markup--syntax)
139 ($table . fuel-markup--table)
140 ($tag . fuel-markup--tag)
141 ($tags . fuel-markup--tags)
142 ($unchecked-example . fuel-markup--example)
143 ($value . fuel-markup--value)
144 ($values . fuel-markup--values)
145 ($values-x/y . fuel-markup--values-x/y)
146 ($var-description . fuel-markup--var-description)
147 ($vocab-link . fuel-markup--vocab-link)
148 ($vocab-links . fuel-markup--vocab-links)
149 ($vocab-subsection . fuel-markup--vocab-subsection)
150 ($vocabulary . fuel-markup--vocabulary)
151 ($warning . fuel-markup--warning)
152 (article . fuel-markup--article)
153 (describe-words . fuel-markup--describe-words)
154 (vocab-list . fuel-markup--vocab-list)))
156 (make-variable-buffer-local
157 (defvar fuel-markup--maybe-nl nil))
159 (defun fuel-markup--print (e)
160 (cond ((null e) (insert "f"))
161 ((stringp e) (fuel-markup--insert-string e))
162 ((and (listp e) (symbolp (car e))
163 (assoc (car e) fuel-markup--printers))
164 (funcall (cdr (assoc (car e) fuel-markup--printers)) e))
166 (assoc e fuel-markup--printers))
167 (funcall (cdr (assoc e fuel-markup--printers)) e))
168 ((listp e) (mapc 'fuel-markup--print e))
169 ((symbolp e) (fuel-markup--print (list '$link e)))
170 (t (insert (format "\n%S\n" e)))))
172 (defun fuel-markup--print-str (e)
174 (fuel-markup--print e)
177 (defun fuel-markup--maybe-nl ()
178 (setq fuel-markup--maybe-nl (point)))
180 (defun fuel-markup--insert-newline (&optional justification nosqueeze)
181 (fill-region (save-excursion (beginning-of-line) (point))
183 (or justification 'left)
187 (defsubst fuel-markup--insert-nl-if-nb (&optional no-fill)
188 (unless (eq (save-excursion (beginning-of-line) (point)) (point))
189 (if no-fill (newline) (fuel-markup--insert-newline))))
191 (defsubst fuel-markup--put-face (txt face)
192 (put-text-property 0 (length txt) 'font-lock-face face txt)
195 (defun fuel-markup--insert-heading (txt &optional no-nl)
196 (fuel-markup--insert-nl-if-nb)
198 (unless (bobp) (newline))
199 (fuel-markup--put-face txt 'fuel-font-lock-markup-heading)
200 (fuel-markup--insert-string txt)
201 (unless no-nl (newline)))
203 (defun fuel-markup--insert-string (str)
204 (when fuel-markup--maybe-nl
206 (setq fuel-markup--maybe-nl nil))
209 (defun fuel-markup--article (e)
210 (setq fuel-markup--maybe-nl nil)
211 (insert (fuel-markup--put-face (cadr e) 'fuel-font-lock-markup-title))
213 (fuel-markup--print (car (cddr e))))
215 (defun fuel-markup--heading (e)
216 (fuel-markup--insert-heading (cadr e)))
218 (defun fuel-markup--subheading (e)
219 (fuel-markup--insert-heading (cadr e)))
221 (defun fuel-markup--subsection (e)
222 (fuel-markup--insert-nl-if-nb)
224 (fuel-markup--link (cons '$link (cdr e)))
225 (fuel-markup--maybe-nl))
227 (defun fuel-markup--vocab-subsection (e)
228 (fuel-markup--insert-nl-if-nb)
230 (fuel-markup--vocab-link (cons '$vocab-link (cdr e)))
231 (fuel-markup--maybe-nl))
233 (defun fuel-markup--newline (e)
234 (fuel-markup--insert-newline)
237 (defun fuel-markup--doc-path (e)
238 (fuel-markup--insert-heading "Related topics")
240 (dolist (art (cdr e))
241 (fuel-markup--insert-button (car art) (cadr art) 'article)
243 (delete-backward-char 2)
244 (fuel-markup--insert-newline 'left))
246 (defun fuel-markup--emphasis (e)
247 (when (stringp (cadr e))
248 (fuel-markup--put-face (cadr e) 'fuel-font-lock-markup-emphasis)
251 (defun fuel-markup--strong (e)
252 (when (stringp (cadr e))
253 (fuel-markup--put-face (cadr e) 'fuel-font-lock-markup-strong)
256 (defun fuel-markup--snippet (e)
257 (insert (mapconcat '(lambda (s)
259 (fuel-font-lock--factor-str s)
260 (fuel-markup--print-str s)))
264 (defun fuel-markup--code (e)
265 (fuel-markup--insert-nl-if-nb)
267 (dolist (snip (cdr e))
269 (insert (fuel-font-lock--factor-str snip))
270 (fuel-markup--print snip))
274 (defun fuel-markup--command (e)
275 (fuel-markup--snippet (list '$snippet (nth 3 e))))
277 (defun fuel-markup--syntax (e)
278 (fuel-markup--insert-heading "Syntax")
279 (fuel-markup--print (cons '$code (cdr e)))
282 (defun fuel-markup--example (e)
283 (fuel-markup--insert-newline)
285 (fuel-markup--snippet (list '$snippet s))
289 (defun fuel-markup--markup-example (e)
290 (fuel-markup--insert-newline)
291 (fuel-markup--snippet (cons '$snippet (cdr e))))
293 (defun fuel-markup--link (e)
294 (let* ((link (or (nth 1 e) 'f))
295 (type (or (nth 3 e) (if (symbolp link) 'word 'article)))
297 (and (eq type 'article)
298 (fuel-markup--article-title link))
300 (fuel-markup--insert-button label link type)))
302 (defun fuel-markup--links (e)
303 (dolist (link (cdr e))
304 (fuel-markup--link (list '$link link))
306 (delete-backward-char 2))
308 (defun fuel-markup--index-quotation (q)
309 (cond ((null q) null)
310 ((listp q) (vconcat (mapcar 'fuel-markup--index-quotation q)))
313 (defun fuel-markup--index (e)
314 (let* ((q (fuel-markup--index-quotation (cadr e)))
315 (cmd `(:fuel* ((,q fuel-index)) "fuel"
316 ("builtins" "help" "help.topics" "classes"
317 "classes.builtin" "classes.tuple"
318 "classes.singleton" "classes.union"
319 "classes.intersection" "classes.predicate")))
320 (subs (fuel-eval--retort-result (fuel-eval--send/wait cmd 200))))
322 (let ((start (point))
323 (sort-fold-case nil))
324 (fuel-markup--print subs)
325 (sort-lines nil start (point))))))
327 (defun fuel-markup--vocab-link (e)
328 (fuel-markup--insert-button (cadr e) (or (car (cddr e)) (cadr e)) 'vocab))
330 (defun fuel-markup--vocab-links (e)
331 (dolist (link (cdr e))
333 (fuel-markup--vocab-link (list '$vocab-link link))
336 (defun fuel-markup--vocab-list (e)
337 (let ((rows (mapcar '(lambda (elem)
338 (list (list '$vocab-link (car elem))
341 (fuel-markup--table (cons '$table rows))))
343 (defun fuel-markup--describe-vocab (e)
344 (fuel-markup--insert-nl-if-nb)
345 (let* ((cmd `(:fuel* ((,(cadr e) fuel-vocab-help)) "fuel" t))
346 (res (fuel-eval--retort-result (fuel-eval--send/wait cmd))))
347 (when res (fuel-markup--print res))))
349 (defun fuel-markup--vocabulary (e)
350 (fuel-markup--insert-heading "Vocabulary: " t)
351 (fuel-markup--vocab-link (cons '$vocab-link (cdr e)))
354 (defun fuel-markup--parse-classes ()
356 (while (looking-at ".+ classes$")
357 (let ((heading `($heading ,(match-string-no-properties 0)))
360 (when (looking-at "Class *.+$")
361 (push (split-string (match-string-no-properties 0) nil t) rows)
363 (while (not (looking-at "$"))
364 (let* ((objs (split-string (thing-at-point 'line) nil t))
365 (class (list '$link (car objs) (car objs) 'word))
366 (super (and (cadr objs)
367 (list (list '$link (cadr objs) (cadr objs) 'word))))
368 (slots (when (cddr objs)
369 (list (mapcar '(lambda (s) (list s " ")) (cddr objs))))))
370 (push `(,class ,@super ,@slots) rows))
372 (push `(,heading ($table ,@(reverse rows))) elems))
376 (defun fuel-markup--parse-words ()
378 (while (looking-at ".+ words\\|Primitives$")
379 (let ((heading `($heading ,(match-string-no-properties 0)))
382 (when (looking-at "Word *\\(Stack effect\\|Syntax\\)$")
383 (push (list "Word" (match-string-no-properties 1)) rows)
385 (while (looking-at "\\(.+?\\)\\( +\\(.+\\)\\)?$")
386 (let ((word `($link ,(match-string-no-properties 1)
387 ,(match-string-no-properties 1)
389 (se (and (match-string-no-properties 3)
390 `(($snippet ,(match-string-no-properties 3))))))
391 (push `(,word ,@se) rows))
393 (push `(,heading ($table ,@(reverse rows))) elems))
397 (defun fuel-markup--parse-words-desc (desc)
400 (goto-char (point-min))
401 (when (re-search-forward "^Words$" nil t)
403 (let ((elems '(($heading "Words"))))
404 (push (fuel-markup--parse-classes) elems)
405 (push (fuel-markup--parse-words) elems)
408 (defun fuel-markup--describe-words (e)
410 (fuel-markup--print (fuel-markup--parse-words-desc (cadr e)))))
412 (defun fuel-markup--tag (e)
413 (fuel-markup--link (list '$link (cadr e) (cadr e) 'tag)))
415 (defun fuel-markup--tags (e)
417 (fuel-markup--insert-heading "Tags: " t)
418 (dolist (tag (cdr e))
419 (fuel-markup--tag (list '$tag tag))
421 (delete-backward-char 2)
422 (fuel-markup--insert-newline)))
424 (defun fuel-markup--all-tags (e)
425 (let* ((cmd `(:fuel* (all-tags :get) "fuel" t))
426 (tags (fuel-eval--retort-result (fuel-eval--send/wait cmd))))
428 (cons '$list (mapcar (lambda (tag) (list '$link tag tag 'tag)) tags)))))
430 (defun fuel-markup--author (e)
431 (fuel-markup--link (list '$link (cadr e) (cadr e) 'author)))
433 (defun fuel-markup--authors (e)
435 (fuel-markup--insert-heading "Authors: " t)
437 (fuel-markup--author (list '$author a))
439 (delete-backward-char 2)
440 (fuel-markup--insert-newline)))
442 (defun fuel-markup--all-authors (e)
443 (let* ((cmd `(:fuel* (all-authors :get) "fuel" t))
444 (authors (fuel-eval--retort-result (fuel-eval--send/wait cmd))))
446 (cons '$list (mapcar (lambda (a) (list '$link a a 'author)) authors)))))
448 (defun fuel-markup--list (e)
449 (fuel-markup--insert-nl-if-nb)
450 (dolist (elt (cdr e))
452 (fuel-markup--print elt)
453 (fuel-markup--insert-newline)))
455 (defun fuel-markup--table (e)
456 (fuel-markup--insert-newline)
460 (mapcar '(lambda (row) (mapcar 'fuel-markup--print-str row)) (cdr e)))
463 (defun fuel-markup--instance (e)
464 (insert " an instance of ")
465 (fuel-markup--print (cadr e)))
467 (defun fuel-markup--maybe (e)
468 (fuel-markup--instance (cons '$instance (cdr e)))
471 (defun fuel-markup--or (e)
472 (let ((fst (car (cdr e)))
473 (mid (butlast (cddr e)))
474 (lst (car (last (cdr e)))))
475 (insert (format "%s" fst))
476 (dolist (m mid) (insert (format ", %s" m)))
477 (insert (format " or %s" lst))))
479 (defun fuel-markup--values (e)
480 (fuel-markup--insert-heading "Inputs and outputs")
481 (dolist (val (cdr e))
482 (insert " " (car val) " - ")
483 (fuel-markup--print (cdr val))
486 (defun fuel-markup--predicate (e)
487 (fuel-markup--values '($values ("object" object) ("?" "a boolean")))
488 (let ((word (make-symbol (substring (format "%s" (cadr e)) 0 -1))))
489 (fuel-markup--description
490 `($description "Tests if the object is an instance of the "
491 ($link ,word) " class."))))
493 (defun fuel-markup--side-effects (e)
494 (fuel-markup--insert-heading "Side effects")
496 (fuel-markup--print (cdr e))
497 (fuel-markup--insert-newline))
499 (defun fuel-markup--definition (e)
500 (fuel-markup--insert-heading "Definition")
501 (fuel-markup--code (cons '$code (cdr e))))
503 (defun fuel-markup--methods (e)
504 (fuel-markup--insert-heading "Methods")
505 (fuel-markup--code (cons '$code (cdr e))))
507 (defun fuel-markup--value (e)
508 (fuel-markup--insert-heading "Variable value")
509 (insert "Current value in global namespace: ")
510 (fuel-markup--snippet (cons '$snippet (cdr e)))
513 (defun fuel-markup--values-x/y (e)
514 (fuel-markup--values '($values ("x" "number") ("y" "number"))))
516 (defun fuel-markup--curious (e)
517 (fuel-markup--insert-heading "For the curious...")
518 (fuel-markup--print (cdr e)))
520 (defun fuel-markup--references (e)
521 (fuel-markup--insert-heading "References")
522 (dolist (ref (cdr e))
524 (fuel-markup--print ref)
525 (fuel-markup--subsection (list '$subsection ref)))))
527 (defun fuel-markup--see-also (e)
528 (fuel-markup--insert-heading "See also")
529 (fuel-markup--links (cons '$links (cdr e))))
531 (defun fuel-markup--related (e)
532 (fuel-markup--insert-heading "See also")
533 (fuel-markup--links (cons '$links (cadr e))))
535 (defun fuel-markup--shuffle (e)
536 (insert "\nShuffle word. Re-arranges the stack "
537 "according to the stack effect pattern.")
538 (fuel-markup--insert-newline))
540 (defun fuel-markup--low-level-note (e)
541 (fuel-markup--print '($notes "Calling this word directly is not necessary "
543 "Higher-level words call it automatically.")))
545 (defun fuel-markup--parsing-note (e)
546 (fuel-markup--insert-nl-if-nb)
547 (insert "This word should only be called from parsing words.")
548 (fuel-markup--insert-newline))
550 (defun fuel-markup--io-error (e)
551 (fuel-markup--errors '($errors "Throws an error if the I/O operation fails.")))
553 (defun fuel-markup--prettyprinting-note (e)
554 (fuel-markup--print '($notes ("This word should only be called within the "
555 ($link with-pprint) " combinator."))))
557 (defun fuel-markup--elem-with-heading (elem heading)
558 (fuel-markup--insert-heading heading)
559 (fuel-markup--print (cdr elem))
560 (fuel-markup--insert-newline))
562 (defun fuel-markup--quotation (e)
564 (fuel-markup--link (list '$link 'quotation 'quotation 'word))
565 (insert " with stack effect ")
566 (fuel-markup--snippet (list '$snippet (nth 1 e))))
568 (defun fuel-markup--warning (e)
569 (fuel-markup--elem-with-heading e "Warning"))
571 (defun fuel-markup--description (e)
572 (fuel-markup--elem-with-heading e "Word description"))
574 (defun fuel-markup--class-description (e)
575 (fuel-markup--elem-with-heading e "Class description"))
577 (defun fuel-markup--error-description (e)
578 (fuel-markup--elem-with-heading e "Error description"))
580 (defun fuel-markup--var-description (e)
581 (fuel-markup--elem-with-heading e "Variable description"))
583 (defun fuel-markup--contract (e)
584 (fuel-markup--elem-with-heading e "Generic word contract"))
586 (defun fuel-markup--errors (e)
587 (fuel-markup--elem-with-heading e "Errors"))
589 (defun fuel-markup--examples (e)
590 (fuel-markup--elem-with-heading e "Examples"))
592 (defun fuel-markup--notes (e)
593 (fuel-markup--elem-with-heading e "Notes"))
595 (defun fuel-markup--word-info (e s)
596 (let* ((word (nth 1 e))
597 (cmd (and word `(:fuel* ((:quote ,(format "%s" word)) ,s) "fuel")))
598 (ret (and cmd (fuel-eval--send/wait cmd)))
599 (res (and (not (fuel-eval--retort-error ret))
600 (fuel-eval--retort-output ret))))
602 (fuel-markup--code (list '$code res))
603 (fuel-markup--snippet (list '$snippet " " word)))))
605 (defun fuel-markup--see (e)
606 (fuel-markup--word-info e 'see))
608 (defun fuel-markup--synopsis (e)
609 (fuel-markup--word-info e 'synopsis))
611 (defun fuel-markup--null (e))
614 (provide 'fuel-markup)
615 ;;; fuel-markup.el ends here