;;; Code:
(require 'fuel-eval)
-(require 'fuel-font-lock)
(require 'fuel-base)
(require 'fuel-table)
\f
;;; Customization:
-(fuel-font-lock--defface fuel-font-lock-markup-title
- 'bold fuel-help "article titles in help buffers")
-
-(fuel-font-lock--defface fuel-font-lock-markup-heading
- 'bold fuel-help "headlines in help buffers")
-
-(fuel-font-lock--defface fuel-font-lock-markup-link
- 'link fuel-help "links to topics in help buffers")
-
-(fuel-font-lock--defface fuel-font-lock-markup-emphasis
- 'italic fuel-help "emphasized words in help buffers")
-
-(fuel-font-lock--defface fuel-font-lock-markup-strong
- 'link fuel-help "bold words in help buffers")
+(defface fuel-font-lock-markup-title '((t (:inherit bold)))
+ "article titles in help buffers"
+ :group 'fuel-help
+ :group 'fuel-faces
+ :group 'faces)
+
+(defface fuel-font-lock-markup-heading '((t (:inherit bold)))
+ "headlines in help buffers"
+ :group 'fuel-help
+ :group 'fuel-faces
+ :group 'faces)
+
+(defface fuel-font-lock-markup-link '((t (:inherit link)))
+ "links to topics in help buffers"
+ :group 'fuel-help
+ :group 'fuel-faces
+ :group 'faces)
+
+(defface fuel-font-lock-markup-emphasis '((t (:inherit italic)))
+ "emphasized words in help buffers"
+ :group 'fuel-help
+ :group 'fuel-faces
+ :group 'faces)
+
+(defface fuel-font-lock-markup-strong '((t (:inherit link)))
+ "bold words in help buffers"
+ :group 'fuel-help
+ :group 'fuel-faces
+ :group 'faces)
\f
;;; Links:
-(make-variable-buffer-local
- (defvar fuel-markup--follow-link-function 'fuel-markup--echo-link))
+(defvar-local fuel-markup--follow-link-function 'fuel-markup--echo-link)
(define-button-type 'fuel-markup--button
'action 'fuel-markup--follow-link
(button-get button 'markup-label)
(button-get button 'markup-link-type)))))
-\f
+(defun fuel-markup--nav-crumbs (e)
+ (fuel-markup--links e " > ")
+ (newline))
+
;;; Markup printers:
(defconst fuel-markup--printers
($author . fuel-markup--author)
($authors . fuel-markup--authors)
($class-description . fuel-markup--class-description)
- ($code . fuel-markup--code)
+ ($code . (lambda (e) (fuel-markup--code e t)))
($command . fuel-markup--command)
($command-map . fuel-markup--null)
+ ($complex-shuffle . fuel-markup--complex-shuffle)
($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)
($error-description . fuel-markup--error-description)
($errors . fuel-markup--errors)
- ($example . fuel-markup--example)
+ ($example . (lambda (e) (fuel-markup--code e t)))
($examples . fuel-markup--examples)
+ ($fuel-nav-crumbs . fuel-markup--nav-crumbs)
($heading . fuel-markup--heading)
($index . fuel-markup--index)
($instance . fuel-markup--instance)
($io-error . fuel-markup--io-error)
($link . fuel-markup--link)
- ($links . fuel-markup--links)
+ ($links . (lambda (e) (fuel-markup--links e ", ")))
($list . fuel-markup--list)
($low-level-note . fuel-markup--low-level-note)
($markup-example . fuel-markup--markup-example)
($maybe . fuel-markup--maybe)
+ ($sequence . fuel-markup--sequence)
($methods . fuel-markup--methods)
+ ($next-link . (lambda (e) (fuel-markup--prefixed-link "Next:" e)))
($nl . fuel-markup--newline)
($notes . fuel-markup--notes)
($operation . fuel-markup--link)
+ ($or . fuel-markup--or)
($parsing-note . fuel-markup--parsing-note)
($predicate . fuel-markup--predicate)
($prettyprinting-note . fuel-markup--prettyprinting-note)
+ ($prev-link . (lambda (e) (fuel-markup--prefixed-link "Prev:" e)))
($quotation . fuel-markup--quotation)
($references . fuel-markup--references)
($related . fuel-markup--related)
- ($see . fuel-markup--see)
+ ($see . fuel-markup--word-info)
($see-also . fuel-markup--see-also)
($shuffle . fuel-markup--shuffle)
($side-effects . fuel-markup--side-effects)
($strong . fuel-markup--strong)
($subheading . fuel-markup--subheading)
($subsection . fuel-markup--subsection)
- ($synopsis . fuel-markup--synopsis)
+ ($subsections . fuel-markup--subsections)
+ ($synopsis . fuel-markup--word-info)
($syntax . fuel-markup--syntax)
($table . fuel-markup--table)
($tag . fuel-markup--tag)
($tags . fuel-markup--tags)
- ($unchecked-example . fuel-markup--example)
+ ($unchecked-example . (lambda (e) (fuel-markup--code e t)))
+ ($url . fuel-markup--url)
($value . fuel-markup--value)
($values . fuel-markup--values)
($values-x/y . fuel-markup--values-x/y)
($var-description . fuel-markup--var-description)
+ ($vocab . fuel-markup--vocab)
($vocab-link . fuel-markup--vocab-link)
($vocab-links . fuel-markup--vocab-links)
($vocab-subsection . fuel-markup--vocab-subsection)
- ($vocabulary . fuel-markup--vocabulary)
($warning . fuel-markup--warning)
(article . fuel-markup--article)
(describe-words . fuel-markup--describe-words)
(vocab-list . fuel-markup--vocab-list)))
-(make-variable-buffer-local
- (defvar fuel-markup--maybe-nl nil))
+(defvar-local fuel-markup--maybe-nl nil)
(defun fuel-markup--print (e)
(cond ((null e) (insert "f"))
((stringp e) (fuel-markup--insert-string e))
((and (listp e) (symbolp (car e))
(assoc (car e) fuel-markup--printers))
- (funcall (cdr (assoc (car e) fuel-markup--printers)) e))
+ (funcall (alist-get (car e) fuel-markup--printers) e))
((and (symbolp e)
(assoc e fuel-markup--printers))
- (funcall (cdr (assoc e fuel-markup--printers)) e))
+ (funcall (alist-get e fuel-markup--printers) e))
((listp e) (mapc 'fuel-markup--print e))
((symbolp e) (fuel-markup--print (list '$link e)))
(t (insert (format "\n%S\n" e)))))
(defun fuel-markup--article (e)
(setq fuel-markup--maybe-nl nil)
(insert (fuel-markup--put-face (cadr e) 'fuel-font-lock-markup-title))
- (newline 2)
+ (newline 1)
(fuel-markup--print (car (cddr e))))
(defun fuel-markup--heading (e)
(fuel-markup--link (cons '$link (cdr e)))
(fuel-markup--maybe-nl))
+(defun fuel-markup--subsections (e)
+ (dolist (link (cdr e))
+ (fuel-markup--insert-nl-if-nb)
+ (insert " - ")
+ (fuel-markup--link (list '$link link))
+ (fuel-markup--maybe-nl)))
+
(defun fuel-markup--vocab-subsection (e)
(fuel-markup--insert-nl-if-nb)
(insert " - ")
(dolist (art (cdr e))
(fuel-markup--insert-button (car art) (cadr art) 'article)
(insert ", "))
- (delete-backward-char 2)
+ (delete-char -2)
(fuel-markup--insert-newline 'left))
(defun fuel-markup--emphasis (e)
(fuel-markup--put-face (cadr e) 'fuel-font-lock-markup-strong)
(insert (cadr e))))
+(define-button-type 'fuel-markup--url
+ 'action 'fuel-markup--follow-url
+ 'face 'fuel-font-lock-markup-link
+ 'follow-link nil)
+
+(defun fuel-markup--follow-url (button)
+ (browse-url (button-get button 'markup-link)))
+
+(defun fuel-markup--url (e)
+ (let ((url (cadr e)))
+ (insert-text-button url
+ :type 'fuel-markup--url
+ 'markup-link url)))
+
(defun fuel-markup--snippet (e)
- (insert (mapconcat '(lambda (s)
+ (insert (mapconcat #'(lambda (s)
(if (stringp s)
- (fuel-font-lock--factor-str s)
+ (factor-font-lock-string s)
(fuel-markup--print-str s)))
(cdr e)
" ")))
-(defun fuel-markup--code (e)
+(defun fuel-markup--code (e indent)
(fuel-markup--insert-nl-if-nb)
(newline)
(dolist (snip (cdr e))
- (if (stringp snip)
- (insert (fuel-font-lock--factor-str snip))
- (fuel-markup--print snip))
- (newline))
+ (unless (stringp snip)
+ (error "snip is not a string"))
+ (dolist (line (split-string (factor-font-lock-string snip) "\n"))
+ (when indent (insert " "))
+ (insert line)
+ (newline)))
(newline))
(defun fuel-markup--command (e)
(fuel-markup--print (cons '$code (cdr e)))
(newline))
-(defun fuel-markup--example (e)
- (fuel-markup--insert-newline)
- (dolist (s (cdr e))
- (fuel-markup--snippet (list '$snippet s))
- (newline)))
-
(defun fuel-markup--markup-example (e)
(fuel-markup--insert-newline)
(fuel-markup--snippet (cons '$snippet (cdr e))))
link)))
(fuel-markup--insert-button label link type)))
-(defun fuel-markup--links (e)
- (dolist (link (cdr e))
- (fuel-markup--link (list '$link link))
- (insert ", "))
- (delete-backward-char 2))
+(defun fuel-markup--links (e sep)
+ "Inserts a sequence of links. Used for rendering see also lists
+and breadcrumb navigation. The items in e can either be strings
+or lists."
+ (let ((links (cdr e)))
+ (when links
+ (dolist (link links)
+ (message (format "link %s" link))
+ (fuel-markup--link
+ (if (listp link)
+ (cons '$link link)
+ (list '$link link)))
+ (insert sep))
+ (delete-char (- (length sep))))))
(defun fuel-markup--index-quotation (q)
- (cond ((null q) null)
+ (cond ((null q) nil)
((listp q) (vconcat (mapcar 'fuel-markup--index-quotation q)))
(t q)))
(defun fuel-markup--index (e)
(let* ((q (fuel-markup--index-quotation (cadr e)))
(cmd `(:fuel* ((,q fuel-index)) "fuel"
- ("builtins" "help" "help.topics" "classes"
- "classes.builtin" "classes.tuple"
- "classes.singleton" "classes.union"
- "classes.intersection" "classes.predicate")))
+ ("assocs" "builtins" "classes" "classes.builtin"
+ "classes.intersection" "classes.predicate"
+ "classes.singleton" "classes.tuple" "classes.union"
+ "help" "help.topics" "namespaces" "sequences"
+ "vocabs" "words")))
(subs (fuel-eval--retort-result (fuel-eval--send/wait cmd 200))))
(when subs
(let ((start (point))
(sort-lines nil start (point))))))
(defun fuel-markup--vocab-link (e)
- (fuel-markup--insert-button (cadr e) (cadr e) 'vocab))
+ (fuel-markup--insert-button (cadr e) (or (car (cddr e)) (cadr e)) 'vocab))
(defun fuel-markup--vocab-links (e)
(dolist (link (cdr e))
(insert " ")))
(defun fuel-markup--vocab-list (e)
- (let ((rows (mapcar '(lambda (elem)
- (list (car elem)
- (list '$vocab-link (cadr elem))
- (caddr elem)))
+ (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)
+(defun fuel-markup--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)))
- (newline))
-
(defun fuel-markup--parse-classes ()
(let ((elems))
(while (looking-at ".+ classes$")
(super (and (cadr objs)
(list (list '$link (cadr objs) (cadr objs) 'word))))
(slots (when (cddr objs)
- (list (mapcar '(lambda (s) (list s " ")) (cddr objs))))))
+ (list (mapcar #'(lambda (s) (list s " ")) (cddr objs))))))
(push `(,class ,@super ,@slots) rows))
(forward-line))
(push `(,heading ($table ,@(reverse rows))) elems))
(when (looking-at "Word *\\(Stack effect\\|Syntax\\)$")
(push (list "Word" (match-string-no-properties 1)) rows)
(forward-line))
- (while (looking-at "\\(.+?\\)\\( +\\(.+\\)\\)?$")
+ (while (looking-at " ?\\(.+?\\)\\( +\\(.+\\)\\)?$")
(let ((word `($link ,(match-string-no-properties 1)
,(match-string-no-properties 1)
word))
(reverse elems)))
(defun fuel-markup--parse-words-desc (desc)
+ "This function parses the text description of the vocab that
+the 'words.' word emits."
(with-temp-buffer
(insert desc)
(goto-char (point-min))
(let ((elems '(($heading "Words"))))
(push (fuel-markup--parse-classes) elems)
(push (fuel-markup--parse-words) elems)
- (reverse elems)))))
+ (reverse (remove nil elems))))))
(defun fuel-markup--describe-words (e)
(when (cadr e)
(dolist (tag (cdr e))
(fuel-markup--tag (list '$tag tag))
(insert ", "))
- (delete-backward-char 2)
+ (delete-char -2)
(fuel-markup--insert-newline)))
(defun fuel-markup--all-tags (e)
- (let* ((cmd `(:fuel* (all-tags :get) "fuel" t))
+ (let* ((cmd `(:fuel* (all-tags) "fuel" t))
(tags (fuel-eval--retort-result (fuel-eval--send/wait cmd))))
(fuel-markup--list
(cons '$list (mapcar (lambda (tag) (list '$link tag tag 'tag)) tags)))))
(dolist (a (cdr e))
(fuel-markup--author (list '$author a))
(insert ", "))
- (delete-backward-char 2)
+ (delete-char -2)
(fuel-markup--insert-newline)))
(defun fuel-markup--all-authors (e)
- (let* ((cmd `(:fuel* (all-authors :get) "fuel" t))
+ (let* ((cmd `(:fuel* (all-authors) "fuel" t))
(authors (fuel-eval--retort-result (fuel-eval--send/wait cmd))))
(fuel-markup--list
(cons '$list (mapcar (lambda (a) (list '$link a a 'author)) authors)))))
+(defun fuel-markup--complex-shuffle (e)
+ (fuel-markup--description
+ `($description "Shuffle word. Rearranges the top of the datastack as "
+ "indicated in the stack effect pattern."))
+ (fuel-markup--elem-with-heading
+ `(nil "The data flow represented by this shuffle word can be more clearly "
+ "expressed using " ($vocab-link "Lexical variables" "locals") ".")
+ "This word is deprecated"))
+
(defun fuel-markup--list (e)
(fuel-markup--insert-nl-if-nb)
(dolist (elt (cdr e))
(delete-blank-lines)
(newline)
(fuel-table--insert
- (mapcar '(lambda (row) (mapcar 'fuel-markup--print-str row)) (cdr e)))
+ (mapcar #'(lambda (row) (mapcar 'fuel-markup--print-str row)) (cdr e)))
(newline))
(defun fuel-markup--instance (e)
(fuel-markup--instance (cons '$instance (cdr e)))
(insert " or f "))
+(defun fuel-markup--sequence (e)
+ (insert "a ")
+ (fuel-markup--link (list '$link 'sequence 'sequence 'word))
+ (insert " of ")
+ (fuel-markup--print (cadr e))
+ (insert "s"))
+
+(defun fuel-markup--or (e)
+ (let ((fst (car (cdr e)))
+ (mid (butlast (cddr e)))
+ (lst (car (last (cdr e)))))
+ (insert (format "%s" fst))
+ (dolist (m mid) (insert (format ", %s" m)))
+ (insert (format " or %s" lst))))
+
(defun fuel-markup--values (e)
(fuel-markup--insert-heading "Inputs and outputs")
(dolist (val (cdr e))
(defun fuel-markup--definition (e)
(fuel-markup--insert-heading "Definition")
- (fuel-markup--code (cons '$code (cdr e))))
+ (fuel-markup--code (cons '$code (cdr e)) nil))
(defun fuel-markup--methods (e)
(fuel-markup--insert-heading "Methods")
- (fuel-markup--code (cons '$code (cdr e))))
+ (fuel-markup--code (cons '$code (cdr e)) nil))
(defun fuel-markup--value (e)
(fuel-markup--insert-heading "Variable value")
(defun fuel-markup--see-also (e)
(fuel-markup--insert-heading "See also")
- (fuel-markup--links (cons '$links (cdr e))))
+ (fuel-markup--links (cons '$links (cdr e)) ", "))
(defun fuel-markup--related (e)
(fuel-markup--insert-heading "See also")
- (fuel-markup--links (cons '$links (cadr e))))
+ (fuel-markup--links (cons '$links (cadr e)) ", "))
(defun fuel-markup--shuffle (e)
(insert "\nShuffle word. Re-arranges the stack "
(fuel-markup--print '($notes ("This word should only be called within the "
($link with-pprint) " combinator."))))
+(defun fuel-markup--prefixed-link (prefix e)
+ (insert (format " %s " prefix))
+ (fuel-markup--link e)
+ (newline))
+
(defun fuel-markup--elem-with-heading (elem heading)
(fuel-markup--insert-heading heading)
(fuel-markup--print (cdr elem))
(fuel-markup--insert-newline))
+(defun fuel-markup--stack-effect (e)
+ (let* ((in (mapconcat 'identity (nth 1 e) " "))
+ (out (mapconcat 'identity (nth 2 e) " "))
+ (str (format "( %s -- %s )" in out)))
+ (fuel-markup--snippet (list '$snippet str))))
+
(defun fuel-markup--quotation (e)
(insert "a ")
(fuel-markup--link (list '$link 'quotation 'quotation 'word))
(insert " with stack effect ")
- (fuel-markup--snippet (list '$snippet (nth 1 e))))
+ (fuel-markup--stack-effect (nth 1 e)))
(defun fuel-markup--warning (e)
(fuel-markup--elem-with-heading e "Warning"))
(defun fuel-markup--notes (e)
(fuel-markup--elem-with-heading e "Notes"))
-(defun fuel-markup--see (e)
+(defun fuel-markup--word-info (e)
+ "Uses the 'see' word to lookup info about a given word. Note
+that this function is called in contexts where it is impossible
+to guess the correct usings, so a static using list is used."
(let* ((word (nth 1 e))
- (cmd (and word `(:fuel* ((:quote ,(format "%S" word)) see) "fuel")))
+ (cmd `(:fuel* ((:quote ,(symbol-name word)) see)
+ "fuel" ("kernel" "lexer" "see" "sequences")))
(ret (and cmd (fuel-eval--send/wait cmd)))
(res (and (not (fuel-eval--retort-error ret))
(fuel-eval--retort-output ret))))
(if res
- (fuel-markup--code (list '$code res))
+ (fuel-markup--code (list '$code res) nil)
(fuel-markup--snippet (list '$snippet " " word)))))
(defun fuel-markup--null (e))
-(defun fuel-markup--synopsis (e)
- (insert (format " %S " e)))
-
\f
(provide 'fuel-markup)
+
;;; fuel-markup.el ends here
projects / factor.git / blobdiff