From 796a7e9d3701dfc3343b687d54e6f5b1bb52adef Mon Sep 17 00:00:00 2001 From: "Jose A. Ortega Ruiz" Date: Sat, 3 Jan 2009 16:37:28 +0100 Subject: [PATCH] FUEL: Help system overhaul. --- extra/fuel/fuel.factor | 84 +++++++- misc/fuel/README | 6 +- misc/fuel/fuel-autodoc.el | 21 +- misc/fuel/fuel-font-lock.el | 21 +- misc/fuel/fuel-help.el | 158 ++++++-------- misc/fuel/fuel-markup.el | 417 ++++++++++++++++++++++++++++++++++++ misc/fuel/fuel-xref.el | 3 +- 7 files changed, 584 insertions(+), 126 deletions(-) create mode 100644 misc/fuel/fuel-markup.el diff --git a/extra/fuel/fuel.factor b/extra/fuel/fuel.factor index c1d90ebbcc..a3cb6a9a22 100644 --- a/extra/fuel/fuel.factor +++ b/extra/fuel/fuel.factor @@ -1,11 +1,12 @@ -! Copyright (C) 2008 Jose Antonio Ortega Ruiz. +! Copyright (C) 2008, 2009 Jose Antonio Ortega Ruiz. ! See http://factorcode.org/license.txt for BSD license. USING: accessors arrays assocs classes.tuple combinators -compiler.units continuations debugger definitions io io.pathnames -io.streams.string kernel lexer math math.order memoize namespaces -parser prettyprint sequences sets sorting source-files strings summary -tools.vocabs vectors vocabs vocabs.parser words ; +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 prettyprint sequences +sets sorting source-files strings summary tools.vocabs vectors vocabs +vocabs.parser words ; IN: fuel @@ -56,6 +57,12 @@ GENERIC: fuel-pprint ( obj -- ) M: object fuel-pprint pprint ; inline +: fuel-maybe-scape ( ch -- seq ) + dup "?#()[]'`" member? [ CHAR: \ swap 2array ] [ 1array ] if ; + +M: word fuel-pprint + name>> V{ } clone [ fuel-maybe-scape append ] reduce >string write ; + M: f fuel-pprint drop "nil" write ; inline M: integer fuel-pprint pprint ; inline @@ -144,8 +151,8 @@ SYMBOL: :uses : fuel-run-file ( path -- ) [ fuel-set-use-hook run-file ] curry with-scope ; inline -: fuel-with-autouse ( quot -- ) - [ auto-use? on fuel-set-use-hook call ] curry with-scope ; +: fuel-with-autouse ( quot -- ) + [ auto-use? on fuel-set-use-hook call ] curry with-scope ; inline : (fuel-get-uses) ( lines -- ) [ parse-fresh drop ] curry with-compilation-unit ; inline @@ -218,6 +225,69 @@ MEMO: (fuel-vocab-words) ( name -- seq ) : fuel-get-words ( prefix names -- ) (fuel-get-words) fuel-eval-set-result ; inline +! Help support + +MEMO: fuel-articles-seq ( -- seq ) + articles get values ; + +: fuel-find-articles ( title -- seq ) + [ [ article-title ] dip = ] curry fuel-articles-seq swap filter ; + +MEMO: fuel-find-article ( title -- article/f ) + fuel-find-articles dup empty? [ drop f ] [ first ] if ; + +MEMO: fuel-article-title ( name -- title/f ) + articles get at [ article-title ] [ f ] if* ; + +: fuel-get-article ( name -- ) + article fuel-eval-set-result ; + +: fuel-value-str ( word -- str ) + [ pprint-short ] with-string-writer ; inline + +: fuel-definition-str ( word -- str ) + [ see ] with-string-writer ; inline + +: fuel-methods-str ( word -- str ) + methods dup empty? not [ + [ [ see nl ] each ] with-string-writer + ] [ drop f ] if ; inline + +: fuel-related-words ( word -- seq ) + dup "related" word-prop remove ; inline + +: fuel-parent-topics ( word -- seq ) + help-path [ dup article-title swap 2array ] map ; inline + +: (fuel-word-help) ( word -- element ) + dup \ article swap article-title rot + [ + { + [ fuel-parent-topics [ \ $doc-path prefix , ] unless-empty ] + [ \ $vocabulary swap vocabulary>> 2array , ] + [ word-help % ] + [ fuel-related-words [ \ $related swap 2array , ] unless-empty ] + [ get-global [ \ $value swap fuel-value-str 2array , ] when* ] + [ \ $definition swap fuel-definition-str 2array , ] + [ fuel-methods-str [ \ $methods swap 2array , ] when* ] + } cleave + ] { } make 3array ; + +MEMO: fuel-find-word ( name -- word/f ) + [ [ name>> ] dip = ] curry all-words swap filter + dup empty? not [ first ] [ drop f ] if ; + +: fuel-word-help ( name -- ) + fuel-find-word [ [ auto-use? on (fuel-word-help) ] with-scope ] [ f ] if* + fuel-eval-set-result ; inline + +: (fuel-word-see) ( word -- elem ) + [ name>> \ article swap ] + [ [ see ] with-string-writer \ $code swap 2array ] bi 3array ; inline + +: fuel-word-see ( name -- ) + fuel-find-word [ [ auto-use? on (fuel-word-see) ] with-scope ] [ f ] if* + fuel-eval-set-result ; inline ! -run=fuel support diff --git a/misc/fuel/README b/misc/fuel/README index b670eef84d..36415bc225 100644 --- a/misc/fuel/README +++ b/misc/fuel/README @@ -94,10 +94,12 @@ C-cC-eC-r is the same as C-cC-er)). * In the Help browser: - - RET : help for word at point + - h : help for word at point - f/b : next/previous page - SPC/S-SPC : scroll up/down - - TAB/S-TAB : next/previous headline + - TAB/S-TAB : next/previous link + - c : clean browsing history + - M-. : edit word at point in Emacs - C-cz : switch to listener - q : bury buffer diff --git a/misc/fuel/fuel-autodoc.el b/misc/fuel/fuel-autodoc.el index 151631eea1..53b5228965 100644 --- a/misc/fuel/fuel-autodoc.el +++ b/misc/fuel/fuel-autodoc.el @@ -1,6 +1,6 @@ ;;; fuel-autodoc.el -- doc snippets in the echo area -;; Copyright (C) 2008 Jose Antonio Ortega Ruiz +;; Copyright (C) 2008, 2009 Jose Antonio Ortega Ruiz ;; See http://factorcode.org/license.txt for BSD license. ;; Author: Jose Antonio Ortega Ruiz @@ -32,23 +32,6 @@ :type 'boolean) - -;;; Highlighting for autodoc messages: - -(defvar fuel-autodoc--font-lock-buffer - (let ((buffer (get-buffer-create " *fuel help minibuffer messages*"))) - (set-buffer buffer) - (set-syntax-table fuel-syntax--syntax-table) - (fuel-font-lock--font-lock-setup) - buffer)) - -(defun fuel-autodoc--font-lock-str (str) - (set-buffer fuel-autodoc--font-lock-buffer) - (erase-buffer) - (insert str) - (let ((font-lock-verbose nil)) (font-lock-fontify-buffer)) - (buffer-string)) - ;;; Eldoc function: @@ -65,7 +48,7 @@ (res (fuel-eval--retort-result ret))) (when (and ret (not (fuel-eval--retort-error ret)) (stringp res)) (if fuel-autodoc-minibuffer-font-lock - (fuel-autodoc--font-lock-str res) + (fuel-font-lock--factor-str res) res)))))) (make-variable-buffer-local diff --git a/misc/fuel/fuel-font-lock.el b/misc/fuel/fuel-font-lock.el index 1c37de7b18..d4ce88cf20 100644 --- a/misc/fuel/fuel-font-lock.el +++ b/misc/fuel/fuel-font-lock.el @@ -1,6 +1,6 @@ ;;; fuel-font-lock.el -- font lock for factor code -;; Copyright (C) 2008 Jose Antonio Ortega Ruiz +;; Copyright (C) 2008, 2009 Jose Antonio Ortega Ruiz ;; See http://factorcode.org/license.txt for BSD license. ;; Author: Jose Antonio Ortega Ruiz @@ -99,5 +99,24 @@ fuel-syntax--syntactic-keywords)))))) + +;;; Fontify strings as Factor code: + +(defvar fuel-font-lock--font-lock-buffer + (let ((buffer (get-buffer-create " *fuel font lock*"))) + (set-buffer buffer) + (set-syntax-table fuel-syntax--syntax-table) + (fuel-font-lock--font-lock-setup) + buffer)) + +(defun fuel-font-lock--factor-str (str) + (save-current-buffer + (set-buffer fuel-font-lock--font-lock-buffer) + (erase-buffer) + (insert str) + (let ((font-lock-verbose nil)) (font-lock-fontify-buffer)) + (buffer-string))) + + (provide 'fuel-font-lock) ;;; fuel-font-lock.el ends here diff --git a/misc/fuel/fuel-help.el b/misc/fuel/fuel-help.el index 325e2971be..dc40463362 100644 --- a/misc/fuel/fuel-help.el +++ b/misc/fuel/fuel-help.el @@ -1,6 +1,6 @@ ;;; fuel-help.el -- accessing Factor's help system -;; Copyright (C) 2008 Jose Antonio Ortega Ruiz +;; Copyright (C) 2008, 2009 Jose Antonio Ortega Ruiz ;; See http://factorcode.org/license.txt for BSD license. ;; Author: Jose Antonio Ortega Ruiz @@ -15,12 +15,15 @@ ;;; Code: (require 'fuel-eval) +(require 'fuel-markup) (require 'fuel-autodoc) (require 'fuel-completion) (require 'fuel-font-lock) (require 'fuel-popup) (require 'fuel-base) +(require 'button) + ;;; Customization: @@ -33,32 +36,21 @@ :type 'boolean :group 'fuel-help) -(defcustom fuel-help-use-minibuffer t - "When enabled, use the minibuffer for short help messages." - :type 'boolean - :group 'fuel-help) - -(defcustom fuel-help-mode-hook nil - "Hook run by `factor-help-mode'." - :type 'hook - :group 'fuel-help) - (defcustom fuel-help-history-cache-size 50 "Maximum number of pages to keep in the help browser cache." :type 'integer :group 'fuel-help) -(fuel-font-lock--defface fuel-font-lock-help-headlines - 'bold fuel-hep "headlines in help buffers") - ;;; Help browser history: -(defvar fuel-help--history +(defun fuel-help--make-history () (list nil ; current (make-ring fuel-help-history-cache-size) ; previous (make-ring fuel-help-history-cache-size))) ; next +(defvar fuel-help--history (fuel-help--make-history)) + (defun fuel-help--history-push (term) (when (and (car fuel-help--history) (not (string= (caar fuel-help--history) (car term)))) @@ -86,94 +78,75 @@ (defvar fuel-help--prompt-history nil) -(defun fuel-help--show-help (&optional see word) - (let* ((def (or word (fuel-syntax-symbol-at-point))) +(defun fuel-help--read-word (see) + (let* ((def (fuel-syntax-symbol-at-point)) (prompt (format "See%s help on%s: " (if see " short" "") (if def (format " (%s)" def) ""))) (ask (or (not (memq major-mode '(factor-mode fuel-help-mode))) (not def) - fuel-help-always-ask)) - (def (if ask (fuel-completion--read-word prompt - def - 'fuel-help--prompt-history - t) - def)) - (cmd `(:fuel* ((:quote ,def) ,(if see 'see 'help)) t))) - (message "Looking up '%s' ..." def) - (fuel-eval--send cmd `(lambda (r) (fuel-help--show-help-cont ,def r))))) + fuel-help-always-ask))) + (if ask (fuel-completion--read-word prompt + def + 'fuel-help--prompt-history + t) + def))) -(defun fuel-help--show-help-cont (def ret) - (let ((out (fuel-eval--retort-output ret))) - (if (or (fuel-eval--retort-error ret) (empty-string-p out)) - (message "No help for '%s'" def) - (fuel-help--insert-contents def out)))) +(defun fuel-help--word-help (&optional see word) + (let ((def (or word (fuel-help--read-word see)))) + (when def + (let ((cmd `(:fuel* (,def ,(if see 'fuel-word-see 'fuel-word-help)) + "fuel" t))) + (message "Looking up '%s' ..." def) + (let* ((ret (fuel-eval--send/wait cmd 2000)) + (res (fuel-eval--retort-result ret))) + (if (not res) + (message "No help for '%s'" def) + (fuel-help--insert-contents def res))))))) -(defun fuel-help--insert-contents (def str &optional nopush) +(defun fuel-help--get-article (name label) + (message "Retriving article ...") + (let* ((cmd `(:fuel* ((,name fuel-get-article)) "fuel" t)) + (ret (fuel-eval--send/wait cmd 2000)) + (res (fuel-eval--retort-result ret))) + (fuel-help--insert-contents label res) + (message ""))) + +(defun fuel-help--follow-link (label link type) + (let ((fuel-help-always-ask nil)) + (cond ((eq type 'word) (fuel-help--word-help nil link)) + ((eq type 'article) (fuel-help--get-article link label)) + (t (message (format "Links of type %s not yet implemented" type)))))) + +(defun fuel-help--insert-contents (def art &optional nopush) (let ((hb (fuel-help--buffer)) (inhibit-read-only t) (font-lock-verbose nil)) (set-buffer hb) (erase-buffer) - (insert str) + (if (stringp art) + (insert art) + (fuel-markup--print art) + (fuel-markup--insert-newline)) (unless nopush - (goto-char (point-min)) - (when (re-search-forward (format "^%s" def) nil t) - (beginning-of-line) - (kill-region (point-min) (point)) - (fuel-help--history-push (cons def (buffer-string))))) + (fuel-help--history-push (cons def (buffer-string)))) (set-buffer-modified-p nil) (fuel-popup--display) (goto-char (point-min)) - (message "%s" def))) - - -;;; Help mode font lock: - -(defconst fuel-help--headlines - (regexp-opt '("Class description" - "Definition" - "Errors" - "Examples" - "Generic word contract" - "Inputs and outputs" - "Methods" - "Notes" - "Parent topics:" - "See also" - "Side effects" - "Syntax" - "Variable description" - "Variable value" - "Vocabulary" - "Warning" - "Word description") - t)) - -(defconst fuel-help--headlines-regexp (format "^%s" fuel-help--headlines)) - -(defconst fuel-help--font-lock-keywords - `(,@fuel-font-lock--font-lock-keywords - (,fuel-help--headlines-regexp . 'fuel-font-lock-help-headlines))) - + (message ""))) ;;; Interactive help commands: -(defun fuel-help-short (&optional arg) - "See a help summary of symbol at point. -By default, the information is shown in the minibuffer. When -called with a prefix argument, the information is displayed in a -separate help buffer." - (interactive "P") - (if (if fuel-help-use-minibuffer (not arg) arg) - (fuel-help--word-synopsis) - (fuel-help--show-help t))) +(defun fuel-help-short () + "See help summary of symbol at point." + (interactive) + (fuel-help--word-help t)) (defun fuel-help () "Show extended help about the symbol at point, using a help buffer." (interactive) - (fuel-help--show-help)) + (fuel-help--word-help)) (defun fuel-help-next () "Go to next page in help browser." @@ -193,15 +166,12 @@ buffer." (error "No previous page")) (fuel-help--insert-contents (car item) (cdr item) t))) -(defun fuel-help-next-headline (&optional count) - (interactive "P") - (end-of-line) - (when (re-search-forward fuel-help--headlines-regexp nil t (or count 1)) - (beginning-of-line))) - -(defun fuel-help-previous-headline (&optional count) - (interactive "P") - (re-search-backward fuel-help--headlines-regexp nil t count)) +(defun fuel-help-clean-history () + "Clean up the help browser cache of visited pages." + (interactive) + (when (y-or-n-p "Clean browsing history? ") + (setq fuel-help--history (fuel-help--make-history))) + (message "")) ;;;; Help mode map: @@ -209,15 +179,14 @@ buffer." (defvar fuel-help-mode-map (let ((map (make-sparse-keymap))) (suppress-keymap map) - (define-key map "\C-m" 'fuel-help) + (set-keymap-parent map button-buffer-map) (define-key map "b" 'fuel-help-previous) + (define-key map "c" 'fuel-help-clean-history) (define-key map "f" 'fuel-help-next) + (define-key map "h" 'fuel-help) (define-key map "l" 'fuel-help-previous) (define-key map "p" 'fuel-help-previous) (define-key map "n" 'fuel-help-next) - (define-key map (kbd "TAB") 'fuel-help-next-headline) - (define-key map (kbd "S-TAB") 'fuel-help-previous-headline) - (define-key map [(backtab)] 'fuel-help-previous-headline) (define-key map (kbd "SPC") 'scroll-up) (define-key map (kbd "S-SPC") 'scroll-down) (define-key map "\M-." 'fuel-edit-word-at-point) @@ -235,16 +204,15 @@ buffer." (kill-all-local-variables) (buffer-disable-undo) (use-local-map fuel-help-mode-map) + (set-syntax-table fuel-syntax--syntax-table) (setq mode-name "FUEL Help") (setq major-mode 'fuel-help-mode) - (fuel-font-lock--font-lock-setup fuel-help--font-lock-keywords t) + (setq fuel-markup--follow-link-function 'fuel-help--follow-link) (setq fuel-autodoc-mode-string "") (fuel-autodoc-mode) - (run-mode-hooks 'fuel-help-mode-hook) - (setq buffer-read-only t)) diff --git a/misc/fuel/fuel-markup.el b/misc/fuel/fuel-markup.el new file mode 100644 index 0000000000..0c83c74040 --- /dev/null +++ b/misc/fuel/fuel-markup.el @@ -0,0 +1,417 @@ +;;; fuel-markup.el -- printing factor help markup + +;; Copyright (C) 2009 Jose Antonio Ortega Ruiz +;; See http://factorcode.org/license.txt for BSD license. + +;; Author: Jose Antonio Ortega Ruiz +;; Keywords: languages, fuel, factor +;; Start date: Thu Jan 01, 2009 21:43 + +;;; Comentary: + +;; Utilities for printing Factor's help markup. + +;;; Code: + +(require 'fuel-eval) +(require 'fuel-font-lock) +(require 'fuel-base) + +(require 'button) +(require 'table) + + +;;; 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") + + +;;; Links: + +(make-variable-buffer-local + (defvar fuel-markup--follow-link-function 'fuel-markup--echo-link)) + +(define-button-type 'fuel-markup--button + 'action 'fuel-markup--follow-link + 'face 'fuel-font-lock-markup-link + 'follow-link t) + +(defun fuel-markup--follow-link (button) + (when fuel-markup--follow-link-function + (funcall fuel-markup--follow-link-function + (button-label button) + (button-get button 'markup-link) + (button-get button 'markup-link-type)))) + +(defun fuel-markup--echo-link (label link type) + (message "Link %s pointing to %s named %s" label type link)) + +(defun fuel-markup--insert-button (label link type) + (insert-text-button (format "%s" label) + :type 'fuel-markup--button + 'markup-link (format "%s" link) + 'markup-link-type type)) + +(defun fuel-markup--article-title (name) + (fuel-eval--retort-result + (fuel-eval--send/wait `(:fuel* ((,name fuel-article-title :get)) "fuel")))) + + +;;; Markup printers: + +(defconst fuel-markup--printers + '(($class-description . fuel-markup--class-description) + ($code . fuel-markup--code) + ($contract . fuel-markup--contract) + ($curious . fuel-markup--curious) + ($definition . fuel-markup--definition) + ($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) + ($examples . fuel-markup--examples) + ($heading . fuel-markup--heading) + ($instance . fuel-markup--instance) + ($io-error . fuel-markup--io-error) + ($link . fuel-markup--link) + ($links . fuel-markup--links) + ($list . fuel-markup--list) + ($low-level-note . fuel-markup--low-level-note) + ($markup-example . fuel-markup--markup-example) + ($maybe . fuel-markup--maybe) + ($methods . fuel-markup--methods) + ($nl . fuel-markup--newline) + ($notes . fuel-markup--notes) + ($parsing-note . fuel-markup--parsing-note) + ($prettyprinting-note . fuel-markup--prettyprinting-note) + ($quotation . fuel-markup--quotation) + ($references . fuel-markup--references) + ($related . fuel-markup--related) + ($see . fuel-markup--see) + ($see-also . fuel-markup--see-also) + ($shuffle . fuel-markup--shuffle) + ($side-effects . fuel-markup--side-effects) + ($slot . fuel-markup--snippet) + ($snippet . fuel-markup--snippet) + ($strong . fuel-markup--strong) + ($subheading . fuel-markup--subheading) + ($subsection . fuel-markup--subsection) + ($synopsis . fuel-markup--synopsis) + ($syntax . fuel-markup--syntax) + ($table . fuel-markup--table) + ($unchecked-example . fuel-markup--example) + ($value . fuel-markup--value) + ($values . fuel-markup--values) + ($values-x/y . fuel-markup--values-x/y) + ($var-description . fuel-markup--var-description) + ($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))) + +(make-variable-buffer-local + (defvar fuel-markup--maybe-nl nil)) + +(defun fuel-markup--print (e) + (cond ((null e)) + ((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)) + ((and (symbolp e) + (assoc e fuel-markup--printers)) + (funcall (cdr (assoc 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--maybe-nl () + (setq fuel-markup--maybe-nl (point))) + +(defun fuel-markup--insert-newline (&optional justification) + (fill-region (save-excursion (beginning-of-line) (point)) + (point) + (or justification 'left)) + (newline)) + +(defsubst fuel-markup--insert-nl-if-nb (&optional no-fill) + (unless (eq (save-excursion (beginning-of-line) (point)) (point)) + (if no-fill (newline) (fuel-markup--insert-newline)))) + +(defsubst fuel-markup--put-face (txt face) + (put-text-property 0 (length txt) 'font-lock-face face txt) + txt) + +(defun fuel-markup--insert-heading (txt &optional no-nl) + (fuel-markup--insert-nl-if-nb) + (unless (bobp) (newline)) + (fuel-markup--put-face txt 'fuel-font-lock-markup-heading) + (fuel-markup--insert-string txt) + (unless no-nl (newline))) + +(defun fuel-markup--insert-string (str) + (when fuel-markup--maybe-nl + (newline 2) + (setq fuel-markup--maybe-nl nil)) + (insert str)) + +(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) + (fuel-markup--print (car (cddr e)))) + +(defun fuel-markup--heading (e) + (fuel-markup--insert-heading (cadr e))) + +(defun fuel-markup--subheading (e) + (fuel-markup--insert-heading (cadr e))) + +(defun fuel-markup--subsection (e) + (fuel-markup--insert-nl-if-nb) + (insert " - ") + (fuel-markup--link (cons '$link (cdr e))) + (fuel-markup--maybe-nl)) + +(defun fuel-markup--newline (e) + (fuel-markup--insert-newline) + (newline)) + +(defun fuel-markup--doc-path (e) + (fuel-markup--insert-heading "Related topics") + (insert " ") + (dolist (art (cdr e)) + (fuel-markup--insert-button (car art) (cadr art) 'article) + (insert ", ")) + (delete-backward-char 2) + (fuel-markup--insert-newline 'left)) + +(defun fuel-markup--emphasis (e) + (when (stringp (cadr e)) + (fuel-markup--put-face (cadr e) 'fuel-font-lock-markup-emphasis) + (insert (cadr e)))) + +(defun fuel-markup--strong (e) + (when (stringp (cadr e)) + (fuel-markup--put-face (cadr e) 'fuel-font-lock-markup-strong) + (insert (cadr e)))) + +(defun fuel-markup--snippet (e) + (let ((snip (cadr e))) + (if (stringp snip) + (insert (fuel-font-lock--factor-str snip)) + (fuel-markup--print snip)))) + +(defun fuel-markup--code (e) + (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)) + (newline)) + +(defun fuel-markup--syntax (e) + (fuel-markup--insert-heading "Syntax") + (fuel-markup--print (cons '$code (cdr e))) + (newline)) + +(defun fuel-markup--examples (e) + (fuel-markup--insert-heading "Examples") + (fuel-markup--print (cdr e))) + +(defun fuel-markup--example (e) + (fuel-markup--print (cons '$code (cdr e)))) + +(defun fuel-markup--markup-example (e) + (fuel-markup--print (cons '$code (cdr e)))) + +(defun fuel-markup--link (e) + (let* ((link (cadr e)) + (type (if (symbolp link) 'word 'article)) + (label (or (and (eq type 'article) + (fuel-markup--article-title link)) + link))) + (fuel-markup--insert-button label link type))) + +(defun fuel-markup--links (e) + (dolist (link (cdr e)) + (insert " ") + (fuel-markup--link (list '$link link)) + (insert " "))) + +(defun fuel-markup--vocab-subsection (e) + (insert (format " %S " e))) + +(defun fuel-markup--vocab-link (e) + (fuel-markup--insert-button (cadr e) (cadr e) 'vocab)) + +(defun fuel-markup--vocab-links (e) + (dolist (link (cdr e)) + (insert " ") + (fuel-markup--vocab-link (list '$vocab-link link)) + (insert " "))) + +(defun fuel-markup--vocabulary (e) + (fuel-markup--insert-heading "Vocabulary:" t) + (insert " " (cadr e)) + (newline)) + +(defun fuel-markup--list (e) + (fuel-markup--insert-nl-if-nb) + (dolist (elt (cdr e)) + (insert " - ") + (fuel-markup--print elt) + (fuel-markup--insert-newline))) + +(defun fuel-markup--table (e) + (fuel-markup--insert-newline) + (newline) + (let ((start (point)) + (col-delim "<~end-of-col~>") + (col-no (length (cadr e)))) + (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)) + +(defun fuel-markup--instance (e) + (insert " an instance of ") + (fuel-markup--print (cadr e))) + +(defun fuel-markup--maybe (e) + (fuel-markup--instance (cons '$instance (cdr e))) + (insert " or f ")) + +(defun fuel-markup--values (e) + (fuel-markup--insert-heading "Inputs and outputs") + (dolist (val (cdr e)) + (insert " " (car val) " - ") + (fuel-markup--print (cdr val)) + (newline))) + +(defun fuel-markup--side-effects (e) + (fuel-markup--insert-heading "Side effects") + (insert "Modifies ") + (fuel-markup--print (cdr e)) + (fuel-markup--insert-newline)) + +(defun fuel-markup--definition (e) + (fuel-markup--insert-heading "Definition") + (fuel-markup--code (cons '$code (cdr e)))) + +(defun fuel-markup--methods (e) + (fuel-markup--insert-heading "Methods") + (fuel-markup--code (cons '$code (cdr e)))) + +(defun fuel-markup--value (e) + (fuel-markup--insert-heading "Variable value") + (insert "Current value in global namespace: ") + (fuel-markup--snippet (cons '$snippet (cdr e))) + (newline)) + +(defun fuel-markup--values-x/y (e) + (fuel-markup--values '($values ("x" "number") ("y" "number")))) + +(defun fuel-markup--curious (e) + (fuel-markup--insert-heading "For the curious...") + (fuel-markup--print (cdr e))) + +(defun fuel-markup--references (e) + (fuel-markup--insert-heading "References") + (fuel-markup--links (cons '$links (cdr e)))) + +(defun fuel-markup--see-also (e) + (fuel-markup--insert-heading "See also") + (fuel-markup--links (cons '$links (cdr e)))) + +(defun fuel-markup--shuffle (e) + (insert "\nShuffle word. Re-arranges the stack " + "according to the stack effect pattern.") + (fuel-markup--insert-newline)) + +(defun fuel-markup--low-level-note (e) + (fuel-markup--print '($notes "Calling this word directly is not necessary " + "in most cases. " + "Higher-level words call it automatically."))) + +(defun fuel-markup--parsing-note (e) + (fuel-markup--insert-nl-if-nb) + (insert "This word should only be called from parsing words.") + (fuel-markup--insert-newline)) + +(defun fuel-markup--io-error (e) + (fuel-markup--errors '($errors "Throws an error if the I/O operation fails."))) + +(defun fuel-markup--prettyprinting-note (e) + (fuel-markup--print '($notes ("This word should only be called within the " + ($link with-pprint) " combinator.")))) + +(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--warning (e) + (fuel-markup--elem-with-heading e "Warning")) + +(defun fuel-markup--description (e) + (fuel-markup--elem-with-heading e "Word description")) + +(defun fuel-markup--class-description (e) + (fuel-markup--elem-with-heading e "Class description")) + +(defun fuel-markup--error-description (e) + (fuel-markup--elem-with-heading e "Error description")) + +(defun fuel-markup--var-description (e) + (fuel-markup--elem-with-heading e "Variable description")) + +(defun fuel-markup--contract (e) + (fuel-markup--elem-with-heading e "Generic word contract")) + +(defun fuel-markup--related (e) + (fuel-markup--elem-with-heading e "See also")) + +(defun fuel-markup--errors (e) + (fuel-markup--elem-with-heading e "Errors")) + +(defun fuel-markup--notes (e) + (fuel-markup--elem-with-heading e "Notes")) + +(defun fuel-markup--see (e) + (insert (format " %S " e))) + +(defun fuel-markup--synopsis (e) + (insert (format " %S " e))) + +(defun fuel-markup--quotation (e) + (insert (format " %S " e))) + + +(provide 'fuel-markup) +;;; fuel-markup.el ends here diff --git a/misc/fuel/fuel-xref.el b/misc/fuel/fuel-xref.el index be976a5392..eb57c98ce2 100644 --- a/misc/fuel/fuel-xref.el +++ b/misc/fuel/fuel-xref.el @@ -1,6 +1,6 @@ ;;; fuel-xref.el -- showing cross-reference info -;; Copyright (C) 2008 Jose Antonio Ortega Ruiz +;; Copyright (C) 2008, 2009 Jose Antonio Ortega Ruiz ;; See http://factorcode.org/license.txt for BSD license. ;; Author: Jose Antonio Ortega Ruiz @@ -138,7 +138,6 @@ cursor at the first ocurrence of the used word." (let ((map (make-sparse-keymap))) (suppress-keymap map) (set-keymap-parent map button-buffer-map) - (define-key map "q" 'bury-buffer) map)) (defun fuel-xref-mode ()