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 ($parsing-note . fuel-markup--parsing-note
)
122 ($predicate . fuel-markup--predicate
)
123 ($prettyprinting-note . fuel-markup--prettyprinting-note
)
124 ($quotation . fuel-markup--quotation
)
125 ($references . fuel-markup--references
)
126 ($related . fuel-markup--related
)
127 ($see . fuel-markup--see
)
128 ($see-also . fuel-markup--see-also
)
129 ($shuffle . fuel-markup--shuffle
)
130 ($side-effects . fuel-markup--side-effects
)
131 ($slot . fuel-markup--snippet
)
132 ($snippet . fuel-markup--snippet
)
133 ($strong . fuel-markup--strong
)
134 ($subheading . fuel-markup--subheading
)
135 ($subsection . fuel-markup--subsection
)
136 ($synopsis . fuel-markup--synopsis
)
137 ($syntax . fuel-markup--syntax
)
138 ($table . fuel-markup--table
)
139 ($tag . fuel-markup--tag
)
140 ($tags . fuel-markup--tags
)
141 ($unchecked-example . fuel-markup--example
)
142 ($value . fuel-markup--value
)
143 ($values . fuel-markup--values
)
144 ($values-x
/y . fuel-markup--values-x
/y
)
145 ($var-description . fuel-markup--var-description
)
146 ($vocab-link . fuel-markup--vocab-link
)
147 ($vocab-links . fuel-markup--vocab-links
)
148 ($vocab-subsection . fuel-markup--vocab-subsection
)
149 ($vocabulary . fuel-markup--vocabulary
)
150 ($warning . fuel-markup--warning
)
151 (article . fuel-markup--article
)
152 (describe-words . fuel-markup--describe-words
)
153 (vocab-list . fuel-markup--vocab-list
)))
155 (make-variable-buffer-local
156 (defvar fuel-markup--maybe-nl nil
))
158 (defun fuel-markup--print (e)
160 ((stringp e
) (fuel-markup--insert-string e
))
161 ((and (listp e
) (symbolp (car e
))
162 (assoc (car e
) fuel-markup--printers
))
163 (funcall (cdr (assoc (car e
) fuel-markup--printers
)) e
))
165 (assoc e fuel-markup--printers
))
166 (funcall (cdr (assoc e fuel-markup--printers
)) e
))
167 ((listp e
) (mapc 'fuel-markup--print e
))
168 ((symbolp e
) (fuel-markup--print (list '$link e
)))
169 (t (insert (format "\n%S\n" e
)))))
171 (defun fuel-markup--print-str (e)
173 (fuel-markup--print e
)
176 (defun fuel-markup--maybe-nl ()
177 (setq fuel-markup--maybe-nl
(point)))
179 (defun fuel-markup--insert-newline (&optional justification nosqueeze
)
180 (fill-region (save-excursion (beginning-of-line) (point))
182 (or justification
'left
)
186 (defsubst fuel-markup--insert-nl-if-nb
(&optional no-fill
)
187 (unless (eq (save-excursion (beginning-of-line) (point)) (point))
188 (if no-fill
(newline) (fuel-markup--insert-newline))))
190 (defsubst fuel-markup--put-face
(txt face
)
191 (put-text-property 0 (length txt
) 'font-lock-face face txt
)
194 (defun fuel-markup--insert-heading (txt &optional no-nl
)
195 (fuel-markup--insert-nl-if-nb)
197 (unless (bobp) (newline))
198 (fuel-markup--put-face txt
'fuel-font-lock-markup-heading
)
199 (fuel-markup--insert-string txt
)
200 (unless no-nl
(newline)))
202 (defun fuel-markup--insert-string (str)
203 (when fuel-markup--maybe-nl
205 (setq fuel-markup--maybe-nl nil
))
208 (defun fuel-markup--article (e)
209 (setq fuel-markup--maybe-nl nil
)
210 (insert (fuel-markup--put-face (cadr e
) 'fuel-font-lock-markup-title
))
212 (fuel-markup--print (car (cddr e
))))
214 (defun fuel-markup--heading (e)
215 (fuel-markup--insert-heading (cadr e
)))
217 (defun fuel-markup--subheading (e)
218 (fuel-markup--insert-heading (cadr e
)))
220 (defun fuel-markup--subsection (e)
221 (fuel-markup--insert-nl-if-nb)
223 (fuel-markup--link (cons '$link
(cdr e
)))
224 (fuel-markup--maybe-nl))
226 (defun fuel-markup--vocab-subsection (e)
227 (fuel-markup--insert-nl-if-nb)
229 (fuel-markup--vocab-link (cons '$vocab-link
(cdr e
)))
230 (fuel-markup--maybe-nl))
232 (defun fuel-markup--newline (e)
233 (fuel-markup--insert-newline)
236 (defun fuel-markup--doc-path (e)
237 (fuel-markup--insert-heading "Related topics")
239 (dolist (art (cdr e
))
240 (fuel-markup--insert-button (car art
) (cadr art
) 'article
)
242 (delete-backward-char 2)
243 (fuel-markup--insert-newline 'left
))
245 (defun fuel-markup--emphasis (e)
246 (when (stringp (cadr e
))
247 (fuel-markup--put-face (cadr e
) 'fuel-font-lock-markup-emphasis
)
250 (defun fuel-markup--strong (e)
251 (when (stringp (cadr e
))
252 (fuel-markup--put-face (cadr e
) 'fuel-font-lock-markup-strong
)
255 (defun fuel-markup--snippet (e)
256 (let ((snip (format "%s" (cadr e
))))
257 (insert (fuel-font-lock--factor-str snip
))))
259 (defun fuel-markup--code (e)
260 (fuel-markup--insert-nl-if-nb)
262 (dolist (snip (cdr e
))
264 (insert (fuel-font-lock--factor-str snip
))
265 (fuel-markup--print snip
))
269 (defun fuel-markup--command (e)
270 (fuel-markup--snippet (list '$snippet
(nth 3 e
))))
272 (defun fuel-markup--syntax (e)
273 (fuel-markup--insert-heading "Syntax")
274 (fuel-markup--print (cons '$code
(cdr e
)))
277 (defun fuel-markup--example (e)
278 (fuel-markup--insert-newline)
280 (fuel-markup--snippet (list '$snippet s
))
283 (defun fuel-markup--markup-example (e)
284 (fuel-markup--insert-newline)
285 (fuel-markup--snippet (cons '$snippet
(cdr e
))))
287 (defun fuel-markup--link (e)
288 (let* ((link (nth 1 e
))
289 (type (or (nth 3 e
) (if (symbolp link
) 'word
'article
)))
291 (and (eq type
'article
)
292 (fuel-markup--article-title link
))
294 (fuel-markup--insert-button label link type
)))
296 (defun fuel-markup--links (e)
297 (dolist (link (cdr e
))
298 (fuel-markup--link (list '$link link
))
300 (delete-backward-char 2))
302 (defun fuel-markup--index-quotation (q)
303 (cond ((null q
) null
)
304 ((listp q
) (vconcat (mapcar 'fuel-markup--index-quotation q
)))
307 (defun fuel-markup--index (e)
308 (let* ((q (fuel-markup--index-quotation (cadr e
)))
309 (cmd `(:fuel
* ((,q fuel-index
)) "fuel"
310 ("builtins" "help" "help.topics" "classes"
311 "classes.builtin" "classes.tuple"
312 "classes.singleton" "classes.union"
313 "classes.intersection" "classes.predicate")))
314 (subs (fuel-eval--retort-result (fuel-eval--send/wait cmd
200))))
316 (let ((start (point))
317 (sort-fold-case nil
))
318 (fuel-markup--print subs
)
319 (sort-lines nil start
(point))))))
321 (defun fuel-markup--vocab-link (e)
322 (fuel-markup--insert-button (cadr e
) (cadr e
) 'vocab
))
324 (defun fuel-markup--vocab-links (e)
325 (dolist (link (cdr e
))
327 (fuel-markup--vocab-link (list '$vocab-link link
))
330 (defun fuel-markup--vocab-list (e)
331 (let ((rows (mapcar '(lambda (elem)
333 (list '$vocab-link
(cadr elem
))
336 (fuel-markup--table (cons '$table rows
))))
338 (defun fuel-markup--describe-vocab (e)
339 (fuel-markup--insert-nl-if-nb)
340 (let* ((cmd `(:fuel
* ((,(cadr e
) fuel-vocab-help
)) "fuel" t
))
341 (res (fuel-eval--retort-result (fuel-eval--send/wait cmd
))))
342 (when res
(fuel-markup--print res
))))
344 (defun fuel-markup--vocabulary (e)
345 (fuel-markup--insert-heading "Vocabulary: " t
)
346 (fuel-markup--vocab-link (cons '$vocab-link
(cdr e
)))
349 (defun fuel-markup--parse-classes ()
351 (while (looking-at ".+ classes$")
352 (let ((heading `($heading
,(match-string-no-properties 0)))
355 (when (looking-at "Class *.+$")
356 (push (split-string (match-string-no-properties 0) nil t
) rows
)
358 (while (not (looking-at "$"))
359 (let* ((objs (split-string (thing-at-point 'line
) nil t
))
360 (class (list '$link
(car objs
) (car objs
) 'word
))
361 (super (and (cadr objs
)
362 (list (list '$link
(cadr objs
) (cadr objs
) 'word
))))
363 (slots (when (cddr objs
)
364 (list (mapcar '(lambda (s) (list s
" ")) (cddr objs
))))))
365 (push `(,class
,@super
,@slots
) rows
))
367 (push `(,heading
($table
,@(reverse rows
))) elems
))
371 (defun fuel-markup--parse-words ()
373 (while (looking-at ".+ words\\|Primitives$")
374 (let ((heading `($heading
,(match-string-no-properties 0)))
377 (when (looking-at "Word *\\(Stack effect\\|Syntax\\)$")
378 (push (list "Word" (match-string-no-properties 1)) rows
)
380 (while (looking-at "\\(.+?\\)\\( +\\(.+\\)\\)?$")
381 (let ((word `($link
,(match-string-no-properties 1)
382 ,(match-string-no-properties 1)
384 (se (and (match-string-no-properties 3)
385 `(($snippet
,(match-string-no-properties 3))))))
386 (push `(,word
,@se
) rows
))
388 (push `(,heading
($table
,@(reverse rows
))) elems
))
392 (defun fuel-markup--parse-words-desc (desc)
395 (goto-char (point-min))
396 (when (re-search-forward "^Words$" nil t
)
398 (let ((elems '(($heading
"Words"))))
399 (push (fuel-markup--parse-classes) elems
)
400 (push (fuel-markup--parse-words) elems
)
403 (defun fuel-markup--describe-words (e)
405 (fuel-markup--print (fuel-markup--parse-words-desc (cadr e
)))))
407 (defun fuel-markup--tag (e)
408 (fuel-markup--link (list '$link
(cadr e
) (cadr e
) 'tag
)))
410 (defun fuel-markup--tags (e)
412 (fuel-markup--insert-heading "Tags: " t
)
413 (dolist (tag (cdr e
))
414 (fuel-markup--tag (list '$tag tag
))
416 (delete-backward-char 2)
417 (fuel-markup--insert-newline)))
419 (defun fuel-markup--all-tags (e)
420 (let* ((cmd `(:fuel
* (all-tags :get
) "fuel" t
))
421 (tags (fuel-eval--retort-result (fuel-eval--send/wait cmd
))))
423 (cons '$list
(mapcar (lambda (tag) (list '$link tag tag
'tag
)) tags
)))))
425 (defun fuel-markup--author (e)
426 (fuel-markup--link (list '$link
(cadr e
) (cadr e
) 'author
)))
428 (defun fuel-markup--authors (e)
430 (fuel-markup--insert-heading "Authors: " t
)
432 (fuel-markup--author (list '$author a
))
434 (delete-backward-char 2)
435 (fuel-markup--insert-newline)))
437 (defun fuel-markup--all-authors (e)
438 (let* ((cmd `(:fuel
* (all-authors :get
) "fuel" t
))
439 (authors (fuel-eval--retort-result (fuel-eval--send/wait cmd
))))
441 (cons '$list
(mapcar (lambda (a) (list '$link a a
'author
)) authors
)))))
443 (defun fuel-markup--list (e)
444 (fuel-markup--insert-nl-if-nb)
445 (dolist (elt (cdr e
))
447 (fuel-markup--print elt
)
448 (fuel-markup--insert-newline)))
450 (defun fuel-markup--table (e)
451 (fuel-markup--insert-newline)
455 (mapcar '(lambda (row) (mapcar 'fuel-markup--print-str row
)) (cdr e
)))
458 (defun fuel-markup--instance (e)
459 (insert " an instance of ")
460 (fuel-markup--print (cadr e
)))
462 (defun fuel-markup--maybe (e)
463 (fuel-markup--instance (cons '$instance
(cdr e
)))
466 (defun fuel-markup--values (e)
467 (fuel-markup--insert-heading "Inputs and outputs")
468 (dolist (val (cdr e
))
469 (insert " " (car val
) " - ")
470 (fuel-markup--print (cdr val
))
473 (defun fuel-markup--predicate (e)
474 (fuel-markup--values '($values
("object" object
) ("?" "a boolean")))
475 (let ((word (make-symbol (substring (format "%s" (cadr e
)) 0 -
1))))
476 (fuel-markup--description
477 `($description
"Tests if the object is an instance of the "
478 ($link
,word
) " class."))))
480 (defun fuel-markup--side-effects (e)
481 (fuel-markup--insert-heading "Side effects")
483 (fuel-markup--print (cdr e
))
484 (fuel-markup--insert-newline))
486 (defun fuel-markup--definition (e)
487 (fuel-markup--insert-heading "Definition")
488 (fuel-markup--code (cons '$code
(cdr e
))))
490 (defun fuel-markup--methods (e)
491 (fuel-markup--insert-heading "Methods")
492 (fuel-markup--code (cons '$code
(cdr e
))))
494 (defun fuel-markup--value (e)
495 (fuel-markup--insert-heading "Variable value")
496 (insert "Current value in global namespace: ")
497 (fuel-markup--snippet (cons '$snippet
(cdr e
)))
500 (defun fuel-markup--values-x/y
(e)
501 (fuel-markup--values '($values
("x" "number") ("y" "number"))))
503 (defun fuel-markup--curious (e)
504 (fuel-markup--insert-heading "For the curious...")
505 (fuel-markup--print (cdr e
)))
507 (defun fuel-markup--references (e)
508 (fuel-markup--insert-heading "References")
509 (dolist (ref (cdr e
))
511 (fuel-markup--print ref
)
512 (fuel-markup--subsection (list '$subsection ref
)))))
514 (defun fuel-markup--see-also (e)
515 (fuel-markup--insert-heading "See also")
516 (fuel-markup--links (cons '$links
(cdr e
))))
518 (defun fuel-markup--related (e)
519 (fuel-markup--insert-heading "See also")
520 (fuel-markup--links (cons '$links
(cadr e
))))
522 (defun fuel-markup--shuffle (e)
523 (insert "\nShuffle word. Re-arranges the stack "
524 "according to the stack effect pattern.")
525 (fuel-markup--insert-newline))
527 (defun fuel-markup--low-level-note (e)
528 (fuel-markup--print '($notes
"Calling this word directly is not necessary "
530 "Higher-level words call it automatically.")))
532 (defun fuel-markup--parsing-note (e)
533 (fuel-markup--insert-nl-if-nb)
534 (insert "This word should only be called from parsing words.")
535 (fuel-markup--insert-newline))
537 (defun fuel-markup--io-error (e)
538 (fuel-markup--errors '($errors
"Throws an error if the I/O operation fails.")))
540 (defun fuel-markup--prettyprinting-note (e)
541 (fuel-markup--print '($notes
("This word should only be called within the "
542 ($link with-pprint
) " combinator."))))
544 (defun fuel-markup--elem-with-heading (elem heading
)
545 (fuel-markup--insert-heading heading
)
546 (fuel-markup--print (cdr elem
))
547 (fuel-markup--insert-newline))
549 (defun fuel-markup--quotation (e)
551 (fuel-markup--link (list '$link
'quotation
'quotation
'word
))
552 (insert " with stack effect ")
553 (fuel-markup--snippet (list '$snippet
(nth 1 e
))))
555 (defun fuel-markup--warning (e)
556 (fuel-markup--elem-with-heading e
"Warning"))
558 (defun fuel-markup--description (e)
559 (fuel-markup--elem-with-heading e
"Word description"))
561 (defun fuel-markup--class-description (e)
562 (fuel-markup--elem-with-heading e
"Class description"))
564 (defun fuel-markup--error-description (e)
565 (fuel-markup--elem-with-heading e
"Error description"))
567 (defun fuel-markup--var-description (e)
568 (fuel-markup--elem-with-heading e
"Variable description"))
570 (defun fuel-markup--contract (e)
571 (fuel-markup--elem-with-heading e
"Generic word contract"))
573 (defun fuel-markup--errors (e)
574 (fuel-markup--elem-with-heading e
"Errors"))
576 (defun fuel-markup--examples (e)
577 (fuel-markup--elem-with-heading e
"Examples"))
579 (defun fuel-markup--notes (e)
580 (fuel-markup--elem-with-heading e
"Notes"))
582 (defun fuel-markup--see (e)
583 (let* ((word (nth 1 e
))
584 (cmd (and word
`(:fuel
* (,(format "%s" word
) fuel-word-see
) "fuel" t
)))
586 (fuel-eval--retort-result (fuel-eval--send/wait cmd
100)))))
588 (fuel-markup--code (list '$code res
))
589 (fuel-markup--snippet (list '$snippet word
)))))
591 (defun fuel-markup--null (e))
593 (defun fuel-markup--synopsis (e)
594 (insert (format " %S " e
)))
597 (provide 'fuel-markup
)
598 ;;; fuel-markup.el ends here