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,108 +1,115 @@
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.
FUEL comes bundled with Factor's distribution. The folder misc/fuel
contains Elisp code, and there's a fuel vocabulary in extras/fuel.
To install FUEL, either add this line to your Emacs initialisation:
To install FUEL, either add this line to your Emacs initialisation:
(load-file "<path/to/factor/installation>/misc/fuel/fu.el")
or
or
(add-to-list load-path "<path/to/factor/installation>/fuel")
(require 'fuel)
If all you want is a major mode for editing Factor code with pretty
font colors and indentation, without running the factor listener
inside Emacs, you can use instead:
If all you want is a major mode for editing Factor code with pretty
font colors and indentation, without running the factor listener
inside Emacs, you can use instead:
(add-to-list load-path "<path/to/factor/installation>/fuel")
(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.
Editing any file with the extension .factor will put you in
factor-mode; try C-hm for a summary of available commands.
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.
Editing any file with the extension .factor will put you in
factor-mode; try C-hm for a summary of available commands.
To start the listener, try M-x run-factor.
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.
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)).
(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
- C-cz : switch to listener
- C-co : cycle between code, tests and docs factor files
- M-. : edit word at point in Emacs
- M-TAB : complete word at point
- C-cC-eu : update USING: line
- C-cC-ev : edit vocabulary (M-x fuel-edit-vocabulary)
- C-cC-ew : edit word (M-x fuel-edit-word-at-point)
- C-cC-ed : edit word's doc (M-x fuel-edit-word-at-point)
- M-. : edit word at point in Emacs
- M-TAB : complete word at point
- C-cC-eu : update USING: line
- C-cC-ev : edit vocabulary (M-x fuel-edit-vocabulary)
- C-cC-ew : edit word (M-x fuel-edit-word-at-point)
- C-cC-ed : edit word's doc (M-x fuel-edit-word-at-point)
- C-cr, C-cC-er : eval region
- C-M-r, C-cC-ee : eval region, extending it to definition boundaries
- C-M-x, C-cC-ex : eval definition around point
- C-ck, C-cC-ek : run file
- C-cr, C-cC-er : eval region
- C-M-r, C-cC-ee : eval region, extending it to definition boundaries
- C-M-x, C-cC-ex : eval definition around point
- C-ck, C-cC-ek : run file
- C-cC-da : toggle autodoc mode
- 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-da : toggle autodoc mode
- 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
- 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-cs : toggle stack mode
- C-cv : edit vocabulary
- C-ch : help for word at point
- C-ck : run file
- 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
- 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
- SPC/S-SPC : scroll up/down
- TAB/S-TAB : next/previous headline
- C-cz : switch to listener
- q : bury buffer
- 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 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
- q : bury buffer
- TAB/BACKTAB : navigate links
- RET/mouse click : follow link
- q : bury buffer

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)
(insert "\nDone!")
(fuel-debug--uses-clean)
(bury-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)
(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)))
@ -210,11 +170,11 @@
(defconst fuel-debug--uses-header-regex
(format "^%s.*$" (regexp-opt '("Infering USING: stanza for "
"Current USING: is already fine!"
"Current vocabulary list:"
"Correct vocabulary list:"
"Sorry, couldn't infer the vocabulary list."
"Done!"))))
"Current USING: is already fine!"
"Current vocabulary list:"
"Correct vocabulary list:"
"Sorry, couldn't infer the vocabulary list."
"Done!"))))
(defconst fuel-debug--uses-prompt-regex
(format "^%s" (regexp-opt '("Asking Factor. Please, wait ..."

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
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 (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))
(save-excursion
(when (re-search-backward fuel-syntax--current-vocab-regex nil t)
(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)))))
(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))))
(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 ()