Merge branch 'master' of git://factorcode.org/git/factor

db4
John Benediktsson 2009-01-03 11:53:33 -08:00
commit 5549dbf403
7 changed files with 584 additions and 126 deletions

View File

@ -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. ! See http://factorcode.org/license.txt for BSD license.
USING: accessors arrays assocs classes.tuple combinators USING: accessors arrays assocs classes.tuple combinators
compiler.units continuations debugger definitions io io.pathnames compiler.units continuations debugger definitions help help.crossref
io.streams.string kernel lexer math math.order memoize namespaces help.markup help.topics io io.pathnames io.streams.string kernel lexer
parser prettyprint sequences sets sorting source-files strings summary make math math.order memoize namespaces parser prettyprint sequences
tools.vocabs vectors vocabs vocabs.parser words ; sets sorting source-files strings summary tools.vocabs vectors vocabs
vocabs.parser words ;
IN: fuel IN: fuel
@ -56,6 +57,12 @@ GENERIC: fuel-pprint ( obj -- )
M: object fuel-pprint pprint ; inline 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: f fuel-pprint drop "nil" write ; inline
M: integer fuel-pprint pprint ; inline M: integer fuel-pprint pprint ; inline
@ -144,8 +151,8 @@ SYMBOL: :uses
: fuel-run-file ( path -- ) : fuel-run-file ( path -- )
[ fuel-set-use-hook run-file ] curry with-scope ; inline [ fuel-set-use-hook run-file ] curry with-scope ; inline
: fuel-with-autouse ( quot -- ) : fuel-with-autouse ( quot -- )
[ auto-use? on fuel-set-use-hook call ] curry with-scope ; [ auto-use? on fuel-set-use-hook call ] curry with-scope ; inline
: (fuel-get-uses) ( lines -- ) : (fuel-get-uses) ( lines -- )
[ parse-fresh drop ] curry with-compilation-unit ; inline [ 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 ( prefix names -- )
(fuel-get-words) fuel-eval-set-result ; inline (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 ! -run=fuel support

View File

@ -94,10 +94,12 @@ C-cC-eC-r is the same as C-cC-er)).
* In the Help browser: * In the Help browser:
- RET : help for word at point - h : help for word at point
- f/b : next/previous page - f/b : next/previous page
- SPC/S-SPC : scroll up/down - 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 - C-cz : switch to listener
- q : bury buffer - q : bury buffer

View File

