misc/fuel/fuel-markup.el

   1 ;;; fuel-markup.el -- printing factor help markup
   2
   3 ;; Copyright (C) 2009 Jose Antonio Ortega Ruiz
   4 ;; See http://factorcode.org/license.txt for BSD license.
   5
   6 ;; Author: Jose Antonio Ortega Ruiz <jao@gnu.org>
   7 ;; Keywords: languages, fuel, factor
   8 ;; Start date: Thu Jan 01, 2009 21:43
   9
  10 ;;; Comentary:
  11
  12 ;; Utilities for printing Factor's help markup.
  13
  14 ;;; Code:
  15
  16 (require 'fuel-eval)
  17 (require 'fuel-base)
  18 (require 'fuel-table)
  19
  20 (require 'button)
  21
  22 \f
  23 ;;; Customization:
  24
  25 (defface fuel-font-lock-markup-title '((t (:inherit bold)))
  26   "article titles in help buffers"
  27   :group 'fuel-help
  28   :group 'fuel-faces
  29   :group 'faces)
  30
  31 (defface fuel-font-lock-markup-heading '((t (:inherit bold)))
  32   "headlines in help buffers"
  33   :group 'fuel-help
  34   :group 'fuel-faces
  35   :group 'faces)
  36
  37 (defface fuel-font-lock-markup-link '((t (:inherit link)))
  38   "links to topics in help buffers"
  39   :group 'fuel-help
  40   :group 'fuel-faces
  41   :group 'faces)
  42
  43 (defface fuel-font-lock-markup-emphasis '((t (:inherit italic)))
  44   "emphasized words in help buffers"
  45   :group 'fuel-help
  46   :group 'fuel-faces
  47   :group 'faces)
  48
  49 (defface fuel-font-lock-markup-strong '((t (:inherit link)))
  50   "bold words in help buffers"
  51   :group 'fuel-help
  52   :group 'fuel-faces
  53   :group 'faces)
  54
  55 \f
  56 ;;; Links:
  57
  58 (defvar-local fuel-markup--follow-link-function 'fuel-markup--echo-link)
  59
  60 (define-button-type 'fuel-markup--button
  61   'action 'fuel-markup--follow-link
  62   'face 'fuel-font-lock-markup-link
  63   'follow-link t)
  64
  65 (defun fuel-markup--follow-link (button)
  66   (when fuel-markup--follow-link-function
  67     (funcall fuel-markup--follow-link-function
  68              (button-get button 'markup-link)
  69              (button-get button 'markup-label)
  70              (button-get button 'markup-link-type))))
  71
  72 (defun fuel-markup--echo-link (link label type)
  73   (message "Link %s pointing to %s named %s" label type link))
  74
  75 (defun fuel-markup--insert-button (label link type)
  76   (let ((label (format "%s" label))
  77         (link (if (listp link) link (format "%s" link))))
  78     (insert-text-button label
  79                         :type 'fuel-markup--button
  80                         'markup-link link
  81                         'markup-label label
  82                         'markup-link-type type
  83                         'help-echo (format "%s (%s)" label type))))
  84
  85 (defun fuel-markup--article-title (name)
  86   (let ((name (if (listp name) (cons :seq name) name)))
  87     (fuel-eval--retort-result
  88      (fuel-eval--send/wait `(:fuel* ((,name fuel-get-article-title)) "fuel")))))
  89
  90 (defun fuel-markup--link-at-point ()
  91   (let ((button (condition-case nil (forward-button 0) (error nil))))
  92     (when button
  93       (list (button-get button 'markup-link)
  94             (button-get button 'markup-label)
  95             (button-get button 'markup-link-type)))))
  96
  97 (defun fuel-markup--nav-crumbs (e)
  98   (fuel-markup--links e " > ")
  99   (newline))
 100
 101 ;;; Markup printers:
 102
 103 (defconst fuel-markup--printers
 104   '(($all-tags . fuel-markup--all-tags)
 105     ($all-authors . fuel-markup--all-authors)
 106     ($author . fuel-markup--author)
 107     ($authors . fuel-markup--authors)
 108     ($class-description . fuel-markup--class-description)
 109     ($code . (lambda (e) (fuel-markup--code e t)))
 110     ($command . fuel-markup--command)
 111     ($command-map . fuel-markup--null)
 112     ($complex-shuffle . fuel-markup--complex-shuffle)
 113     ($contract . fuel-markup--contract)
 114     ($curious . fuel-markup--curious)
 115     ($definition . fuel-markup--definition)
 116     ($description . fuel-markup--description)
 117     ($doc-path . fuel-markup--doc-path)
 118     ($emphasis . fuel-markup--emphasis)
 119     ($error-description . fuel-markup--error-description)
 120     ($errors . fuel-markup--errors)
 121     ($example . (lambda (e) (fuel-markup--code e t)))
 122     ($examples . fuel-markup--examples)
 123     ($fuel-nav-crumbs . fuel-markup--nav-crumbs)
 124     ($heading . fuel-markup--heading)
 125     ($index . fuel-markup--index)
 126     ($instance . fuel-markup--instance)
 127     ($io-error . fuel-markup--io-error)
 128     ($link . fuel-markup--link)
 129     ($links . (lambda (e) (fuel-markup--links e ", ")))
 130     ($list . fuel-markup--list)
 131     ($low-level-note . fuel-markup--low-level-note)
 132     ($markup-example . fuel-markup--markup-example)
 133     ($maybe . fuel-markup--maybe)
 134     ($sequence . fuel-markup--sequence)
 135     ($methods . fuel-markup--methods)
 136     ($next-link . (lambda (e) (fuel-markup--prefixed-link "Next:" e)))
 137     ($nl . fuel-markup--newline)
 138     ($notes . fuel-markup--notes)
 139     ($operation . fuel-markup--link)
 140     ($or . fuel-markup--or)
 141     ($parsing-note . fuel-markup--parsing-note)
 142     ($predicate . fuel-markup--predicate)
 143     ($prettyprinting-note . fuel-markup--prettyprinting-note)
 144     ($prev-link . (lambda (e) (fuel-markup--prefixed-link "Prev:" e)))
 145     ($quotation . fuel-markup--quotation)
 146     ($references . fuel-markup--references)
 147     ($related . fuel-markup--related)
 148     ($see . fuel-markup--word-info)
 149     ($see-also . fuel-markup--see-also)
 150     ($shuffle . fuel-markup--shuffle)
 151     ($side-effects . fuel-markup--side-effects)
 152     ($slot . fuel-markup--snippet)
 153     ($snippet . fuel-markup--snippet)
 154     ($strong . fuel-markup--strong)
 155     ($subheading . fuel-markup--subheading)
 156     ($subsection . fuel-markup--subsection)
 157     ($subsections . fuel-markup--subsections)
 158     ($synopsis . fuel-markup--word-info)
 159     ($syntax . fuel-markup--syntax)
 160     ($table . fuel-markup--table)
 161     ($tag . fuel-markup--tag)
 162     ($tags . fuel-markup--tags)
 163     ($unchecked-example . (lambda (e) (fuel-markup--code e t)))
 164     ($url . fuel-markup--url)
 165     ($value . fuel-markup--value)
 166     ($values . fuel-markup--values)
 167     ($values-x/y . fuel-markup--values-x/y)
 168     ($var-description . fuel-markup--var-description)
 169     ($vocab . fuel-markup--vocab)
 170     ($vocab-link . fuel-markup--vocab-link)
 171     ($vocab-links . fuel-markup--vocab-links)
 172     ($vocab-subsection . fuel-markup--vocab-subsection)
 173     ($warning . fuel-markup--warning)
 174     (article . fuel-markup--article)
 175     (describe-words . fuel-markup--describe-words)
 176     (vocab-list . fuel-markup--vocab-list)))
 177
 178 (defvar-local fuel-markup--maybe-nl nil)
 179
 180 (defun fuel-markup--print (e)
 181   (cond ((null e) (insert "f"))
 182         ((stringp e) (fuel-markup--insert-string e))
 183         ((and (listp e) (symbolp (car e))
 184               (assoc (car e) fuel-markup--printers))
 185          (funcall (alist-get (car e) fuel-markup--printers) e))
 186         ((and (symbolp e)
 187               (assoc e fuel-markup--printers))
 188          (funcall (alist-get e fuel-markup--printers) e))
 189         ((listp e) (mapc 'fuel-markup--print e))
 190         ((symbolp e) (fuel-markup--print (list '$link e)))
 191         (t (insert (format "\n%S\n" e)))))
 192
 193 (defun fuel-markup--print-str (e)
 194   (with-temp-buffer
 195     (fuel-markup--print e)
 196     (buffer-string)))
 197
 198 (defun fuel-markup--maybe-nl ()
 199   (setq fuel-markup--maybe-nl (point)))
 200
 201 (defun fuel-markup--insert-newline (&optional justification nosqueeze)
 202   (fill-region (save-excursion (beginning-of-line) (point))
 203                (point)
 204                (or justification 'left)
 205                nosqueeze)
 206   (newline))
 207
 208 (defsubst fuel-markup--insert-nl-if-nb (&optional no-fill)
 209   (unless (eq (save-excursion (beginning-of-line) (point)) (point))
 210     (if no-fill (newline) (fuel-markup--insert-newline))))
 211
 212 (defsubst fuel-markup--put-face (txt face)
 213   (put-text-property 0 (length txt) 'font-lock-face face txt)
 214   txt)
 215
 216 (defun fuel-markup--insert-heading (txt &optional no-nl)
 217   (fuel-markup--insert-nl-if-nb)
 218   (delete-blank-lines)
 219   (unless (bobp) (newline))
 220   (fuel-markup--put-face txt 'fuel-font-lock-markup-heading)
 221   (fuel-markup--insert-string txt)
 222   (unless no-nl (newline)))
 223
 224 (defun fuel-markup--insert-string (str)
 225   (when fuel-markup--maybe-nl
 226     (newline 2)
 227     (setq fuel-markup--maybe-nl nil))
 228   (insert str))
 229
 230 (defun fuel-markup--article (e)
 231   (setq fuel-markup--maybe-nl nil)
 232   (insert (fuel-markup--put-face (cadr e) 'fuel-font-lock-markup-title))
 233   (newline 1)
 234   (fuel-markup--print (car (cddr e))))
 235
 236 (defun fuel-markup--heading (e)
 237   (fuel-markup--insert-heading (cadr e)))
 238
 239 (defun fuel-markup--subheading (e)
 240   (fuel-markup--insert-heading (cadr e)))
 241
 242 (defun fuel-markup--subsection (e)
 243   (fuel-markup--insert-nl-if-nb)
 244   (insert "  - ")
 245   (fuel-markup--link (cons '$link (cdr e)))
 246   (fuel-markup--maybe-nl))
 247
 248 (defun fuel-markup--subsections (e)
 249   (dolist (link (cdr e))
 250     (fuel-markup--insert-nl-if-nb)
 251     (insert "  - ")
 252     (fuel-markup--link (list '$link link))
 253     (fuel-markup--maybe-nl)))
 254
 255 (defun fuel-markup--vocab-subsection (e)
 256   (fuel-markup--insert-nl-if-nb)
 257   (insert "  - ")
 258   (fuel-markup--vocab-link (cons '$vocab-link (cdr e)))
 259   (fuel-markup--maybe-nl))
 260
 261 (defun fuel-markup--newline (e)
 262   (fuel-markup--insert-newline)
 263   (newline))
 264
 265 (defun fuel-markup--doc-path (e)
 266   (fuel-markup--insert-heading "Related topics")
 267   (insert "  ")
 268   (dolist (art (cdr e))
 269     (fuel-markup--insert-button (car art) (cadr art) 'article)
 270     (insert ", "))
 271   (delete-char -2)
 272   (fuel-markup--insert-newline 'left))
 273
 274 (defun fuel-markup--emphasis (e)
 275   (when (stringp (cadr e))
 276     (fuel-markup--put-face (cadr e) 'fuel-font-lock-markup-emphasis)
 277     (insert (cadr e))))
 278
 279 (defun fuel-markup--strong (e)
 280   (when (stringp (cadr e))
 281     (fuel-markup--put-face (cadr e) 'fuel-font-lock-markup-strong)
 282     (insert (cadr e))))
 283
 284 (define-button-type 'fuel-markup--url
 285   'action 'fuel-markup--follow-url
 286   'face 'fuel-font-lock-markup-link
 287   'follow-link nil)
 288
 289 (defun fuel-markup--follow-url (button)
 290   (browse-url (button-get button 'markup-link)))
 291
 292 (defun fuel-markup--url (e)
 293   (let ((url (cadr e)))
 294     (insert-text-button url
 295                         :type 'fuel-markup--url
 296                         'markup-link url)))
 297
 298 (defun fuel-markup--snippet (e)
 299   (insert (mapconcat #'(lambda (s)
 300                         (if (stringp s)
 301                             (factor-font-lock-string s)
 302                           (fuel-markup--print-str s)))
 303                      (cdr e)
 304                      " ")))
 305
 306 (defun fuel-markup--code (e indent)
 307   (fuel-markup--insert-nl-if-nb)
 308   (newline)
 309   (dolist (snip (cdr e))
 310     (unless (stringp snip)
 311       (error "snip is not a string"))
 312     (dolist (line (split-string (factor-font-lock-string snip) "\n"))
 313       (when indent (insert "    "))
 314       (insert line)
 315       (newline)))
 316   (newline))
 317
 318 (defun fuel-markup--command (e)
 319   (fuel-markup--snippet (list '$snippet (nth 3 e))))
 320
 321 (defun fuel-markup--syntax (e)
 322   (fuel-markup--insert-heading "Syntax")
 323   (fuel-markup--print (cons '$code (cdr e)))
 324   (newline))
 325
 326 (defun fuel-markup--markup-example (e)
 327   (fuel-markup--insert-newline)
 328   (fuel-markup--snippet (cons '$snippet (cdr e))))
 329
 330 (defun fuel-markup--link (e)
 331   (let* ((link (or (nth 1 e) 'f))
 332          (type (or (nth 3 e) (if (symbolp link) 'word 'article)))
 333          (label (or (nth 2 e)
 334                     (and (eq type 'article)
 335                          (fuel-markup--article-title link))
 336                     link)))
 337     (fuel-markup--insert-button label link type)))
 338
 339 (defun fuel-markup--links (e sep)
 340   "Inserts a sequence of links. Used for rendering see also lists
 341 and breadcrumb navigation. The items in e can either be strings
 342 or lists."
 343   (let ((links (cdr e)))
 344     (when links
 345       (dolist (link links)
 346         (message (format "link %s" link))
 347         (fuel-markup--link
 348          (if (listp link)
 349              (cons '$link link)
 350            (list '$link link)))
 351         (insert sep))
 352       (delete-char (- (length sep))))))
 353
 354 (defun fuel-markup--index-quotation (q)
 355   (cond ((null q) nil)
 356         ((listp q) (vconcat (mapcar 'fuel-markup--index-quotation q)))
 357         (t q)))
 358
 359 (defun fuel-markup--index (e)
 360   (let* ((q (fuel-markup--index-quotation (cadr e)))
 361          (cmd `(:fuel* ((,q fuel-index)) "fuel"
 362                        ("assocs" "builtins" "classes" "classes.builtin"
 363                         "classes.intersection" "classes.predicate"
 364                         "classes.singleton"  "classes.tuple" "classes.union"
 365                         "help" "help.topics" "namespaces" "sequences"
 366                         "vocabs" "words")))
 367          (subs (fuel-eval--retort-result (fuel-eval--send/wait cmd 200))))
 368     (when subs
 369       (let ((start (point))
 370             (sort-fold-case nil))
 371         (fuel-markup--print subs)
 372         (sort-lines nil start (point))))))
 373
 374 (defun fuel-markup--vocab-link (e)
 375   (fuel-markup--insert-button (cadr e) (or (car (cddr e)) (cadr e)) 'vocab))
 376
 377 (defun fuel-markup--vocab-links (e)
 378   (dolist (link (cdr e))
 379     (insert " ")
 380     (fuel-markup--vocab-link (list '$vocab-link link))
 381     (insert " ")))
 382
 383 (defun fuel-markup--vocab-list (e)
 384   (let ((rows (mapcar #'(lambda (elem)
 385                          (list (list '$vocab-link (car elem))
 386                                (cadr elem)))
 387                       (cdr e))))
 388     (fuel-markup--table (cons '$table rows))))
 389
 390 (defun fuel-markup--vocab (e)
 391   (fuel-markup--insert-nl-if-nb)
 392   (let* ((cmd `(:fuel* ((,(cadr e) fuel-vocab-help)) "fuel" t))
 393          (res (fuel-eval--retort-result (fuel-eval--send/wait cmd))))
 394     (when res (fuel-markup--print res))))
 395
 396 (defun fuel-markup--parse-classes ()
 397   (let ((elems))
 398     (while (looking-at ".+ classes$")
 399       (let ((heading `($heading ,(match-string-no-properties 0)))
 400             (rows))
 401         (forward-line)
 402         (when (looking-at "Class *.+$")
 403           (push (split-string (match-string-no-properties 0) nil t) rows)
 404           (forward-line))
 405         (while (not (looking-at "$"))
 406           (let* ((objs (split-string (thing-at-point 'line) nil t))
 407                  (class (list '$link (car objs) (car objs) 'word))
 408                  (super (and (cadr objs)
 409                              (list (list '$link (cadr objs) (cadr objs) 'word))))
 410                  (slots (when (cddr objs)
 411                           (list (mapcar #'(lambda (s) (list s " ")) (cddr objs))))))
 412             (push `(,class ,@super ,@slots) rows))
 413           (forward-line))
 414         (push `(,heading ($table ,@(reverse rows))) elems))
 415       (forward-line))
 416     (reverse elems)))
 417
 418 (defun fuel-markup--parse-words ()
 419   (let ((elems))
 420     (while (looking-at ".+ words\\|Primitives$")
 421       (let ((heading `($heading ,(match-string-no-properties 0)))
 422             (rows))
 423         (forward-line)
 424         (when (looking-at "Word *\\(Stack effect\\|Syntax\\)$")
 425           (push (list "Word" (match-string-no-properties 1)) rows)
 426           (forward-line))
 427         (while (looking-at " ?\\(.+?\\)\\( +\\(.+\\)\\)?$")
 428           (let ((word `($link ,(match-string-no-properties 1)
 429                               ,(match-string-no-properties 1)
 430                               word))
 431                 (se (and (match-string-no-properties 3)
 432                          `(($snippet ,(match-string-no-properties 3))))))
 433             (push `(,word ,@se) rows))
 434           (forward-line))
 435         (push `(,heading ($table ,@(reverse rows))) elems))
 436       (forward-line))
 437     (reverse elems)))
 438
 439 (defun fuel-markup--parse-words-desc (desc)
 440   "This function parses the text description of the vocab that
 441 the 'words.' word emits."
 442   (with-temp-buffer
 443     (insert desc)
 444     (goto-char (point-min))
 445     (when (re-search-forward "^Words$" nil t)
 446       (forward-line 2)
 447       (let ((elems '(($heading "Words"))))
 448         (push (fuel-markup--parse-classes) elems)
 449         (push (fuel-markup--parse-words) elems)
 450         (reverse (remove nil elems))))))
 451
 452 (defun fuel-markup--describe-words (e)
 453   (when (cadr e)
 454     (fuel-markup--print (fuel-markup--parse-words-desc (cadr e)))))
 455
 456 (defun fuel-markup--tag (e)
 457   (fuel-markup--link (list '$link (cadr e) (cadr e) 'tag)))
 458
 459 (defun fuel-markup--tags (e)
 460   (when (cdr e)
 461     (fuel-markup--insert-heading "Tags: " t)
 462     (dolist (tag (cdr e))
 463       (fuel-markup--tag (list '$tag tag))
 464       (insert ", "))
 465     (delete-char -2)
 466     (fuel-markup--insert-newline)))
 467
 468 (defun fuel-markup--all-tags (e)
 469   (let* ((cmd `(:fuel* (all-tags) "fuel" t))
 470          (tags (fuel-eval--retort-result (fuel-eval--send/wait cmd))))
 471     (fuel-markup--list
 472      (cons '$list (mapcar (lambda (tag) (list '$link tag tag 'tag)) tags)))))
 473
 474 (defun fuel-markup--author (e)
 475   (fuel-markup--link (list '$link (cadr e) (cadr e) 'author)))
 476
 477 (defun fuel-markup--authors (e)
 478   (when (cdr e)
 479     (fuel-markup--insert-heading "Authors: " t)
 480     (dolist (a (cdr e))
 481       (fuel-markup--author (list '$author a))
 482       (insert ", "))
 483     (delete-char -2)
 484     (fuel-markup--insert-newline)))
 485
 486 (defun fuel-markup--all-authors (e)
 487   (let* ((cmd `(:fuel* (all-authors) "fuel" t))
 488          (authors (fuel-eval--retort-result (fuel-eval--send/wait cmd))))
 489     (fuel-markup--list
 490      (cons '$list (mapcar (lambda (a) (list '$link a a 'author)) authors)))))
 491
 492 (defun fuel-markup--complex-shuffle (e)
 493   (fuel-markup--description
 494    `($description "Shuffle word. Rearranges the top of the datastack as "
 495                   "indicated in the stack effect pattern."))
 496   (fuel-markup--elem-with-heading
 497    `(nil "The data flow represented by this shuffle word can be more clearly "
 498          "expressed using " ($vocab-link "Lexical variables" "locals") ".")
 499    "This word is deprecated"))
 500
 501 (defun fuel-markup--list (e)
 502   (fuel-markup--insert-nl-if-nb)
 503   (dolist (elt (cdr e))
 504     (insert " - ")
 505     (fuel-markup--print elt)
 506     (fuel-markup--insert-newline)))
 507
 508 (defun fuel-markup--table (e)
 509   (fuel-markup--insert-newline)
 510   (delete-blank-lines)
 511   (newline)
 512   (fuel-table--insert
 513    (mapcar #'(lambda (row) (mapcar 'fuel-markup--print-str row)) (cdr e)))
 514   (newline))
 515
 516 (defun fuel-markup--instance (e)
 517   (insert " an instance of ")
 518   (fuel-markup--print (cadr e)))
 519
 520 (defun fuel-markup--maybe (e)
 521   (fuel-markup--instance (cons '$instance (cdr e)))
 522   (insert " or f "))
 523
 524 (defun fuel-markup--sequence (e)
 525   (insert "a ")
 526   (fuel-markup--link (list '$link 'sequence 'sequence 'word))
 527   (insert " of ")
 528   (fuel-markup--print (cadr e))
 529   (insert "s"))
 530
 531 (defun fuel-markup--or (e)
 532   (let ((fst (car (cdr e)))
 533         (mid (butlast (cddr e)))
 534         (lst (car (last (cdr e)))))
 535     (insert (format "%s" fst))
 536     (dolist (m mid) (insert (format ", %s" m)))
 537     (insert (format " or %s" lst))))
 538
 539 (defun fuel-markup--values (e)
 540   (fuel-markup--insert-heading "Inputs and outputs")
 541   (dolist (val (cdr e))
 542     (insert " " (car val) " - ")
 543     (fuel-markup--print (cdr val))
 544     (newline)))
 545
 546 (defun fuel-markup--predicate (e)
 547   (fuel-markup--values '($values ("object" object) ("?" "a boolean")))
 548   (let ((word (make-symbol (substring (format "%s" (cadr e)) 0 -1))))
 549   (fuel-markup--description
 550    `($description "Tests if the object is an instance of the "
 551                   ($link ,word) " class."))))
 552
 553 (defun fuel-markup--side-effects (e)
 554   (fuel-markup--insert-heading "Side effects")
 555   (insert "Modifies ")
 556   (fuel-markup--print (cdr e))
 557   (fuel-markup--insert-newline))
 558
 559 (defun fuel-markup--definition (e)
 560   (fuel-markup--insert-heading "Definition")
 561   (fuel-markup--code (cons '$code (cdr e)) nil))
 562
 563 (defun fuel-markup--methods (e)
 564   (fuel-markup--insert-heading "Methods")
 565   (fuel-markup--code (cons '$code (cdr e)) nil))
 566
 567 (defun fuel-markup--value (e)
 568   (fuel-markup--insert-heading "Variable value")
 569   (insert "Current value in global namespace: ")
 570   (fuel-markup--snippet (cons '$snippet (cdr e)))
 571   (newline))
 572
 573 (defun fuel-markup--values-x/y (e)
 574   (fuel-markup--values '($values ("x" "number") ("y" "number"))))
 575
 576 (defun fuel-markup--curious (e)
 577   (fuel-markup--insert-heading "For the curious...")
 578   (fuel-markup--print (cdr e)))
 579
 580 (defun fuel-markup--references (e)
 581   (fuel-markup--insert-heading "References")
 582   (dolist (ref (cdr e))
 583     (if (listp ref)
 584         (fuel-markup--print ref)
 585       (fuel-markup--subsection (list '$subsection ref)))))
 586
 587 (defun fuel-markup--see-also (e)
 588   (fuel-markup--insert-heading "See also")
 589   (fuel-markup--links (cons '$links (cdr e)) ", "))
 590
 591 (defun fuel-markup--related (e)
 592   (fuel-markup--insert-heading "See also")
 593   (fuel-markup--links (cons '$links (cadr e)) ", "))
 594
 595 (defun fuel-markup--shuffle (e)
 596   (insert "\nShuffle word. Re-arranges the stack "
 597           "according to the stack effect pattern.")
 598   (fuel-markup--insert-newline))
 599
 600 (defun fuel-markup--low-level-note (e)
 601   (fuel-markup--print '($notes "Calling this word directly is not necessary "
 602                                "in most cases. "
 603                                "Higher-level words call it automatically.")))
 604
 605 (defun fuel-markup--parsing-note (e)
 606   (fuel-markup--insert-nl-if-nb)
 607   (insert "This word should only be called from parsing words.")
 608   (fuel-markup--insert-newline))
 609
 610 (defun fuel-markup--io-error (e)
 611   (fuel-markup--errors '($errors "Throws an error if the I/O operation fails.")))
 612
 613 (defun fuel-markup--prettyprinting-note (e)
 614   (fuel-markup--print '($notes ("This word should only be called within the "
 615                                 ($link with-pprint) " combinator."))))
 616
 617 (defun fuel-markup--prefixed-link (prefix e)
 618   (insert (format "  %s " prefix))
 619   (fuel-markup--link e)
 620   (newline))
 621
 622 (defun fuel-markup--elem-with-heading (elem heading)
 623   (fuel-markup--insert-heading heading)
 624   (fuel-markup--print (cdr elem))
 625   (fuel-markup--insert-newline))
 626
 627 (defun fuel-markup--stack-effect (e)
 628   (let* ((in (mapconcat 'identity (nth 1 e) " "))
 629          (out (mapconcat 'identity (nth 2 e) " "))
 630          (str (format "( %s -- %s )" in out)))
 631     (fuel-markup--snippet (list '$snippet str))))
 632
 633 (defun fuel-markup--quotation (e)
 634   (insert "a ")
 635   (fuel-markup--link (list '$link 'quotation 'quotation 'word))
 636   (insert " with stack effect ")
 637   (fuel-markup--stack-effect (nth 1 e)))
 638
 639 (defun fuel-markup--warning (e)
 640   (fuel-markup--elem-with-heading e "Warning"))
 641
 642 (defun fuel-markup--description (e)
 643   (fuel-markup--elem-with-heading e "Word description"))
 644
 645 (defun fuel-markup--class-description (e)
 646   (fuel-markup--elem-with-heading e "Class description"))
 647
 648 (defun fuel-markup--error-description (e)
 649   (fuel-markup--elem-with-heading e "Error description"))
 650
 651 (defun fuel-markup--var-description (e)
 652   (fuel-markup--elem-with-heading e "Variable description"))
 653
 654 (defun fuel-markup--contract (e)
 655   (fuel-markup--elem-with-heading e "Generic word contract"))
 656
 657 (defun fuel-markup--errors (e)
 658   (fuel-markup--elem-with-heading e "Errors"))
 659
 660 (defun fuel-markup--examples (e)
 661   (fuel-markup--elem-with-heading e "Examples"))
 662
 663 (defun fuel-markup--notes (e)
 664   (fuel-markup--elem-with-heading e "Notes"))
 665
 666 (defun fuel-markup--word-info (e)
 667   "Uses the 'see' word to lookup info about a given word. Note
 668 that this function is called in contexts where it is impossible
 669 to guess the correct usings, so a static using list is used."
 670   (let* ((word (nth 1 e))
 671          (cmd `(:fuel* ((:quote ,(symbol-name word)) see)
 672                        "fuel" ("kernel" "lexer" "see" "sequences")))
 673          (ret (and cmd (fuel-eval--send/wait cmd)))
 674          (res (and (not (fuel-eval--retort-error ret))
 675                    (fuel-eval--retort-output ret))))
 676     (if res
 677         (fuel-markup--code (list '$code res) nil)
 678       (fuel-markup--snippet (list '$snippet " " word)))))
 679
 680 (defun fuel-markup--null (e))
 681
 682 \f
 683 (provide 'fuel-markup)
 684
 685 ;;; fuel-markup.el ends here