Merge branch 'master' of git://factorcode.org/git/factor
John Benediktsson
commit
5549dbf403
|
|
@ -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
|
||||
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
||||
|
|
|
|||
|
|
@ -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 <jao@gnu.org>
|
||||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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 <jao@gnu.org>
|
||||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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 <jao@gnu.org>
|
||||
|
|
@ -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))
|
||||
|
||||
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
@ -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 <jao@gnu.org>
|
||||
|
|
@ -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 ()
|
||||
|
|
|
|||
Loading…
Reference in New Issue