@ -1,6 +1,6 @@
;;; fuel-autodoc.el -- doc snippets in the echo area ;;; 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. ;; See http://factorcode.org/license.txt for BSD license.
;; Author: Jose Antonio Ortega Ruiz <jao@gnu.org> ;; Author: Jose Antonio Ortega Ruiz <jao@gnu.org>
@ -32,23 +32,6 @@
:type 'boolean) :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: ;;; Eldoc function:
@ -65,7 +48,7 @@
(res (fuel-eval--retort-result ret))) (res (fuel-eval--retort-result ret)))
(when (and ret (not (fuel-eval--retort-error ret)) (stringp res)) (when (and ret (not (fuel-eval--retort-error ret)) (stringp res))
(if fuel-autodoc-minibuffer-font-lock (if fuel-autodoc-minibuffer-font-lock
(fuel-autodoc--font-lock-str res) (fuel-font-lock--factor-str res)
res)))))) res))))))
(make-variable-buffer-local (make-variable-buffer-local

View File

@ -1,6 +1,6 @@
;;; fuel-font-lock.el -- font lock for factor code ;;; 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. ;; See http://factorcode.org/license.txt for BSD license.
;; Author: Jose Antonio Ortega Ruiz <jao@gnu.org> ;; Author: Jose Antonio Ortega Ruiz <jao@gnu.org>
@ -99,5 +99,24 @@
fuel-syntax--syntactic-keywords)))))) 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) (provide 'fuel-font-lock)
;;; fuel-font-lock.el ends here ;;; fuel-font-lock.el ends here

View File

@ -1,6 +1,6 @@
;;; fuel-help.el -- accessing Factor's help system ;;; 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. ;; See http://factorcode.org/license.txt for BSD license.
;; Author: Jose Antonio Ortega Ruiz <jao@gnu.org> ;; Author: Jose Antonio Ortega Ruiz <jao@gnu.org>
@ -15,12 +15,15 @@
;;; Code: ;;; Code:
(require 'fuel-eval) (require 'fuel-eval)
(require 'fuel-markup)
(require 'fuel-autodoc) (require 'fuel-autodoc)
(require 'fuel-completion) (require 'fuel-completion)
(require 'fuel-font-lock) (require 'fuel-font-lock)
(require 'fuel-popup) (require 'fuel-popup)
(require 'fuel-base) (require 'fuel-base)
(require 'button)
;;; Customization: ;;; Customization:
@ -33,32 +36,21 @@
:type 'boolean :type 'boolean
:group 'fuel-help) :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 (defcustom fuel-help-history-cache-size 50
"Maximum number of pages to keep in the help browser cache." "Maximum number of pages to keep in the help browser cache."
:type 'integer :type 'integer
:group 'fuel-help) :group 'fuel-help)
(fuel-font-lock--defface fuel-font-lock-help-headlines
'bold fuel-hep "headlines in help buffers")
;;; Help browser history: ;;; Help browser history:
(defvar fuel-help--history (defun fuel-help--make-history ()
(list nil ; current (list nil ; current
(make-ring fuel-help-history-cache-size) ; previous (make-ring fuel-help-history-cache-size) ; previous
(make-ring fuel-help-history-cache-size))) ; next (make-ring fuel-help-history-cache-size))) ; next
(defvar fuel-help--history (fuel-help--make-history))
(defun fuel-help--history-push (term) (defun fuel-help--history-push (term)
(when (and (car fuel-help--history) (when (and (car fuel-help--history)
(not (string= (caar fuel-help--history) (car term)))) (not (string= (caar fuel-help--history) (car term))))
@ -86,94 +78,75 @@
(defvar fuel-help--prompt-history nil) (defvar fuel-help--prompt-history nil)
(defun fuel-help--show-help (&optional see word) (defun fuel-help--read-word (see)
(let* ((def (or word (fuel-syntax-symbol-at-point))) (let* ((def (fuel-syntax-symbol-at-point))
(prompt (format "See%s help on%s: " (if see " short" "") (prompt (format "See%s help on%s: " (if see " short" "")
(if def (format " (%s)" def) ""))) (if def (format " (%s)" def) "")))
(ask (or (not (memq major-mode '(factor-mode fuel-help-mode))) (ask (or (not (memq major-mode '(factor-mode fuel-help-mode)))
(not def) (not def)
fuel-help-always-ask)) fuel-help-always-ask)))
(def (if ask (fuel-completion--read-word prompt (if ask (fuel-completion--read-word prompt
def def
'fuel-help--prompt-history 'fuel-help--prompt-history
t) t)
def)) 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)))))
(defun fuel-help--show-help-cont (def ret) (defun fuel-help--word-help (&optional see word)
(let ((out (fuel-eval--retort-output ret))) (let ((def (or word (fuel-help--read-word see))))
(if (or (fuel-eval--retort-error ret) (empty-string-p out)) (when def
(message "No help for '%s'" def) (let ((cmd `(:fuel* (,def ,(if see 'fuel-word-see 'fuel-word-help))
(fuel-help--insert-contents def out)))) "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)) (let ((hb (fuel-help--buffer))
(inhibit-read-only t) (inhibit-read-only t)
(font-lock-verbose nil)) (font-lock-verbose nil))
(set-buffer hb) (set-buffer hb)
(erase-buffer) (erase-buffer)
(insert str) (if (stringp art)
(insert art)
(fuel-markup--print art)
(fuel-markup--insert-newline))
(unless nopush (unless nopush
(goto-char (point-min)) (fuel-help--history-push (cons def (buffer-string))))
(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)))))
(set-buffer-modified-p nil) (set-buffer-modified-p nil)
(fuel-popup--display) (fuel-popup--display)
(goto-char (point-min)) (goto-char (point-min))
(message "%s" def))) (message "")))
;;; 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)))
;;; Interactive help commands: ;;; Interactive help commands:
(defun fuel-help-short (&optional arg) (defun fuel-help-short ()
"See a help summary of symbol at point. "See help summary of symbol at point."
By default, the information is shown in the minibuffer. When (interactive)
called with a prefix argument, the information is displayed in a (fuel-help--word-help t))
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 () (defun fuel-help ()
"Show extended help about the symbol at point, using a help "Show extended help about the symbol at point, using a help
buffer." buffer."
(interactive) (interactive)
(fuel-help--show-help)) (fuel-help--word-help))
(defun fuel-help-next () (defun fuel-help-next ()
"Go to next page in help browser." "Go to next page in help browser."
@ -193,15 +166,12 @@ buffer."
(error "No previous page")) (error "No previous page"))
(fuel-help--insert-contents (car item) (cdr item) t))) (fuel-help--insert-contents (car item) (cdr item) t)))
(defun fuel-help-next-headline (&optional count) (defun fuel-help-clean-history ()
(interactive "P") "Clean up the help browser cache of visited pages."
(end-of-line) (interactive)
(when (re-search-forward fuel-help--headlines-regexp nil t (or count 1)) (when (y-or-n-p "Clean browsing history? ")
(beginning-of-line))) (setq fuel-help--history (fuel-help--make-history)))
(message ""))
(defun fuel-help-previous-headline (&optional count)
(interactive "P")
(re-search-backward fuel-help--headlines-regexp nil t count))
;;;; Help mode map: ;;;; Help mode map:
@ -209,15 +179,14 @@ buffer."
(defvar fuel-help-mode-map (defvar fuel-help-mode-map
(let ((map (make-sparse-keymap))) (let ((map (make-sparse-keymap)))
(suppress-keymap map) (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 "b" 'fuel-help-previous)
(define-key map "c" 'fuel-help-clean-history)
(define-key map "f" 'fuel-help-next) (define-key map "f" 'fuel-help-next)
(define-key map "h" 'fuel-help)
(define-key map "l" 'fuel-help-previous) (define-key map "l" 'fuel-help-previous)
(define-key map "p" 'fuel-help-previous) (define-key map "p" 'fuel-help-previous)
(define-key map "n" 'fuel-help-next) (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 "SPC") 'scroll-up)
(define-key map (kbd "S-SPC") 'scroll-down) (define-key map (kbd "S-SPC") 'scroll-down)
(define-key map "\M-." 'fuel-edit-word-at-point) (define-key map "\M-." 'fuel-edit-word-at-point)
@ -235,16 +204,15 @@ buffer."
(kill-all-local-variables) (kill-all-local-variables)
(buffer-disable-undo) (buffer-disable-undo)
(use-local-map fuel-help-mode-map) (use-local-map fuel-help-mode-map)
(set-syntax-table fuel-syntax--syntax-table)
(setq mode-name "FUEL Help") (setq mode-name "FUEL Help")
(setq major-mode 'fuel-help-mode) (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 "") (setq fuel-autodoc-mode-string "")
(fuel-autodoc-mode) (fuel-autodoc-mode)
(run-mode-hooks 'fuel-help-mode-hook)
(setq buffer-read-only t)) (setq buffer-read-only t))

417
misc/fuel/fuel-markup.el Normal file
View File

@ -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 <jao@gnu.org>
;; 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

View File

@ -1,6 +1,6 @@
;;; fuel-xref.el -- showing cross-reference info ;;; 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. ;; See http://factorcode.org/license.txt for BSD license.
;; Author: Jose Antonio Ortega Ruiz <jao@gnu.org> ;; Author: Jose Antonio Ortega Ruiz <jao@gnu.org>
@ -138,7 +138,6 @@ cursor at the first ocurrence of the used word."
(let ((map (make-sparse-keymap))) (let ((map (make-sparse-keymap)))
(suppress-keymap map) (suppress-keymap map)
(set-keymap-parent map button-buffer-map) (set-keymap-parent map button-buffer-map)
(define-key map "q" 'bury-buffer)
map)) map))
(defun fuel-xref-mode () (defun fuel-xref-mode ()