Merge branch 'master' into new_ui

db4
Slava Pestov 2009-01-05 07:58:52 -06:00
commit cb3102f9d1
15 changed files with 1016 additions and 319 deletions

View File

@ -1,10 +1,13 @@
! Copyright (C) 2008 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
USING: binary-search math.primes.list math.ranges sequences
USING: binary-search kernel math.primes.list math.ranges sequences
prettyprint ;
IN: benchmark.binary-search
: binary-search-benchmark ( -- )
1 1000000 [a,b] [ primes-under-million sorted-member? ] map length . ;
! Force computation of the primes list before benchmarking the binary search
primes-under-million drop
MAIN: binary-search-benchmark

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.
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.crossref tools.vocabs
vectors vocabs vocabs.parser words ;
IN: fuel
@ -17,13 +18,13 @@ SYMBOL: fuel-status-stack
V{ } clone fuel-status-stack set-global
SYMBOL: fuel-eval-result
f clone fuel-eval-result set-global
f fuel-eval-result set-global
SYMBOL: fuel-eval-output
f clone fuel-eval-result set-global
f fuel-eval-result set-global
SYMBOL: fuel-eval-res-flag
t clone fuel-eval-res-flag set-global
t fuel-eval-res-flag set-global
: fuel-eval-restartable? ( -- ? )
fuel-eval-res-flag get-global ; inline
@ -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
@ -99,20 +106,17 @@ M: source-file fuel-pprint path>> fuel-pprint ;
clone fuel-eval-result set-global ; inline
: fuel-retort ( -- )
error get
fuel-eval-result get-global
fuel-eval-output get-global
error get fuel-eval-result get-global fuel-eval-output get-global
3array fuel-pprint flush nl "<~FUEL~>" write nl flush ;
: fuel-forget-error ( -- ) f error set-global ; inline
: fuel-forget-result ( -- ) f fuel-eval-result set-global ; inline
: fuel-forget-output ( -- ) f fuel-eval-output set-global ; inline
: fuel-forget-status ( -- )
fuel-forget-error fuel-forget-result fuel-forget-output ; inline
: (fuel-begin-eval) ( -- )
fuel-push-status
fuel-forget-error
fuel-forget-result
fuel-forget-output ;
fuel-push-status fuel-forget-status ; inline
: (fuel-end-eval) ( output -- )
fuel-eval-output set-global fuel-retort fuel-pop-status ; inline
@ -138,14 +142,17 @@ M: source-file fuel-pprint path>> fuel-pprint ;
! Loading files
: fuel-run-file ( path -- ) run-file ; inline
SYMBOL: :uses
: fuel-with-autouse ( quot -- )
[
auto-use? on
[ amended-use get clone fuel-eval-set-result ] print-use-hook set
call
] curry with-scope ;
: fuel-set-use-hook ( -- )
[ amended-use get clone :uses prefix fuel-eval-set-result ]
print-use-hook set ;
: 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 ; inline
: (fuel-get-uses) ( lines -- )
[ parse-fresh drop ] curry with-compilation-unit ; inline
@ -177,13 +184,16 @@ M: source-file fuel-pprint path>> fuel-pprint ;
[ [ first ] dip first <=> ] sort ; inline
: fuel-format-xrefs ( seq -- seq' )
[ word? ] filter [ fuel-word>xref ] map fuel-sort-xrefs ;
[ word? ] filter [ fuel-word>xref ] map ; inline
: fuel-callers-xref ( word -- )
usage fuel-format-xrefs fuel-eval-set-result ; inline
usage fuel-format-xrefs fuel-sort-xrefs fuel-eval-set-result ; inline
: fuel-callees-xref ( word -- )
uses fuel-format-xrefs fuel-eval-set-result ; inline
uses fuel-format-xrefs fuel-sort-xrefs fuel-eval-set-result ; inline
: fuel-apropos-xref ( str -- )
words-matching fuel-format-xrefs fuel-eval-set-result ; inline
! Completion support
@ -218,6 +228,86 @@ 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
: (fuel-vocab-help) ( name -- element )
\ article swap dup >vocab-link
[
[ summary [ , ] [ "No summary available" , ] if* ]
[ drop \ $nl , ]
[ vocab-help article [ content>> % ] when* ] tri
] { } make 3array ;
: fuel-vocab-help ( name -- )
(fuel-vocab-help) fuel-eval-set-result ; inline
: (fuel-index) ( seq -- seq )
[ [ >link name>> ] [ article-title ] bi 2array \ $subsection prefix ] map ;
: fuel-index ( quot: ( -- seq ) -- )
call (fuel-index) fuel-eval-set-result ; inline
! -run=fuel support

View File

@ -1,4 +1,4 @@
USING: math.primes ;
USING: math.primes memoize ;
IN: math.primes.list
: primes-under-million ( -- seq ) 1000000 primes-upto ;
MEMO: primes-under-million ( -- seq ) 1000000 primes-upto ;

View File

@ -1,15 +1,15 @@
FUEL, Factor's Ultimate Emacs Library
FUEL, Factor's Ultimate Emacs Library -*- org -*-
-------------------------------------
FUEL provides a complete environment for your Factor coding pleasure
inside Emacs, including source code edition and interaction with a
Factor listener instance running within Emacs.
FUEL was started by Jose A Ortega as an extension to Ed Cavazos'
original factor.el code.
FUEL was started by Jose A Ortega as an extension to Eduardo Cavazos'
original factor.el code. Eduardo is also responsible of naming the
beast.
Installation
------------
* Installation
FUEL comes bundled with Factor's distribution. The folder misc/fuel
contains Elisp code, and there's a fuel vocabulary in extras/fuel.
@ -31,8 +31,7 @@ inside Emacs, you can use instead:
(setq factor-mode-use-fuel nil)
(require 'factor-mode)
Basic usage
-----------
* Basic usage
If you're using the default factor binary and images locations inside
the Factor's source tree, that should be enough to start using FUEL.
@ -44,13 +43,12 @@ To start the listener, try M-x run-factor.
Many aspects of the environment can be customized:
M-x customize-group fuel will show you how many.
Quick key reference
-------------------
* Quick key reference
(Triple chords ending in a single letter <x> accept also C-<x> (e.g.
C-cC-eC-r is the same as C-cC-er)).
* In factor source files:
*** In factor source files:
- C-cz : switch to listener
- C-co : cycle between code, tests and docs factor files
@ -71,37 +69,46 @@ C-cC-eC-r is the same as C-cC-er)).
- C-cC-dd : help for word at point
- C-cC-ds : short help word at point
- C-cC-de : show stack effect of current sexp (with prefix, region)
- C-cC-dp : find words containing given substring (M-x fuel-apropos)
- C-cM-<, C-cC-d< : show callers of word at point
- C-cM->, C-cC-d> : show callees of word at point
* In the listener:
*** In the listener:
- TAB : complete word at point
- M-. : edit word at point in Emacs
- C-ca : toggle autodoc mode
- C-cp : find words containing given substring (M-x fuel-apropos)
- C-cs : toggle stack mode
- C-cv : edit vocabulary
- C-ch : help for word at point
- C-ck : run file
* In the debugger (it pops up upon eval/compilation errors):
*** In the debugger (it pops up upon eval/compilation errors):
- g : go to error
- <digit> : invoke nth restart
- w/e/l : invoke :warnings, :errors, :linkage
- q : bury buffer
* In the Help browser:
*** In the help browser:
- RET : help for word at point
- f/b : next/previous page
- h : help for word at point
- a : find words containing given substring (M-x fuel-apropos)
- ba : bookmark current page
- bb : display bookmarks
- bd : delete bookmark at point
- n/p : next/previous page
- SPC/S-SPC : scroll up/down
- TAB/S-TAB : next/previous headline
- TAB/S-TAB : next/previous link
- r : refresh page
- c : clean browsing history
- M-. : edit word at point in Emacs
- C-cz : switch to listener
- q : bury buffer
* In crossref buffers
*** In crossref buffers
- TAB/BACKTAB : navigate links
- RET/mouse click : follow link

View File

@ -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>
@ -15,6 +15,7 @@
;;; Code:
(require 'fuel-eval)
(require 'fuel-font-lock)
(require 'fuel-syntax)
(require 'fuel-base)
@ -30,34 +31,24 @@
:group 'fuel-autodoc
:type 'boolean)
;;; Autodoc mode:
;;; Eldoc function:
(defvar fuel-autodoc--font-lock-buffer
(let ((buffer (get-buffer-create " *fuel help minibuffer messages*")))
(set-buffer buffer)
(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))
(defvar fuel-autodoc--timeout 200)
(defun fuel-autodoc--word-synopsis (&optional word)
(let ((word (or word (fuel-syntax-symbol-at-point)))
(fuel-log--inhibit-p t))
(when word
(let* ((cmd (if (fuel-syntax--in-using)
`(:fuel* (,word fuel-vocab-summary) t t)
`(:fuel* (((:quote ,word) synopsis :get)) t)))
(ret (fuel-eval--send/wait cmd 20))
`(:fuel* (,word fuel-vocab-summary) :in t)
`(:fuel* (((:quote ,word) synopsis :get)) :in)))
(ret (fuel-eval--send/wait cmd fuel-autodoc--timeout))
(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
@ -68,6 +59,9 @@
(funcall fuel-autodoc--fallback-function))
(fuel-autodoc--word-synopsis)))
;;; Autodoc mode:
(make-variable-buffer-local
(defvar fuel-autodoc-mode-string " A"
"Modeline indicator for fuel-autodoc-mode"))

View File

@ -23,12 +23,6 @@
;;; Customization:
(fuel-font-lock--defface fuel-font-lock-debug-missing-vocab
'font-lock-warning-face fuel-debug "missing vocabulary names")
(fuel-font-lock--defface fuel-font-lock-debug-unneeded-vocab
'font-lock-warning-face fuel-debug "unneeded vocabulary names")
(fuel-font-lock--defface fuel-font-lock-debug-uses-header
'bold fuel-debug "headers in Uses buffers")
@ -53,26 +47,6 @@
(forward-line))
(reverse lines))))))
(defun fuel-debug--highlight-names (names ref face)
(dolist (n names)
(when (not (member n ref))
(put-text-property 0 (length n) 'font-lock-face face n))))
(defun fuel-debug--uses-new-uses (file uses)
(pop-to-buffer (find-file-noselect file))
(goto-char (point-min))
(if (re-search-forward "^USING: " nil t)
(let ((begin (point))
(end (or (and (re-search-forward "\\_<;\\_>") (point)) (point))))
(kill-region begin end))
(re-search-forward "^IN: " nil t)
(beginning-of-line)
(open-line 2)
(insert "USING: "))
(let ((start (point)))
(insert (mapconcat 'substring-no-properties uses " ") " ;")
(fill-region start (point) nil)))
(defun fuel-debug--uses-filter (restarts)
(let ((result) (i 1) (rn 0))
(dolist (r restarts (reverse result))
@ -87,9 +61,6 @@
(fuel-popup--define fuel-debug--uses-buffer
"*fuel uses*" 'fuel-debug-uses-mode)
(make-variable-buffer-local
(defvar fuel-debug--uses nil))
(make-variable-buffer-local
(defvar fuel-debug--uses-file nil))
@ -122,27 +93,15 @@
(fuel-popup--display (fuel-debug--uses-buffer))))
(defun fuel-debug--uses-cont (retort)
(let ((uses (fuel-eval--retort-result retort))
(let ((uses (fuel-debug--uses retort))
(err (fuel-eval--retort-error retort)))
(if uses (fuel-debug--uses-display uses)
(fuel-debug--uses-display-err retort))))
(defun fuel-debug--insert-vlist (title vlist)
(goto-char (point-max))
(insert title "\n\n ")
(let ((i 0) (step 5))
(dolist (v vlist)
(setq i (1+ i))
(insert v)
(insert (if (zerop (mod i step)) "\n " " ")))
(unless (zerop (mod i step)) (newline))
(newline)))
(defun fuel-debug--uses-display (uses)
(let* ((inhibit-read-only t)
(old (with-current-buffer (find-file-noselect fuel-debug--uses-file)
(fuel-syntax--usings)))
(old (sort old 'string<))
(sort (fuel-syntax--find-usings t) 'string<)))
(new (sort uses 'string<)))
(erase-buffer)
(fuel-debug--uses-insert-title)
@ -177,14 +136,15 @@
(defun fuel-debug--uses-update-usings ()
(interactive)
(let ((inhibit-read-only t))
(when (and fuel-debug--uses-file fuel-debug--uses)
(fuel-debug--uses-new-uses fuel-debug--uses-file fuel-debug--uses)
(message "USING: updated!")
(with-current-buffer (fuel-debug--uses-buffer)
(let ((inhibit-read-only t)
(file fuel-debug--uses-file)
(uses fuel-debug--uses))
(when (and uses file)
(insert "\nDone!")
(fuel-debug--uses-clean)
(bury-buffer)))))
(fuel-popup--quit)
(fuel-debug--replace-usings file uses)
(message "USING: updated!"))))
(defun fuel-debug--uses-restart (n)
(when (and (> n 0) (<= n (length fuel-debug--uses-restarts)))

View File

@ -31,6 +31,12 @@
:group 'fuel-debug
:type 'hook)
(defcustom fuel-debug-confirm-restarts-p t
"Whether to ask for confimation before executing a restart in
the debugger."
:group 'fuel-debug
:type 'boolean)
(defcustom fuel-debug-show-short-help t
"Whether to show short help on available keys in debugger."
:group 'fuel-debug
@ -43,7 +49,9 @@
(column variable-name "column numbers in errors/warnings")
(info comment "information headers")
(restart-number warning "restart numbers")
(restart-name function-name "restart names")))
(restart-name function-name "restart names")
(missing-vocab warning"missing vocabulary names")
(unneeded-vocab warning "unneeded vocabulary names")))
;;; Font lock and other pattern matching:
@ -92,6 +100,9 @@
(make-variable-buffer-local
(defvar fuel-debug--file nil))
(make-variable-buffer-local
(defvar fuel-debug--uses nil))
(defun fuel-debug--prepare-compilation (file msg)
(let ((inhibit-read-only t))
(with-current-buffer (fuel-debug--buffer)
@ -114,6 +125,7 @@
(fuel-debug--display-restarts err)
(delete-blank-lines)
(newline))
(fuel-debug--display-uses ret)
(let ((hstr (fuel-debug--help-string err fuel-debug--file)))
(if fuel-debug-show-short-help
(insert "-----------\n" hstr "\n")
@ -124,6 +136,46 @@
(when (and err (not no-pop)) (fuel-popup--display))
(not err))))
(defun fuel-debug--uses (ret)
(let ((uses (fuel-eval--retort-result ret)))
(and (eq :uses (car uses))
(cdr uses))))
(defun fuel-debug--insert-vlist (title vlist)
(goto-char (point-max))
(insert title "\n\n ")
(let ((i 0) (step 5))
(dolist (v vlist)
(setq i (1+ i))
(insert v)
(insert (if (zerop (mod i step)) "\n " " ")))
(unless (zerop (mod i step)) (newline))
(newline)))
(defun fuel-debug--highlight-names (names ref face)
(dolist (n names)
(when (not (member n ref))
(put-text-property 0 (length n) 'font-lock-face face n))))
(defun fuel-debug--insert-uses (uses)
(let* ((file (or file fuel-debug--file))
(old (with-current-buffer (find-file-noselect file)
(sort (fuel-syntax--find-usings t) 'string<)))
(new (sort uses 'string<)))
(when (not (equalp old new))
(fuel-debug--highlight-names old new 'fuel-font-lock-debug-unneeded-vocab)
(newline)
(fuel-debug--insert-vlist "Correct vocabulary list:" new)
new)))
(defun fuel-debug--display-uses (ret)
(when (setq fuel-debug--uses (fuel-debug--uses ret))
(newline)
(fuel-debug--highlight-names fuel-debug--uses
nil 'fuel-font-lock-debug-missing-vocab)
(fuel-debug--insert-vlist "Missing vocabularies:" fuel-debug--uses)
(newline)))
(defun fuel-debug--display-output (ret)
(let* ((last (fuel-eval--retort-output fuel-debug--last-ret))
(current (fuel-eval--retort-output ret))
@ -149,7 +201,7 @@
(newline))))
(defun fuel-debug--help-string (err &optional file)
(format "Press %s%s%sq bury buffer"
(format "Press %s%s%s%sq bury buffer"
(if (or file (fuel-eval--error-file err)) "g go to file, " "")
(let ((rsn (length (fuel-eval--error-restarts err))))
(cond ((zerop rsn) "")
@ -160,7 +212,8 @@
(save-excursion
(goto-char (point-min))
(when (search-forward (car ci) nil t)
(setq str (format "%c %s, %s" (cdr ci) (car ci) str))))))))
(setq str (format "%c %s, %s" (cdr ci) (car ci) str))))))
(if (and (not err) fuel-debug--uses) "u to update USING:, " "")))
(defun fuel-debug--buffer-file ()
(with-current-buffer (fuel-debug--buffer)
@ -229,6 +282,31 @@
(fuel-eval--send/wait `(:fuel ((:factor ,info)))) "")
(error "Sorry, no %s info available" info))))
(defun fuel-debug--replace-usings (file uses)
(pop-to-buffer (find-file-noselect file))
(goto-char (point-min))
(if (re-search-forward "^USING: " nil t)
(let ((begin (point))
(end (or (and (re-search-forward "\\_<;\\_>") (point)) (point))))
(kill-region begin end))
(re-search-forward "^IN: " nil t)
(beginning-of-line)
(open-line 2)
(insert "USING: "))
(let ((start (point)))
(insert (mapconcat 'substring-no-properties uses " ") " ;")
(fill-region start (point) nil)))
(defun fuel-debug-update-usings ()
(interactive)
(when (and fuel-debug--file fuel-debug--uses)
(let* ((file fuel-debug--file)
(old (with-current-buffer (find-file-noselect file)
(fuel-syntax--find-usings t)))
(uses (sort (append fuel-debug--uses old) 'string<)))
(fuel-popup--quit)
(fuel-debug--replace-usings file uses))))
;;; Fuel Debug mode:
@ -239,9 +317,11 @@
(define-key map "\C-c\C-c" 'fuel-debug-goto-error)
(define-key map "n" 'next-line)
(define-key map "p" 'previous-line)
(define-key map "u" 'fuel-debug-update-usings)
(dotimes (n 9)
(define-key map (vector (+ ?1 n))
`(lambda () (interactive) (fuel-debug-exec-restart ,(1+ n) t))))
`(lambda () (interactive)
(fuel-debug-exec-restart ,(1+ n) fuel-debug-confirm-restarts-p))))
(dolist (ci fuel-debug--compiler-info-alist)
(define-key map (vector (cdr ci))
`(lambda () (interactive) (fuel-debug-show--compiler-info ,(car ci)))))

View File

@ -67,7 +67,7 @@
(cons :array (mapcar 'factor lst)))
(defsubst factor--fuel-in (in)
(cond ((null in) :in)
(cond ((or (eq in :in) (null in)) :in)
((eq in 'f) 'f)
((eq in 't) "fuel-scratchpad")
((stringp in) in)

View File

@ -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

View File

@ -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,16 @@
;;; Code:
(require 'fuel-eval)
(require 'fuel-markup)
(require 'fuel-autodoc)
(require 'fuel-xref)
(require 'fuel-completion)
(require 'fuel-font-lock)
(require 'fuel-popup)
(require 'fuel-base)
(require 'button)
;;; Customization:
@ -33,37 +37,35 @@
: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")
(defcustom fuel-help-bookmarks nil
"Bookmars. Maintain this list using the help browser."
:type 'list
:group 'fuel-help)
;;; 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
(defun fuel-help--history-push (term)
(when (and (car fuel-help--history)
(not (string= (caar fuel-help--history) (car term))))
(ring-insert (nth 1 fuel-help--history) (car fuel-help--history)))
(setcar fuel-help--history term))
(defsubst fuel-help--history-current ()
(car fuel-help--history))
(defun fuel-help--history-push (link)
(unless (equal link (car fuel-help--history))
(let ((next (fuel-help--history-next)))
(unless (equal link next)
(when next (fuel-help--history-previous))
(ring-insert (nth 1 fuel-help--history) (car fuel-help--history))
(setcar fuel-help--history link))))
link)
(defun fuel-help--history-next ()
(when (not (ring-empty-p (nth 2 fuel-help--history)))
@ -77,6 +79,25 @@
(ring-insert (nth 2 fuel-help--history) (car fuel-help--history)))
(setcar fuel-help--history (ring-remove (nth 1 fuel-help--history) 0))))
(defvar fuel-help--history (fuel-help--make-history))
;;; Page cache:
(defun fuel-help--history-current-content ()
(fuel-help--cache-get (car fuel-help--history)))
(defvar fuel-help--cache (make-hash-table :weakness 'key :test 'equal))
(defsubst fuel-help--cache-get (name)
(gethash name fuel-help--cache))
(defsubst fuel-help--cache-insert (name str)
(puthash name str fuel-help--cache))
(defsubst fuel-help--cache-clear ()
(clrhash fuel-help--cache))
;;; Fuel help buffer and internals:
@ -86,121 +107,158 @@
(defvar fuel-help--prompt-history nil)
(defun fuel-help--show-help (&optional see word)
(let* ((def (or word (fuel-syntax-symbol-at-point)))
(make-local-variable
(defvar fuel-help--buffer-link nil))
(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
fuel-help-always-ask)))
(if ask (fuel-completion--read-word prompt
def
'fuel-help--prompt-history
t)
def))
(cmd `(:fuel* ((:quote ,def) ,(if see 'see 'help)) t)))
def)))
(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)
(fuel-eval--send cmd `(lambda (r) (fuel-help--show-help-cont ,def r)))))
(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))
(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 out))))
(fuel-help--insert-contents (list def def 'word) res)))))))
(defun fuel-help--insert-contents (def str &optional nopush)
(defun fuel-help--get-article (name label)
(message "Retrieving article ...")
(let* ((cmd `(:fuel* ((,name fuel-get-article)) "fuel" t))
(ret (fuel-eval--send/wait cmd 2000))
(res (fuel-eval--retort-result ret)))
(if (not res)
(message "Article '%s' not found" label)
(fuel-help--insert-contents (list name label 'article) res)
(message ""))))
(defun fuel-help--get-vocab (name)
(message "Retrieving vocabulary help ...")
(let* ((cmd `(:fuel* ((,name fuel-vocab-help)) "fuel" (,name)))
(ret (fuel-eval--send/wait cmd 2000))
(res (fuel-eval--retort-result ret)))
(if (not res)
(message "No help available for vocabulary '%s'" name)
(fuel-help--insert-contents (list name name 'vocab) res)
(message ""))))
(defun fuel-help--follow-link (link label type &optional no-cache)
(let* ((llink (list link label type))
(cached (and (not no-cache) (fuel-help--cache-get llink))))
(if (not cached)
(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))
((eq type 'vocab) (fuel-help--get-vocab link))
((eq type 'bookmarks) (fuel-help-display-bookmarks))
(t (error "Links of type %s not yet implemented" type))))
(fuel-help--insert-contents llink cached))))
(defun fuel-help--insert-contents (key content)
(let ((hb (fuel-help--buffer))
(inhibit-read-only t)
(font-lock-verbose nil))
(set-buffer hb)
(erase-buffer)
(insert str)
(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)))))
(if (stringp content)
(insert content)
(fuel-markup--print content)
(fuel-markup--insert-newline)
(fuel-help--cache-insert key (buffer-string)))
(fuel-help--history-push key)
(setq fuel-help--buffer-link key)
(set-buffer-modified-p nil)
(fuel-popup--display)
(goto-char (point-min))
(message "%s" def)))
(message "")))
;;; Help mode font lock:
;;; Bookmarks:
(defconst fuel-help--headlines
(regexp-opt '("Class description"
"Definition"
"Errors"
"Examples"
"Generic word contract"
"Inputs and outputs"
"Methods"
"Notes"
"Parent topics:"
"See also"
"Syntax"
"Variable description"
"Variable value"
"Vocabulary"
"Warning"
"Word description")
t))
(defun fuel-help-bookmark-page ()
"Add current help page to bookmarks."
(interactive)
(let ((link fuel-help--buffer-link))
(unless link (error "No link associated to this page"))
(add-to-list 'fuel-help-bookmarks link)
(customize-save-variable 'fuel-help-bookmarks fuel-help-bookmarks)
(message "Bookmark '%s' saved" (cadr link))))
(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)))
(defun fuel-help-delete-bookmark ()
"Delete link at point from bookmarks."
(interactive)
(let ((link (fuel-markup--link-at-point)))
(unless link (error "No link at point"))
(unless (member link fuel-help-bookmarks)
(error "'%s' is not bookmarked" (cadr link)))
(customize-save-variable 'fuel-help-bookmarks
(remove link fuel-help-bookmarks))
(message "Bookmark '%s' delete" (cadr link))
(fuel-help-display-bookmarks)))
(defun fuel-help-display-bookmarks ()
"Display bookmarked pages."
(interactive)
(let ((links (mapcar (lambda (l) (cons '$subsection l)) fuel-help-bookmarks)))
(unless links (error "No links to display"))
(fuel-help--insert-contents '("bookmarks" "Bookmars" bookmarks)
`(article "Bookmarks" ,links))))
;;; 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."
(interactive)
(let ((item (fuel-help--history-next))
(fuel-help-always-ask nil))
(unless item
(error "No next page"))
(fuel-help--insert-contents (car item) (cdr item) t)))
(let ((item (fuel-help--history-next)))
(unless item (error "No next page"))
(apply 'fuel-help--follow-link item)))
(defun fuel-help-previous ()
"Go to next page in help browser."
"Go to previous page in help browser."
(interactive)
(let ((item (fuel-help--history-previous))
(fuel-help-always-ask nil))
(unless item
(error "No previous page"))
(fuel-help--insert-contents (car item) (cdr item) t)))
(let ((item (fuel-help--history-previous)))
(unless item (error "No previous page"))
(apply 'fuel-help--follow-link item)))
(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-refresh ()
"Refresh the contents of current page."
(interactive)
(when fuel-help--buffer-link
(apply 'fuel-help--follow-link (append fuel-help--buffer-link '(t)))))
(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? ")
(fuel-help--cache-clear)
(setq fuel-help--history (fuel-help--make-history))
(fuel-help-refresh))
(message ""))
;;;; Help mode map:
@ -208,15 +266,16 @@ buffer."
(defvar fuel-help-mode-map
(let ((map (make-sparse-keymap)))
(suppress-keymap map)
(define-key map "\C-m" 'fuel-help)
(define-key map "b" 'fuel-help-previous)
(define-key map "f" 'fuel-help-next)
(define-key map "l" 'fuel-help-previous)
(define-key map "p" 'fuel-help-previous)
(set-keymap-parent map button-buffer-map)
(define-key map "a" 'fuel-apropos)
(define-key map "ba" 'fuel-help-bookmark-page)
(define-key map "bb" 'fuel-help-display-bookmarks)
(define-key map "bd" 'fuel-help-delete-bookmark)
(define-key map "c" 'fuel-help-clean-history)
(define-key map "h" 'fuel-help)
(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 "p" 'fuel-help-previous)
(define-key map "r" 'fuel-help-refresh)
(define-key map (kbd "SPC") 'scroll-up)
(define-key map (kbd "S-SPC") 'scroll-down)
(define-key map "\M-." 'fuel-edit-word-at-point)
@ -234,16 +293,10 @@ 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-autodoc-mode-string "")
(fuel-autodoc-mode)
(run-mode-hooks 'fuel-help-mode-hook)
(setq fuel-markup--follow-link-function 'fuel-help--follow-link)
(setq buffer-read-only t))

View File

@ -1,6 +1,6 @@
;;; fuel-listener.el --- starting the fuel listener
;; 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,6 +15,7 @@
(require 'fuel-stack)
(require 'fuel-completion)
(require 'fuel-xref)
(require 'fuel-eval)
(require 'fuel-connection)
(require 'fuel-syntax)
@ -169,6 +170,7 @@ buffer."
(define-key fuel-listener-mode-map "\C-ca" 'fuel-autodoc-mode)
(define-key fuel-listener-mode-map "\C-ch" 'fuel-help)
(define-key fuel-listener-mode-map "\C-cs" 'fuel-stack-mode)
(define-key fuel-listener-mode-map "\C-cp" 'fuel-apropos)
(define-key fuel-listener-mode-map "\M-." 'fuel-edit-word-at-point)
(define-key fuel-listener-mode-map "\C-cv" 'fuel-edit-vocabulary)
(define-key fuel-listener-mode-map "\C-c\C-v" 'fuel-edit-vocabulary)

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

@ -0,0 +1,479 @@
;;; 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-get button 'markup-link)
(button-get button 'markup-label)
(button-get button 'markup-link-type))))
(defun fuel-markup--echo-link (link label type)
(message "Link %s pointing to %s named %s" label type link))
(defun fuel-markup--insert-button (label link type)
(let ((label (format "%s" label))
(link (format "%s" link)))
(insert-text-button label
:type 'fuel-markup--button
'markup-link link
'markup-label label
'markup-link-type type
'help-echo (format "%s (%s)" label type))))
(defun fuel-markup--article-title (name)
(fuel-eval--retort-result
(fuel-eval--send/wait `(:fuel* ((,name fuel-article-title :get)) "fuel"))))
(defun fuel-markup--link-at-point ()
(let ((button (condition-case nil (forward-button 0) (error nil))))
(when button
(list (button-get button 'markup-link)
(button-get button 'markup-label)
(button-get button 'markup-link-type)))))
;;; Markup printers:
(defconst fuel-markup--printers
'(($class-description . fuel-markup--class-description)
($code . fuel-markup--code)
($command . fuel-markup--command)
($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)
($index . fuel-markup--index)
($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)
($predicate . fuel-markup--predicate)
($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--print-str (e)
(with-temp-buffer
(fuel-markup--print e)
(buffer-string)))
(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--vocab-subsection (e)
(fuel-markup--insert-nl-if-nb)
(insert " - ")
(fuel-markup--vocab-link (cons '$vocab-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 (format "%s" (cdr e))))
(insert (fuel-font-lock--factor-str 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--command (e)
(fuel-markup--snippet (list '$snippet (nth 3 e))))
(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")
(dolist (ex (cdr e))
(fuel-markup--print ex)
(newline)))
(defun fuel-markup--example (e)
(fuel-markup--snippet (list '$snippet (cadr e))))
(defun fuel-markup--markup-example (e)
(fuel-markup--snippet (cons '$snippet (cadr e))))
(defun fuel-markup--link (e)
(let* ((link (nth 1 e))
(type (or (nth 3 e) (if (symbolp link) 'word 'article)))
(label (or (nth 2 e)
(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))
(fuel-markup--link (list '$link link))
(insert ", "))
(delete-backward-char 2))
(defun fuel-markup--index-quotation (q)
(cond ((null q) null)
((listp q) (vconcat (mapcar 'fuel-markup--index-quotation q)))
(t q)))
(defun fuel-markup--index (e)
(let* ((q (fuel-markup--index-quotation (cadr e)))
(cmd `(:fuel* ((,q fuel-index)) "fuel"
("builtins" "help" "help.topics" "classes"
"classes.builtin" "classes.tuple"
"classes.singleton" "classes.union"
"classes.intersection" "classes.predicate")))
(subs (fuel-eval--retort-result (fuel-eval--send/wait cmd 200))))
(when subs
(fuel-markup--print subs))))
(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)
(fuel-markup--vocab-link (cons '$vocab-link (cdr 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--predicate (e)
(fuel-markup--values '($values ("object" object) ("?" "a boolean")))
(let ((word (make-symbol (substring (format "%s" (cadr e)) 0 -1))))
(fuel-markup--description
`($description "Tests if the object is an instance of the "
($link ,word) " class."))))
(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")
(dolist (ref (cdr e))
(if (listp ref)
(fuel-markup--print ref)
(fuel-markup--subsection (list '$subsection ref)))))
(defun fuel-markup--see-also (e)
(fuel-markup--insert-heading "See also")
(fuel-markup--links (cons '$links (cdr e))))
(defun fuel-markup--related (e)
(fuel-markup--insert-heading "See also")
(fuel-markup--links (cons '$links (cadr e))))
(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--quotation (e)
(insert "a ")
(fuel-markup--link (list '$link 'quotation 'quotation 'word))
(insert " with stack effect ")
(fuel-markup--snippet (list '$snippet (nth 1 e))))
(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--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)
(let* ((word (nth 1 e))
(cmd (and word `(:fuel* (,(format "%s" word) fuel-word-see) "fuel" t)))
(res (and cmd
(fuel-eval--retort-result (fuel-eval--send/wait cmd 100)))))
(if res
(fuel-markup--code (list '$code res))
(fuel-markup--snippet (list '$snippet word)))))
(defun fuel-markup--synopsis (e)
(insert (format " %S " e)))
(provide 'fuel-markup)
;;; fuel-markup.el ends here

View File

@ -1,6 +1,6 @@
;;; fuel-mode.el -- Minor mode enabling FUEL niceties
;; 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>
@ -224,6 +224,11 @@ With prefix argument, ask for word."
(message "Looking up %s's callees ..." word)
(fuel-xref--show-callees word))))
(defun fuel-apropos (str)
"Show a list of words containing the given substring."
(interactive "MFind words containing: ")
(message "Looking up %s's references ..." str)
(fuel-xref--apropos str))
;;; Minor mode definition:
@ -289,6 +294,7 @@ interacting with a factor listener is at your disposal.
(fuel-mode--key ?d ?> 'fuel-show-callees)
(fuel-mode--key ?d ?< 'fuel-show-callers)
(fuel-mode--key ?d ?a 'fuel-autodoc-mode)
(fuel-mode--key ?d ?p 'fuel-apropos)
(fuel-mode--key ?d ?d 'fuel-help)
(fuel-mode--key ?d ?e 'fuel-stack-effect-sexp)
(fuel-mode--key ?d ?s 'fuel-help-short)

View File

@ -157,19 +157,26 @@
table))
(defconst fuel-syntax--syntactic-keywords
`(("\\_<\\(#?!\\) .*\\(\n\\)" (1 "<") (2 ">"))
("\\_<\\(#?!\\)\\(\n\\)" (1 "<") (2 ">"))
`(;; Comments:
("\\_<\\(#?!\\) .*\\(\n\\|$\\)" (1 "<") (2 ">"))
("\\_<\\(#?!\\)\\(\n\\|$\\)" (1 "<") (2 ">"))
;; CHARs:
("CHAR: \\(.\\)\\( \\|$\\)" (1 "w"))
;; Let and lambda:
("\\_<\\(!(\\) .* \\()\\)" (1 "<") (2 ">"))
("\\(\\[\\)\\(let\\|wlet\\|let\\*\\)\\( \\|$\\)" (1 "(]"))
("\\(\\[\\)\\(|\\) +[^|]* \\(|\\)" (1 "(]") (2 "(|") (3 ")|"))
(" \\(|\\) " (1 "(|"))
(" \\(|\\)$" (1 ")"))
("CHAR: \\(\"\\)\\( \\|$\\)" (1 "w"))
;; Opening brace words:
(,(format "\\_<%s\\({\\)\\_>" (regexp-opt fuel-syntax--bracers)) (1 "(}"))
("\\_<\\({\\)\\_>" (1 "(}"))
("\\_<\\(}\\)\\_>" (1 "){"))
;; Parenthesis:
("\\_<\\((\\)\\_>" (1 "()"))
("\\_<\\()\\)\\_>" (1 ")("))
;; Quotations:
("\\_<'\\(\\[\\)\\_>" (1 "(]")) ; fried
("\\_<\\(\\[\\)\\_>" (1 "(]"))
("\\_<\\(\\]\\)\\_>" (1 ")["))))
@ -294,21 +301,9 @@
(funcall fuel-syntax--current-vocab-function))
(defun fuel-syntax--find-in ()
(let* ((vocab)
(ip
(save-excursion
(when (re-search-backward fuel-syntax--current-vocab-regex nil t)
(setq vocab (match-string-no-properties 1))
(point)))))
(when ip
(let ((pp (save-excursion
(when (re-search-backward fuel-syntax--sub-vocab-regex ip t)
(point)))))
(when (and pp (> pp ip))
(let ((sub (match-string-no-properties 1)))
(unless (save-excursion (search-backward (format "%s>" sub) pp t))
(setq vocab (format "%s.%s" vocab (downcase sub))))))))
vocab))
(match-string-no-properties 1))))
(make-variable-buffer-local
(defvar fuel-syntax--usings-function 'fuel-syntax--find-usings))
@ -316,13 +311,19 @@
(defsubst fuel-syntax--usings ()
(funcall fuel-syntax--usings-function))
(defun fuel-syntax--find-usings ()
(defun fuel-syntax--find-usings (&optional no-private)
(save-excursion
(let ((usings))
(goto-char (point-max))
(while (re-search-backward fuel-syntax--using-lines-regex nil t)
(dolist (u (split-string (match-string-no-properties 1) nil t))
(push u usings)))
(goto-char (point-min))
(when (and (not no-private)
(re-search-forward "\\_<<PRIVATE\\_>" nil t)
(re-search-forward "\\_<PRIVATE>\\_>" nil t))
(goto-char (point-max))
(push (concat (fuel-syntax--find-in) ".private") usings))
usings)))

View File

@ -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>
@ -75,11 +75,10 @@ cursor at the first ocurrence of the used word."
(defvar fuel-xref--help-string "(Press RET or click to follow crossrefs)")
(defun fuel-xref--title (word cc count)
(let ((cc (if cc "using" "used by")))
(put-text-property 0 (length word) 'font-lock-face 'bold word)
(cond ((zerop count) (format "No known words %s %s" cc word))
((= 1 count) (format "1 word %s %s:" cc word))
(t (format "%s words %s %s:" count cc word)))))
(t (format "%s words %s %s:" count cc word))))
(defun fuel-xref--insert-ref (ref)
(when (and (stringp (first ref))
@ -124,12 +123,17 @@ cursor at the first ocurrence of the used word."
(defun fuel-xref--show-callers (word)
(let* ((cmd `(:fuel* (((:quote ,word) fuel-callers-xref))))
(res (fuel-eval--retort-result (fuel-eval--send/wait cmd))))
(fuel-xref--fill-and-display word t res)))
(fuel-xref--fill-and-display word "using" res)))
(defun fuel-xref--show-callees (word)
(let* ((cmd `(:fuel* (((:quote ,word) fuel-callees-xref))))
(res (fuel-eval--retort-result (fuel-eval--send/wait cmd))))
(fuel-xref--fill-and-display word nil res)))
(fuel-xref--fill-and-display word "used by" res)))
(defun fuel-xref--apropos (str)
(let* ((cmd `(:fuel* ((,str fuel-apropos-xref))))
(res (fuel-eval--retort-result (fuel-eval--send/wait cmd))))
(fuel-xref--fill-and-display str "containing" res)))
;;; Xref mode:
@ -138,7 +142,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 ()