steve
/
factor
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

Large reorg of FUEL codebase 

* Modernize the FUEL elisp code for Emacs 24.3. Emacs 24.3 deprecated
the old 'cl lib and standardized a new 'cl-lib lib to put the name
clash issues to rest once and for all. This version of FUEL now requires
24.3.
* Move FUEL code that was needed by factor-mode into factor-mode and
rename appropriately. factor-mode and FUEL are now clearly separated
and FUEL depends on factor-mode.
* Set up FUEL with appropriate autoloads so that it's Emacs 24 package
manager friendly. FUEL can now be uploaded to MELPA or some similar
package manager.
* Changed the Factor faces for font locking to inherit from the default
Emacs faces rather than defaulting to other colors. This means that
Emacs themes will work for Factor code out of the box. Further
tailoring of Factor-specific faces can be done by users themselves.
* Cleaned up a lot of code to use Emacs conventions
(define-defined-mode, define-minor-mode, indent-function, etc) and added
a propery syntax table so that paren matching works, and word/symbol
skipping works.
* Added a new minor mode, fuel-autohelp-mode, that displays the help for
the symbol under point in another window. A fusion of fuel-autodoc-mode
and fuel-help-mode that's quite handy for reading Factor code.
db4
Erik Charlebois 2013-05-05 00:48:12 -04:00
parent a5bc30ba42
commit deb0ceaa9c
29 changed files with 1619 additions and 1607 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

20
misc/fuel/LICENSE Normal file
View File

@ -0,0 +1,20 @@
Redistribution and use in source and binary forms, with or without
modification, are permitted provided that the following conditions are met:
1. Redistributions of source code must retain the above copyright notice,
this list of conditions and the following disclaimer.
2. Redistributions in binary form must reproduce the above copyright notice,
this list of conditions and the following disclaimer in the documentation
and/or other materials provided with the distribution.
THIS SOFTWARE IS PROVIDED ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES,
INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND
FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE
DEVELOPERS AND CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,
PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS;
OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY,
WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR
OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF
ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.

199
misc/fuel/README
View File

@ -1,199 +0,0 @@
FUEL, Factor's Ultimate Emacs Library
-------------------------------------
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 Eduardo Cavazos'
original factor.el code. Eduardo is also responsible of naming the
beast.
* Installation
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:
(load-file "<path/to/factor/installation>/misc/fuel/fu.el")
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
*** Running the listener
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.
By default, FUEL will try to use the binary and image files in the
factor installation directory. You can customize them with:
(setq fuel-listener-factor-binary <full path to factor>)
(setq fuel-listener-factor-image <full path to factor image>)
Many aspects of the environment can be customized:
M-x customize-group fuel will show you how many.
*** Faster listener startup
On startup, run-factor loads the fuel vocabulary, which can take a
while. If you want to speedup the load process, type 'save' in the
listener prompt just after invoking run-factor. This will save a
factor image (overwriting the current one) with all the needed
vocabs.
Alternatively, you can add the following line to your
.factor-boot-rc file:
"fuel" require
This will ensure that the image generated while bootstrapping
Factor contains fuel and the vocabularies it depends on.
*** Connecting to a running Factor
'run-factor' starts a new factor listener process managed by Emacs.
If you prefer to start Factor externally, you can also connect
remotely from Emacs. Here's how to proceed:
- In the factor listener, run FUEL: "fuel" run
This will start a server listener in port 9000.
- Switch to Emacs and issue the command 'M-x connect-to-factor'.
That's it; you should be up and running. See the help for
'connect-to-factor' for how to use a different port.
*** Vocabulary creation
FUEL offers a basic interface to Factor's scaffolding utilities.
To create a new vocabulary directory and associated files:
M-x fuel-scaffold-vocab
and when in a vocab file, to create a docs file with boilerplate
for each word:
M-x fuel-scaffold-help
* Quick key reference
Triple chords ending in a single letter <x> accept also C-<x> (e.g.
C-c C-e C-r is the same as C-c C-e r).
*** In factor source files:
Commands in parenthesis can be invoked interactively with
M-x <command>, not necessarily in a factor buffer.
|--------------------+------------------------------------------------------------|
| C-c C-z | switch to listener (run-factor) |
| C-c C-o | cycle between code, tests and docs files |
| C-c C-t | run the unit tests for a vocabulary |
| C-c C-r | switch to listener and refresh all loaded vocabs |
| C-c C-s | switch to other factor buffer (fuel-switch-to-buffer) |
| C-x 4 s | switch to other factor buffer in other window |
| C-x 5 s | switch to other factor buffer in other frame |
|--------------------+------------------------------------------------------------|
| M-. | edit word at point in Emacs (fuel-edit-word) |
| M-, | go back to where M-. was last invoked |
| M-TAB | complete word at point |
| C-c C-e u | update USING: line (fuel-update-usings) |
| C-c C-e v | edit vocabulary (fuel-edit-vocabulary) |
| C-c C-e w | edit word (fuel-edit-word-at-point) |
| C-c C-e d | edit word's doc (C-u M-x fuel-edit-word-doc-at-point) |
| C-c C-e l | load vocabs in USING: form |
|--------------------+------------------------------------------------------------|
| C-c C-e r | eval region |
| C-M-r, C-c C-e e | eval region, extending it to definition boundaries |
| C-M-x, C-c C-e x | eval definition around point |
| C-c C-k, C-c C-e k | run file (fuel-run-file) |
|--------------------+------------------------------------------------------------|
| C-c C-d a | toggle autodoc mode (fuel-autodoc-mode) |
| C-c C-d d | help for word at point (fuel-help) |
| C-c C-d s | short help word at point (fuel-help-short) |
| C-c C-d e | show stack effect of current sexp (with prefix, region) |
| C-c C-d p | find words containing given substring (fuel-apropos) |
| C-c C-d v | show words in current file (with prefix, ask for vocab) |
|--------------------+------------------------------------------------------------|
| C-c M-< | show callers of word or vocabulary at point |
| | (fuel-show-callers, fuel-vocab-usage) |
| C-c M-> | show callees of word or vocabulary at point |
| | (fuel-show-callees, fuel-vocab-uses) |
|--------------------+------------------------------------------------------------|
| C-c C-x s | extract innermost sexp (up to point) as a separate word |
| | (fuel-refactor-extract-sexp) |
| C-c C-x r | extract region as a separate word |
| | (fuel-refactor-extract-region) |
| C-c C-x v | extract region as a separate vocabulary |
| | (fuel-refactor-extract-vocab) |
| C-c C-x i | replace word by its definition (fuel-refactor-inline-word) |
| C-c C-x w | rename all uses of a word (fuel-refactor-rename-word) |
| C-c C-x a | extract region as a separate ARTICLE: form |
| C-c C-x g | convert current word definition into GENERIC + method |
| | (fuel-refactor-make-generic) |
|--------------------+------------------------------------------------------------|
*** In the listener:
|---------+----------------------------------------------------------|
| TAB | complete word at point |
| M-. | edit word at point in Emacs |
| C-c C-r | refresh all loaded vocabs |
| C-c C-a | toggle autodoc mode |
| C-c C-p | find words containing given substring (M-x fuel-apropos) |
| C-c C-s | toggle stack mode |
| C-c C-v | edit vocabulary |
| C-c C-w | help for word at point |
| C-c C-k | run file |
|---------+----------------------------------------------------------|
*** 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:
|-----------+----------------------------------------------------------|
| h | help for word at point |
| v | help for a vocabulary |
| a | find words containing given substring (M-x fuel-apropos) |
| e | edit current article |
| b a | bookmark current page |
| b b | display bookmarks |
| b d | delete bookmark at point |
| n/p | next/previous page |
| l | previous page |
| SPC/S-SPC | scroll up/down |
| TAB/S-TAB | next/previous link |
| k | kill current page and go to previous or next |
| r | refresh page |
| c | clean browsing history |
| M-. | edit word at point in Emacs |
| C-c C-z | switch to listener |
| q | bury buffer |
|-----------+----------------------------------------------------------|
*** In crossref buffers
|-----------------+-----------------------------|
| TAB/BACKTAB | navigate links |
| RET/mouse click | follow link |
| h | show help for word at point |
| q | bury buffer |
|-----------------+-----------------------------|

205
misc/fuel/README.md Normal file
View File

@ -0,0 +1,205 @@
FUEL, Factor's Ultimate Emacs Library
-------------------------------------
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 Eduardo Cavazos'
original factor.el code. Eduardo is also responsible of naming the
beast.
# Installation
FUEL can be installed from [MELPA](http://melpa.milkbox.net/).
Alternatively, FUEL comes bundled with Factor's distribution.
The folder misc/fuel can be added to your load path:
(load-file "<path/to/factor/installation>/misc/fuel/fu.el")
The factor-mode major mode provides basic fontification and indentation
without connecting to an running Factor image:
(require 'factor-mode)
The fuel-mode minor mode provides interaction with a runnign Factor instance:
(require 'fuel-mode)
To use FUEL, you must set `fuel-factor-root-dir` to the root directory
of your Factor installation:
(setq fuel-factor-root-dir "<path/to/factor/installation>")
# Basic usage
## Running the listener
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`.
By default, FUEL will try to use the binary and image files in the
factor installation directory. You can customize them with:
(setq fuel-listener-factor-binary <full path to factor>)
(setq fuel-listener-factor-image <full path to factor image>)
Many aspects of the environment can be customized:
`M-x customize-group fuel` will show you how many.
### Faster listener startup
On startup, `run-factor` loads the fuel vocabulary, which can take a
while. If you want to speedup the load process, type `save` in the
listener prompt just after invoking `run-factor`. This will save a
Factor image (overwriting the current one) with all the needed
vocabs.
Alternatively, you can add the following line to your
`.factor-boot-rc` file:
"fuel" require
This will ensure that the image generated while bootstrapping
Factor contains fuel and the vocabularies it depends on.
### Connecting to a running Factor
`run-factor` starts a new factor listener process managed by Emacs.
If you prefer to start Factor externally, you can also connect
remotely from Emacs. Here's how to proceed:
- In the factor listener, run FUEL: `"fuel" run`. This will start a server
listener in port 9000.
- Switch to Emacs and issue the command `M-x connect-to-factor`.
That's it; you should be up and running. See the help for
`connect-to-factor` for how to use a different port.
### Vocabulary creation
FUEL offers a basic interface to Factor's scaffolding utilities.
To create a new vocabulary directory and associated files:
M-x fuel-scaffold-vocab
and when in a vocab file, to create a docs file with boilerplate
for each word:
M-x fuel-scaffold-help
# Quick key reference
Triple chords ending in a single letter <x> accept also C-<x> (e.g.
C-c C-e C-r is the same as C-c C-e r).
### In factor source files:
Commands in parenthesis can be invoked interactively with
M-x <command>, not necessarily in a factor buffer.
|--------------------+------------------------------------------------------------|
| C-c C-z | switch to listener (run-factor) |
| C-c C-o | cycle between code, tests and docs files |
| C-c C-t | run the unit tests for a vocabulary |
| C-c C-r | switch to listener and refresh all loaded vocabs |
| C-c C-s | switch to other factor buffer (fuel-switch-to-buffer) |
| C-x 4 s | switch to other factor buffer in other window |
| C-x 5 s | switch to other factor buffer in other frame |
|--------------------+------------------------------------------------------------|
| M-. | edit word at point in Emacs (fuel-edit-word) |
| M-, | go back to where M-. was last invoked |
| M-TAB | complete word at point |
| C-c C-e u | update USING: line (fuel-update-usings) |
| C-c C-e v | edit vocabulary (fuel-edit-vocabulary) |
| C-c C-e w | edit word (fuel-edit-word-at-point) |
| C-c C-e d | edit word's doc (C-u M-x fuel-edit-word-doc-at-point) |
| C-c C-e l | load vocabs in USING: form |
|--------------------+------------------------------------------------------------|
| C-c C-e r | eval region |
| C-M-r, C-c C-e e | eval region, extending it to definition boundaries |
| C-M-x, C-c C-e x | eval definition around point |
| C-c C-k, C-c C-e k | run file (fuel-run-file) |
|--------------------+------------------------------------------------------------|
| C-c C-d a | toggle autodoc mode (fuel-autodoc-mode) |
| C-c C-d d | help for word at point (fuel-help) |
| C-c C-d s | short help word at point (fuel-help-short) |
| C-c C-d e | show stack effect of current sexp (with prefix, region) |
| C-c C-d p | find words containing given substring (fuel-apropos) |
| C-c C-d v | show words in current file (with prefix, ask for vocab) |
|--------------------+------------------------------------------------------------|
| C-c M-< | show callers of word or vocabulary at point |
| | (fuel-show-callers, fuel-vocab-usage) |
| C-c M-> | show callees of word or vocabulary at point |
| | (fuel-show-callees, fuel-vocab-uses) |
|--------------------+------------------------------------------------------------|
| C-c C-x s | extract innermost sexp (up to point) as a separate word |
| | (fuel-refactor-extract-sexp) |
| C-c C-x r | extract region as a separate word |
| | (fuel-refactor-extract-region) |
| C-c C-x v | extract region as a separate vocabulary |
| | (fuel-refactor-extract-vocab) |
| C-c C-x i | replace word by its definition (fuel-refactor-inline-word) |
| C-c C-x w | rename all uses of a word (fuel-refactor-rename-word) |
| C-c C-x a | extract region as a separate ARTICLE: form |
| C-c C-x g | convert current word definition into GENERIC + method |
| | (fuel-refactor-make-generic) |
|--------------------+------------------------------------------------------------|
### In the listener:
|---------+----------------------------------------------------------|
| TAB | complete word at point |
| M-. | edit word at point in Emacs |
| C-c C-r | refresh all loaded vocabs |
| C-c C-a | toggle autodoc mode |
| C-c C-p | find words containing given substring (M-x fuel-apropos) |
| C-c C-s | toggle stack mode |
| C-c C-v | edit vocabulary |
| C-c C-w | help for word at point |
| C-c C-k | run file |
|---------+----------------------------------------------------------|
### 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:
|-----------+----------------------------------------------------------|
| h | help for word at point |
| v | help for a vocabulary |
| a | find words containing given substring (M-x fuel-apropos) |
| e | edit current article |
| b a | bookmark current page |
| b b | display bookmarks |
| b d | delete bookmark at point |
| n/p | next/previous page |
| l | previous page |
| SPC/S-SPC | scroll up/down |
| TAB/S-TAB | next/previous link |
| k | kill current page and go to previous or next |
| r | refresh page |
| c | clean browsing history |
| M-. | edit word at point in Emacs |
| C-c C-z | switch to listener |
| q | bury buffer |
|-----------+----------------------------------------------------------|
### In crossref buffers
|-----------------+-----------------------------|
| TAB/BACKTAB | navigate links |
| RET/mouse click | follow link |
| h | show help for word at point |
| q | bury buffer |
|-----------------+-----------------------------|

887
misc/fuel/factor-mode.el
View File

File diff suppressed because it is too large Load Diff

54
misc/fuel/fu.el
View File

@ -1,54 +0,0 @@
;;; fu.el --- Startup file for FUEL
;; 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>
;; Keywords: languages
;;; Code:
(setq fuel-factor-fuel-dir (file-name-directory load-file-name))
(setq fuel-factor-root-dir (expand-file-name "../../" fuel-factor-fuel-dir))
(add-to-list 'load-path fuel-factor-fuel-dir)
(add-to-list 'auto-mode-alist '("\\.factor\\'" . factor-mode))
(autoload 'factor-mode "factor-mode.el"
"Major mode for editing Factor source." t)
(autoload 'run-factor "fuel-listener.el"
"Start a Factor listener, or switch to a running one." t)
(autoload 'switch-to-factor "fuel-listener.el"
"Start a Factor listener, or switch to a running one." t)
(autoload 'connect-to-factor "fuel-listener.el"
"Connect to an external Factor listener." t)
(autoload 'fuel-autodoc-mode "fuel-help.el"
"Minor mode showing in the minibuffer a synopsis of Factor word at point."
t)
(autoload 'fuel-scaffold-vocab "fuel-scaffold.el"
"Create a new Factor vocabulary." t)
(autoload 'fuel-scaffold-help "fuel-scaffold.el"
"Create a Factor vocabulary help file." t)
(mapc (lambda (group)
(custom-add-load group (symbol-name group))
(custom-add-load 'fuel (symbol-name group)))
'(fuel fuel-faces
factor-mode
fuel-autodoc
fuel-stack
fuel-help
fuel-xref
fuel-listener
fuel-scaffold
fuel-debug
fuel-mode))
;;; fu.el ends here

24
misc/fuel/fuel-autodoc.el
View File

@ -15,13 +15,13 @@
;;; Code:
(require 'fuel-eval)
(require 'fuel-font-lock)
(require 'fuel-syntax)
(require 'fuel-base)
(require 'factor-mode)
;;; Customization:
;;;###autoload
(defgroup fuel-autodoc nil
"Options controlling FUEL's autodoc system."
:group 'fuel)
@ -54,22 +54,21 @@ USING: form with \\[fuel-load-usings]."
(defvar fuel-autodoc--timeout 200)
(defun fuel-autodoc--word-synopsis (&optional word)
(let ((word (or word (fuel-syntax-symbol-at-point)))
(let ((word (or word (factor-symbol-at-point)))
(fuel-log--inhibit-p t))
(when word
(let* ((usings (if fuel-autodoc-eval-using-form-p :usings t))
(cmd (if (fuel-syntax--in-using)
(cmd (if (factor-in-using)
`(:fuel* (,word fuel-vocab-summary) :in t)
`(:fuel* ((,word :usings fuel-word-synopsis)) t ,usings)))
(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-font-lock--factor-str res)
(factor-font-lock-string res)
res))))))
(make-variable-buffer-local
(defvar fuel-autodoc--fallback-function nil))
(defvar-local fuel-autodoc--fallback-function nil)
(defun fuel-autodoc--eldoc-function ()
(or (and fuel-autodoc--fallback-function
@ -82,10 +81,10 @@ USING: form with \\[fuel-load-usings]."
;;; Autodoc mode:
(make-variable-buffer-local
(defvar fuel-autodoc-mode-string " A"
"Modeline indicator for fuel-autodoc-mode"))
(defvar-local fuel-autodoc-mode-string " A"
"Modeline indicator for fuel-autodoc-mode")
;;;###autoload
(define-minor-mode fuel-autodoc-mode
"Toggle Fuel's Autodoc mode.
With no argument, this command toggles the mode.
@ -98,12 +97,13 @@ displayed in the minibuffer."
:lighter fuel-autodoc-mode-string
:group 'fuel-autodoc
(set (make-local-variable 'eldoc-documentation-function)
(setq-local eldoc-documentation-function
(when fuel-autodoc-mode 'fuel-autodoc--eldoc-function))
(set (make-local-variable 'eldoc-minor-mode-string) nil)
(setq-local eldoc-minor-mode-string nil)
(eldoc-mode fuel-autodoc-mode)
(message "Fuel Autodoc %s" (if fuel-autodoc-mode "enabled" "disabled")))
(provide 'fuel-autodoc)
;;; fuel-autodoc.el ends here

100
misc/fuel/fuel-autohelp.el Normal file
View File

@ -0,0 +1,100 @@
;;; fuel-autohelp.el -- help pages in another window
;; Copyright (C) 2013 Erik Charlebois
;; See http://factorcode.org/license.txt for BSD license.
;; Author: Erik Charlebois <erikcharlebois@gmail.com>
;; Keywords: languages, fuel, factor
;; Start date: Mon Mar 25, 2012, 11:46
;;; Commentary:
;; Utilities for displaying help in a side window.
;;; Code:
(require 'fuel-base)
(require 'fuel-help)
(require 'factor-mode)
;;; Customization:
;;;###autoload
(defgroup fuel-autohelp nil
"Options controlling FUEL's autohelp system."
:group 'fuel)
(defcustom fuel-autohelp-idle-delay 0.7
"Number of seconds of idle time to wait before printing.
If user input arrives before this interval of time has elapsed after the
last input, no documentation will be printed.
If this variable is set to 0, no idle time is required."
:type 'number
:group 'fuel-autohelp)
;;; Helper function:
(defvar fuel-autohelp-timer nil "Autohelp's timer object.")
(defvar fuel-autohelp-current-idle-delay fuel-autohelp-idle-delay
"Idle time delay currently in use by timer.
This is used to determine if `fuel-autohelp-idle-delay' is changed by the
user.")
(defun fuel-autohelp-show-current-symbol-help ()
(condition-case err
(when (and (boundp 'fuel-autohelp-mode) fuel-autohelp-mode)
(let ((word (factor-symbol-at-point))
(fuel-log--inhibit-p t))
(when word
(fuel-help--word-help nil word t))))
(error (message "FUEL Autohelp error: %s" err))))
(defun fuel-autohelp-schedule-timer ()
(or (and fuel-autohelp-timer
(memq fuel-autohelp-timer timer-idle-list))
(setq fuel-autohelp-timer
(run-with-idle-timer fuel-autohelp-idle-delay t
'fuel-autohelp-show-current-symbol-help)))
;; If user has changed the idle delay, update the timer.
(cond ((not (= fuel-autohelp-idle-delay fuel-autohelp-current-idle-delay))
(setq fuel-autohelp-current-idle-delay fuel-autohelp-idle-delay)
(timer-set-idle-time fuel-autohelp-timer fuel-autohelp-idle-delay t))))
;;; Autohelp mode:
(defvar-local fuel-autohelp-mode-string " H"
"Modeline indicator for fuel-autohelp-mode")
;;;###autoload
(define-minor-mode fuel-autohelp-mode
"Toggle Fuel's Autohelp mode.
With no argument, this command toggles the mode.
Non-null prefix argument turns on the mode.
Null prefix argument turns off the mode.
When Autohelp mode is enabled, the help for the word is displayed
in another window."
:init-value nil
:lighter fuel-autohelp-mode-string
:group 'fuel-autohelp
(if fuel-autohelp-mode
(add-hook 'post-command-hook 'fuel-autohelp-schedule-timer nil t)
(remove-hook 'post-command-hook 'fuel-autohelp-schedule-timer)))
;;;###autoload
(defun turn-on-fuel-autohelp-mode ()
"Unequivocally turn on FUEL's Autohelp mode (see command
`fuel-autohelp-mode')."
(interactive)
(fuel-autohelp-mode 1))
(provide 'fuel-autohelp)
;;; fuel-autohelp.el ends here

77
misc/fuel/fuel-base.el
View File

@ -4,7 +4,7 @@
;; See http://factorcode.org/license.txt for BSD license.
;; Author: Jose Antonio Ortega Ruiz <jao@gnu.org>
;; Keywords: languages
;; Keywords: languages, fuel, factor
;;; Commentary:
@ -12,7 +12,7 @@
;;; Code:
(defconst fuel-version "1.0")
(defconst fuel-version "1.1")
;;;###autoload
(defsubst fuel-version ()
@ -29,73 +29,48 @@
:group 'languages)
;;; Emacs compatibility:
;;; Utilities:
(eval-after-load "ring"
'(when (not (fboundp 'ring-member))
(defun ring-member (ring item)
(catch 'found
(dotimes (ind (ring-length ring) nil)
(when (equal item (ring-ref ring ind))
(throw 'found ind)))))))
(when (not (fboundp 'completion-table-dynamic))
(defun completion-table-dynamic (fun)
(lexical-let ((fun fun))
(lambda (string pred action)
(with-current-buffer (let ((win (minibuffer-selected-window)))
(if (window-live-p win) (window-buffer win)
(current-buffer)))
(complete-with-action action (funcall fun string) string pred))))))
(when (not (fboundp 'looking-at-p))
(defsubst looking-at-p (regexp)
(let ((inhibit-changing-match-data t))
(looking-at regexp))))
;;; Utilities
(defun fuel--shorten-str (str len)
(defun fuel-shorten-str (str len)
(let ((sl (length str)))
(if (<= sl len) str
(let* ((sep " ... ")
(sepl (length sep))
(segl (/ (- len sepl) 2)))
(format "%s%s%s"
(substring str 0 segl)
sep
(substring str (- sl segl)))))))
(format "%s%s%s" (substring str 0 segl)
sep (substring str (- sl segl)))))))
(defun fuel--shorten-region (begin end len)
(fuel--shorten-str (mapconcat 'identity
(split-string (buffer-substring begin end) nil t)
" ")
len))
(defun fuel-shorten-region (begin end len)
(fuel-shorten-str
(mapconcat 'identity
(split-string (buffer-substring begin end) nil t) " ") len))
(defsubst fuel--region-to-string (begin &optional end)
(defsubst fuel-region-to-string (begin &optional end)
(let ((end (or end (point))))
(if (< begin end)
(mapconcat 'identity
(split-string (buffer-substring-no-properties begin end)
nil
t)
" ")
"")))
nil t) " ") "")))
(defsubst empty-string-p (str) (equal str ""))
(defun fuel--string-prefix-p (prefix str)
(and (>= (length str) (length prefix))
(string= (substring-no-properties str 0 (length prefix))
(substring-no-properties prefix))))
(defun fuel--respecting-message (format &rest format-args)
(defun fuel-respecting-message (format &rest format-args)
"Display TEXT as a message, without hiding any minibuffer contents."
(let ((text (format " [%s]" (apply #'format format format-args))))
(if (minibuffer-window-active-p (minibuffer-window))
(minibuffer-message text)
(message "%s" text))))
(defun fuel-mode--read-file (arg)
(let* ((file (or (and arg (read-file-name "File: " nil (buffer-file-name) t))
(buffer-file-name)))
(file (expand-file-name file))
(buffer (find-file-noselect file)))
(when (and buffer
(buffer-modified-p buffer)
(y-or-n-p "Save file? "))
(save-buffer buffer))
(cons file buffer)))
(provide 'fuel-base)
;;; fuel-base.el ends here

51
misc/fuel/fuel-completion.el
View File

@ -14,9 +14,9 @@
;;; Code:
(require 'fuel-base)
(require 'fuel-syntax)
(require 'fuel-eval)
(require 'fuel-log)
(require 'factor-mode)
;;; Aux:
@ -34,17 +34,20 @@
(defun fuel-completion--vocabs (&optional reload)
(when (or reload (not fuel-completion--vocabs))
(fuel--respecting-message "Retrieving vocabs list")
(fuel-respecting-message "Retrieving vocabs list")
(let ((fuel-log--inhibit-p t))
(setq fuel-completion--vocabs
(fuel-eval--retort-result
(fuel-eval--send/wait '(:fuel* (fuel-get-vocabs) "fuel" (:array)))))))
fuel-completion--vocabs)
(defvar fuel-completion--vocab-history nil)
(defun fuel-completion--read-vocab (&optional reload init-input history)
(let ((minibuffer-local-completion-map fuel-completion--minibuffer-map)
(vocabs (fuel-completion--vocabs reload)))
(completing-read "Vocab name: " vocabs nil nil init-input history)))
(completing-read "Vocab name: " vocabs nil nil
init-input (or history fuel-completion--vocab-history))))
(defsubst fuel-completion--vocab-list (prefix)
(fuel-eval--retort-result
@ -61,17 +64,15 @@
(defvar fuel-completion--comp-buffer "*Completions*")
(make-variable-buffer-local
(defvar fuel-completion--window-cfg nil
(defvar-local fuel-completion--window-cfg nil
"Window configuration before we show the *Completions* buffer.
This is buffer local in the buffer where the completion is
performed."))
performed.")
(make-variable-buffer-local
(defvar fuel-completion--completions-window nil
(defvar-local fuel-completion--completions-window nil
"The window displaying *Completions* after saving window configuration.
If this window is no longer active or displaying the completions
buffer then we can ignore `fuel-completion--window-cfg'."))
buffer then we can ignore `fuel-completion--window-cfg'.")
(defun fuel-completion--save-window-cfg ()
"Maybe save the current window configuration.
@ -109,7 +110,7 @@ terminates a current completion."
(remove-hook 'pre-command-hook
'fuel-completion--maybe-restore-window-cfg)
(condition-case err
(cond ((find last-command-char "()\"'`,# \r\n:")
(cond ((cl-find last-command-event "()\"'`,# \r\n:")
(fuel-completion--restore-window-cfg))
((not (fuel-completion--window-active-p))
(fuel-completion--forget-window-cfg))
@ -131,8 +132,8 @@ terminates a current completion."
(display-completion-list completions base)
(let ((offset (- (point) 1 (length base))))
(with-current-buffer standard-output
(setq completion-base-size offset)
(set-syntax-table fuel-syntax--syntax-table))))
(setq completion-base-position offset)
(set-syntax-table factor-mode-syntax-table))))
(when savedp
(setq fuel-completion--completions-window
(get-buffer-window fuel-completion--comp-buffer)))))
@ -157,8 +158,8 @@ terminates a current completion."
(defun fuel-completion--word-list (prefix)
(let* ((fuel-log--inhibit-p t)
(cv (fuel-syntax--current-vocab))
(vs (and cv `("syntax" ,cv ,@(fuel-syntax--usings)))))
(cv (factor-current-vocab))
(vs (and cv `("syntax" ,cv ,@(factor-usings)))))
(fuel-completion--words prefix vs)))
(defsubst fuel-completion--all-words-list (prefix)
@ -186,36 +187,26 @@ terminates a current completion."
fuel-completion--word-list-func)
nil nil nil
history
(or default (fuel-syntax-symbol-at-point)))))
(defvar fuel-completion--vocab-history nil)
(defun fuel-completion--read-vocab (refresh &optional init-input)
(let ((minibuffer-local-completion-map fuel-completion--minibuffer-map)
(vocabs (fuel-completion--vocabs refresh))
(prompt "Vocabulary name: "))
(if vocabs
(completing-read prompt vocabs nil nil init-input fuel-completion--vocab-history)
(read-string prompt init-input fuel-completion--vocab-history))))
(or default (factor-symbol-at-point)))))
(defun fuel-completion--complete-symbol ()
"Complete the symbol at point.
Perform completion similar to Emacs' complete-symbol."
(interactive)
(let* ((end (point))
(beg (fuel-syntax--beginning-of-symbol-pos))
(beg (save-excursion (factor-beginning-of-symbol) (point)))
(prefix (buffer-substring-no-properties beg end))
(result (fuel-completion--complete prefix (fuel-syntax--in-using)))
(result (fuel-completion--complete prefix (factor-in-using)))
(completions (car result))
(partial (cdr result)))
(cond ((null completions)
(fuel--respecting-message "Can't find completion for %S" prefix)
(fuel-respecting-message "Can't find completion for %S" prefix)
(fuel-completion--restore-window-cfg))
(t (insert-and-inherit (substring partial (length prefix)))
(cond ((= (length completions) 1)
(fuel--respecting-message "Sole completion")
(fuel-respecting-message "Sole completion")
(fuel-completion--restore-window-cfg))
(t (fuel--respecting-message "Complete but not unique")
(t (fuel-respecting-message "Complete but not unique")
(fuel-completion--display-or-scroll completions
partial)))))))

10
misc/fuel/fuel-connection.el
View File

@ -23,8 +23,7 @@
;;; Default connection:
(make-variable-buffer-local
(defvar fuel-con--connection nil))
(defvar-local fuel-con--connection nil)
(defun fuel-con--get-connection (buffer/proc)
(if (processp buffer/proc)
@ -34,6 +33,7 @@
;;; Request and connection datatypes:
;;; TODO Replace with a defstruct
(defun fuel-con--connection-queue-request (c r)
(let ((reqs (assoc :requests c)))
(setcdr reqs (append (cdr reqs) (list r)))))
@ -66,6 +66,7 @@
(defsubst fuel-con--request-deactivated-p (req)
(null (cdr (assoc :continuation req))))
;;; TODO Replace with a defstruct
(defsubst fuel-con--make-connection (buffer)
(list :fuel-connection
(cons :requests (list))
@ -138,7 +139,7 @@
(defvar fuel-con--comint-finished-regex fuel-con--prompt-regex)
(defun fuel-con--setup-comint ()
(set (make-local-variable 'comint-redirect-insert-matching-regexp) t)
(setq-local comint-redirect-insert-matching-regexp t)
(add-hook 'comint-redirect-filter-functions
'fuel-con--comint-preoutput-filter nil t)
(add-hook 'comint-redirect-hook
@ -173,7 +174,7 @@
(progn
(setq fuel-con--comint-finished-regex
fuel-con--comint-finished-regex-connected)
(fuel-con--connection-start-timer conn)
(fuel-con--connection-start-timer fuel-con--connection)
(message "FUEL listener up and running!"))
(fuel-con--connection-clean-current-request fuel-con--connection)
(setq fuel-con--connection nil)
@ -272,4 +273,5 @@
(provide 'fuel-connection)
;;; fuel-connection.el ends here

116
misc/fuel/fuel-debug-uses.el
View File

@ -16,18 +16,28 @@
(require 'fuel-debug)
(require 'fuel-eval)
(require 'fuel-popup)
(require 'fuel-font-lock)
(require 'fuel-base)
;;; Customization:
(fuel-font-lock--defface fuel-font-lock-debug-uses-header
'bold fuel-debug "headers in Uses buffers")
;;;###autoload
(defgroup fuel-debug-uses nil
"Customization for FUEL's debug uses."
:group 'fuel)
(fuel-font-lock--defface fuel-font-lock-debug-uses-prompt
'italic fuel-debug "prompts in Uses buffers")
(defface fuel-debug-uses-header-face '((t (:inherit header)))
"Header face for FUEL's debug uses."
:group 'fuel-debug-uses
:group 'fuel-faces
:group 'faces)
(defface fuel-debug-uses-prompt-face '((t (:inherit comint-highlight-prompt)))
"Prompt face for FUEL's debug uses."
:group 'fuel-debug-uses
:group 'fuel-faces
:group 'faces)
;;; Utility functions:
@ -63,25 +73,28 @@
;;; Retrieving USINGs:
(fuel-popup--define fuel-debug--uses-buffer
"*fuel uses*" 'fuel-debug-uses-mode)
(defun fuel-debug--uses-buffer ()
(or (get-buffer "*fuel uses*")
(with-current-buffer (get-buffer-create "*fuel uses*")
(fuel-debug-uses-mode)
(fuel-popup-mode)
(current-buffer))))
(make-variable-buffer-local
(defvar fuel-debug--uses-file nil))
(defvar-local fuel-debug--uses-file nil)
(make-variable-buffer-local
(defvar fuel-debug--uses-restarts nil))
(defvar-local fuel-debug--uses-restarts nil)
(defsubst fuel-debug--uses-insert-title ()
(insert "Inferring USING: stanza for " fuel-debug--uses-file ".\n\n"))
(defun fuel-debug--uses-prepare (file)
(fuel--with-popup (fuel-debug--uses-buffer)
(setq fuel-debug--uses-file file
fuel-debug--uses nil
fuel-debug--uses-restarts nil)
(erase-buffer)
(fuel-debug--uses-insert-title)))
(with-current-buffer (fuel-debug--uses-buffer)
(let ((inhibit-read-only t))
(setq fuel-debug--uses-file file
fuel-debug--uses nil
fuel-debug--uses-restarts nil)
(erase-buffer)
(fuel-debug--uses-insert-title))))
(defun fuel-debug--uses-clean ()
(setq fuel-debug--uses-file nil
@ -90,7 +103,7 @@
(defun fuel-debug--current-usings (file)
(with-current-buffer (find-file-noselect file)
(sort (fuel-syntax--find-usings t) 'string<)))
(sort (factor-find-usings t) 'string<)))
(defun fuel-debug--uses-for-file (file)
(let* ((lines (fuel-debug--file-lines file))
@ -99,9 +112,10 @@
[ V{ ,@lines } fuel-get-uses ]
fuel-use-suggested-vocabs)) t t)))
(fuel-debug--uses-prepare file)
(fuel--with-popup (fuel-debug--uses-buffer)
(insert "Asking Factor. Please, wait ...\n")
(fuel-eval--send cmd 'fuel-debug--uses-cont))
(with-current-buffer (fuel-debug--uses-buffer)
(let ((inhibit-read-only t))
(insert "Asking Factor. Please, wait...\n")
(fuel-eval--send cmd 'fuel-debug--uses-cont)))
(fuel-popup--display (fuel-debug--uses-buffer))))
(defun fuel-debug--uses-cont (retort)
@ -116,7 +130,7 @@
(new (sort uses 'string<)))
(erase-buffer)
(fuel-debug--uses-insert-title)
(if (equalp old new)
(if (cl-equalp old new)
(progn
(insert "Current USING: is already fine!. Type 'q' to bury buffer.\n")
(fuel-debug--uses-clean))
@ -143,7 +157,7 @@
(if unique (fuel-debug--uses-restart 1)
(insert "\nPlease, type the number of the desired vocabulary:\n\n")
(dolist (r restarts)
(insert (format " :%s %s\n" (first r) (third r))))))))
(insert (format " :%s %s\n" (cl-first r) (cl-third r))))))))
(defun fuel-debug--uses-update-usings ()
(interactive)
@ -169,6 +183,27 @@
;;; Fuel uses mode:
(defconst fuel-debug--uses-header-regex
(format "^%s.*$"
(regexp-opt '("Inferring USING: stanza for "
"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 ..."
"Please, type the number of the desired vocabulary:"
"Type 'y' to update your USING: to the new one."))))
(defconst fuel-debug--uses-font-lock-keywords
`((,fuel-debug--uses-header-regex . 'fuel-debug-uses-header-face)
(,fuel-debug--uses-prompt-regex . 'fuel-debug-uses-prompt-face)
(,fuel-debug--restart-regex (1 'fuel-font-lock-debug-restart-number)
(2 'fuel-font-lock-debug-restart-name))))
(defvar fuel-debug-uses-mode-map
(let ((map (make-keymap)))
(suppress-keymap map)
@ -179,36 +214,15 @@
(define-key map "\C-c\C-c" 'fuel-debug--uses-update-usings)
map))
(defconst fuel-debug--uses-header-regex
(format "^%s.*$" (regexp-opt '("Inferring USING: stanza for "
"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 ..."
"Please, type the number of the desired vocabulary:"
"Type 'y' to update your USING: to the new one."))))
(defconst fuel-debug--uses-font-lock-keywords
`((,fuel-debug--uses-header-regex . 'fuel-font-lock-debug-uses-header)
(,fuel-debug--uses-prompt-regex . 'fuel-font-lock-debug-uses-prompt)
(,fuel-debug--restart-regex (1 'fuel-font-lock-debug-restart-number)
(2 'fuel-font-lock-debug-restart-name))))
(defun fuel-debug-uses-mode ()
"A major mode for displaying Factor's USING: inference results."
(interactive)
(kill-all-local-variables)
;;;###autoload
(define-derived-mode fuel-debug-uses-mode fundamental-mode "FUEL Uses"
"A major mode for displaying Factor's USING: inference results.
\\{fuel-debug-uses-mode-map}"
(buffer-disable-undo)
(setq major-mode 'fuel-debug-uses-mode)
(setq mode-name "Fuel Uses:")
(set (make-local-variable 'font-lock-defaults)
'(fuel-debug--uses-font-lock-keywords t nil nil nil))
(use-local-map fuel-debug-uses-mode-map))
(setq font-lock-defaults
'(fuel-debug--uses-font-lock-keywords t nil nil nil)))
(provide 'fuel-debug-uses)
;;; fuel-debug-uses.el ends here

127
misc/fuel/fuel-debug.el
View File

@ -16,13 +16,13 @@
(require 'fuel-eval)
(require 'fuel-popup)
(require 'fuel-font-lock)
(require 'fuel-menu)
(require 'fuel-base)
;;; Customization:
;;;###autoload
(defgroup fuel-debug nil
"Major mode for interaction with the Factor debugger."
:group 'fuel)
@ -43,16 +43,43 @@ the debugger."
:group 'fuel-debug
:type 'boolean)
(fuel-font-lock--define-faces
fuel-font-lock-debug font-lock fuel-debug
((error warning "highlighting errors")
(line variable-name "line numbers in errors/warnings")
(column variable-name "column numbers in errors/warnings")
(info comment "information headers")
(restart-number warning "restart numbers")
(restart-name function-name "restart names")
(missing-vocab warning"missing vocabulary names")
(unneeded-vocab warning "unneeded vocabulary names")))
(defface fuel-font-lock-debug-error '((t (:inherit font-lock-warning-face)))
"highlighting errors"
:group 'fuel-debug)
(defface fuel-font-lock-debug-line
'((t (:inherit font-lock-variable-name-face)))
"line numbers in errors/warnings"
:group 'fuel-debug)
(defface fuel-font-lock-debug-column
'((t (:inherit font-lock-variable-name-face)))
"column numbers in errors/warnings"
:group 'fuel-debug)
(defface fuel-font-lock-debug-info '((t (:inherit font-lock-comment-face)))
"information headers"
:group 'fuel-debug)
(defface fuel-font-lock-debug-restart-number
'((t (:inherit font-lock-warning-face)))
"restart numbers"
:group 'fuel-debug)
(defface fuel-font-lock-debug-restart-name
'((t (:inherit font-lock-function-name-face)))
"restart names"
:group 'fuel-debug)
(defface fuel-font-lock-debug-missing-vocab
'((t (:inherit font-lock-warning-face)))
"missing vocabulary names"
:group 'fuel-debug)
(defface fuel-font-lock-debug-unneeded-vocab
'((t (:inherit font-lock-warning-face)))
"unneeded vocabulary names"
:group 'fuel-debug)
;;; Font lock and other pattern matching:
@ -85,24 +112,21 @@ the debugger."
("^\\(Restarts?\\|Loading\\) .+$" . 'fuel-font-lock-debug-info)
("^Error: " . 'fuel-font-lock-debug-error)))
(defun fuel-debug--font-lock-setup ()
(set (make-local-variable 'font-lock-defaults)
'(fuel-debug--font-lock-keywords t nil nil nil)))
;;; Debug buffer:
(fuel-popup--define fuel-debug--buffer
"*fuel debug*" 'fuel-debug-mode)
(defun fuel-debug--buffer ()
(or (get-buffer "*fuel debug*")
(with-current-buffer (get-buffer-create "*fuel debug*")
(fuel-debug-mode)
(fuel-popup-mode)
(current-buffer))))
(make-variable-buffer-local
(defvar fuel-debug--last-ret nil))
(defvar-local fuel-debug--last-ret nil)
(make-variable-buffer-local
(defvar fuel-debug--file nil))
(defvar-local fuel-debug--file nil)
(make-variable-buffer-local
(defvar fuel-debug--uses nil))
(defvar-local fuel-debug--uses nil)
(defun fuel-debug--prepare-compilation (file msg)
(let ((inhibit-read-only t))
@ -161,9 +185,9 @@ the debugger."
(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<)))
(sort (factor-find-usings t) 'string<)))
(new (sort uses 'string<)))
(when (not (equalp old new))
(when (not (cl-equalp old new))
(fuel-debug--highlight-names old new 'fuel-font-lock-debug-unneeded-vocab)
(newline)
(fuel-debug--insert-vlist "Correct vocabulary list:" new)
@ -242,7 +266,8 @@ the debugger."
(col (or (cdr l/c) 0)))
(find-file-other-window file)
(when line
(goto-line line)
(goto-char (point-min))
(forward-line (1- line))
(when col (forward-char col)))))
(defun fuel-debug--read-restart-no ()
@ -304,7 +329,7 @@ the debugger."
(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)))
(factor-find-usings t)))
(uses (sort (append fuel-debug--uses old) 'string<)))
(fuel-popup--quit)
(fuel-debug--replace-usings file uses))))
@ -312,40 +337,32 @@ the debugger."
;;; Fuel Debug mode:
(defvar fuel-debug-mode-map
(let ((map (make-keymap)))
(suppress-keymap map)
(dotimes (n 9)
(define-key map (vector (+ ?1 n))
`(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)))))
map))
;;;###autoload
(define-derived-mode fuel-debug-mode fundamental-mode "FUEL Debug"
"A major mode for displaying Factor's compilation results and
invoking restarts as needed.
\\{fuel-debug-mode-map}"
(buffer-disable-undo)
(fuel-menu--defmenu fuel-debug fuel-debug-mode-map
(suppress-keymap fuel-debug-mode-map)
(dotimes (n 9)
(define-key fuel-debug-mode-map (vector (+ ?1 n))
`(lambda () (interactive)
(fuel-debug-exec-restart ,(1+ n) fuel-debug-confirm-restarts-p))))
(dolist (ci fuel-debug--compiler-info-alist)
(define-key fuel-debug-mode-map (vector (cdr ci))
`(lambda () (interactive) (fuel-debug-show--compiler-info ,(car ci)))))
(setq font-lock-defaults
'(fuel-debug--font-lock-keywords t nil nil nil)))
(fuel-menu--defmenu fuel-debug fuel-debug-mode-map
("Go to error" ("g" "\C-c\C-c") fuel-debug-goto-error)
("Next line" "n" next-line)
("Previous line" "p" previous-line)
("Update USINGs" "u" fuel-debug-update-usings))
(defun fuel-debug-mode ()
"A major mode for displaying Factor's compilation results and
invoking restarts as needed.
\\{fuel-debug-mode-map}"
(interactive)
(kill-all-local-variables)
(buffer-disable-undo)
(setq major-mode 'fuel-debug-mode)
(setq mode-name "Fuel Debug")
(use-local-map fuel-debug-mode-map)
(fuel-debug--font-lock-setup)
(setq fuel-debug--file nil)
(setq fuel-debug--last-ret nil)
(run-hooks 'fuel-debug-mode-hook))
(provide 'fuel-debug)
;;; fuel-debug.el ends here

31
misc/fuel/fuel-edit.el
View File

@ -16,23 +16,19 @@
(require 'fuel-completion)
(require 'fuel-eval)
(require 'fuel-base)
(require 'factor-mode)
(require 'etags)
;;; Customization
(defmacro fuel-edit--define-custom-visit (var group doc)
`(defcustom ,var nil
,doc
:group ',group
:type '(choice (const :tag "Other window" window)
(const :tag "Other frame" frame)
(const :tag "Current window" nil))))
(fuel-edit--define-custom-visit
fuel-edit-word-method fuel
"How the new buffer is opened when invoking \\[fuel-edit-word-at-point]")
(defcustom fuel-edit-word-method nil
"How the new buffer is opened when invoking `fuel-edit-word-at-point'."
:group 'fuel
:type '(choice (const :tag "Other window" window)
(const :tag "Other frame" frame)
(const :tag "Current window" nil)))
;;; Auxiliar functions:
@ -44,7 +40,7 @@
(defun fuel-edit--looking-at-vocab ()
(save-excursion
(fuel-syntax--beginning-of-defun)
(factor-beginning-of-defun)
(looking-at "USING:\\|USE:\\|IN:")))
(defun fuel-edit--try-edit (ret)
@ -55,7 +51,8 @@
(unless (file-readable-p (car loc))
(error "Couldn't open '%s' for read" (car loc)))
(fuel-edit--visit-file (car loc) fuel-edit-word-method)
(goto-line (if (numberp (cadr loc)) (cadr loc) 1))))
(goto-char (point-min))
(forward-line (1- (if (numberp (cadr loc)) (cadr loc) 1)))))
(defun fuel-edit--edit-article (name)
(let ((cmd `(:fuel* (,name fuel-get-article-location) "fuel" t)))
@ -66,6 +63,7 @@
(defvar fuel-edit--word-history nil)
;;;###autoload
(defun fuel-edit-vocabulary (&optional refresh vocab)
"Visits vocabulary file in Emacs.
When called interactively, asks for vocabulary with completion.
@ -75,6 +73,7 @@ With prefix argument, refreshes cached vocabulary list."
(cmd `(:fuel* (,vocab fuel-get-vocab-location) "fuel" t)))
(fuel-edit--try-edit (fuel-eval--send/wait cmd))))
;;;###autoload
(defun fuel-edit-word (&optional arg)
"Asks for a word to edit, with completion.
With prefix, only words visible in the current vocabulary are
@ -91,7 +90,7 @@ offered."
"Opens a new window visiting the definition of the word at point.
With prefix, asks for the word to edit."
(interactive "P")
(let* ((word (or (and (not arg) (fuel-syntax-symbol-at-point))
(let* ((word (or (and (not arg) (factor-symbol-at-point))
(fuel-completion--read-word "Edit word: ")))
(cmd `(:fuel* ((:quote ,word) fuel-get-word-location)))
(marker (and (not arg) (point-marker))))
@ -105,7 +104,7 @@ With prefix, asks for the word to edit."
With prefix, asks for the word to edit."
(interactive "P")
(let* ((word (or word
(and (not arg) (fuel-syntax-symbol-at-point))
(and (not arg) (factor-symbol-at-point))
(fuel-completion--read-word "Edit word: ")))
(cmd `(:fuel* ((:quote ,word) fuel-get-doc-location)))
(marker (and (not arg) (point-marker))))
@ -138,7 +137,7 @@ was last invoked."
(let ((buffer (completing-read "Factor buffer: "
(remove (buffer-name)
(mapcar 'buffer-name (buffer-list)))
'(lambda (s) (string-match "\\.factor$" s))
#'(lambda (s) (string-match "\\.factor$" s))
t
nil
fuel-edit--buffer-history)))

14
misc/fuel/fuel-eval.el
View File

@ -13,12 +13,12 @@
;;; Code:
(require 'fuel-syntax)
(require 'fuel-connection)
(require 'fuel-log)
(require 'fuel-base)
(require 'factor-mode)
(eval-when-compile (require 'cl))
(require 'cl-lib)
;;; Simple sexp-based representation of factor code
@ -29,7 +29,7 @@
((or (stringp sexp) (numberp sexp)) (format "%S" sexp))
((vectorp sexp) (factor (cons :quotation (append sexp nil))))
((listp sexp)
(case (car sexp)
(cl-case (car sexp)
(:array (factor--seq 'V{ '} (cdr sexp)))
(:seq (factor--seq '{ '} (cdr sexp)))
(:tuple (factor--seq 'T{ '} (cdr sexp)))
@ -41,11 +41,11 @@
(:fuel* (factor--fuel-factor (cons :nrs (cdr sexp))))
(t (mapconcat 'factor sexp " "))))
((keywordp sexp)
(factor (case sexp
(factor (cl-case sexp
(:rs 'fuel-eval-restartable)
(:nrs 'fuel-eval-non-restartable)
(:in (or (fuel-syntax--current-vocab) "fuel"))
(:usings `(:array ,@(fuel-syntax--usings)))
(:in (or (factor-current-vocab) "fuel"))
(:usings `(:array ,@(factor-usings)))
(:get 'fuel-eval-set-result)
(:end '\;)
(t `(:factor ,(symbol-name sexp))))))
@ -98,7 +98,7 @@
(setq fuel-eval--sync-retort nil)
(fuel-con--send-string/wait (or fuel-eval--proc (fuel-eval--default-proc))
(if (stringp code) code (factor code))
'(lambda (s)
#'(lambda (s)
(setq fuel-eval--sync-retort
(fuel-eval--parse-retort s)))
timeout

186
misc/fuel/fuel-font-lock.el
View File

@ -1,186 +0,0 @@
;;; fuel-font-lock.el -- font lock for factor code
;; 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>
;; Keywords: languages, fuel, factor
;; Start date: Wed Dec 03, 2008 21:40
;;; Comentary:
;; Font lock setup for highlighting Factor code.
;;; Code:
(require 'fuel-syntax)
(require 'fuel-base)
(require 'font-lock)
;;; Faces:
(defgroup fuel-faces nil
"Faces used by FUEL."
:group 'fuel
:group 'faces)
(defmacro fuel-font-lock--defface (face def group doc)
`(defface ,face (face-default-spec ,def)
,(format "Face for %s." doc)
:group ',group
:group 'fuel-faces
:group 'faces))
(put 'fuel-font-lock--defface 'lisp-indent-function 1)
(defmacro fuel-font-lock--make-face (prefix def-prefix group face def doc)
(let ((face (intern (format "%s-%s" prefix face)))
(def (intern (format "%s-%s-face" def-prefix def))))
`(fuel-font-lock--defface ,face ,def ,group ,doc)))
(defmacro fuel-font-lock--define-faces (prefix def-prefix group faces)
(let ((setup (make-symbol (format "%s--faces-setup" prefix))))
`(progn
(defmacro ,setup ()
(cons 'progn
(mapcar (lambda (f) (append '(fuel-font-lock--make-face
,prefix ,def-prefix ,group) f))
',faces)))
(,setup))))
(fuel-font-lock--define-faces
factor-font-lock font-lock factor-mode
((comment comment "comments")
(constructor type "constructors (<foo>)")
(constant constant "constants and literal values")
(number constant "integers and floats")
(ratio constant "ratios")
(declaration keyword "declaration words")
(ebnf-form constant "EBNF: ... ;EBNF form")
(error-form warning "ERROR: ... ; form")
(parsing-word keyword "parsing words")
(postpone-body comment "postponed form")
(setter-word function-name "setter words (>>foo)")
(getter-word function-name "getter words (foo>>)")
(stack-effect comment "stack effect specifications")
(string string "strings")
(symbol variable-name "name of symbol being defined")
(type-name type "type names")
(vocabulary-name constant "vocabulary names")
(word function-name "word, generic or method being defined")
(invalid-syntax warning "syntactically invalid constructs")))
;;; Font lock:
(defun fuel-font-lock--syntactic-face (state)
(if (nth 3 state) 'factor-font-lock-string
(let ((c (char-after (nth 8 state))))
(cond ((memq c '(?\ ?\n ?E ?P))
(save-excursion
(goto-char (nth 8 state))
(beginning-of-line)
(cond ((looking-at "E") 'factor-font-lock-ebnf-form)
((looking-at "P") 'factor-font-lock-postpone-body)
((looking-at-p "USING: ")
'factor-font-lock-vocabulary-name)
((looking-at-p
"\\(TUPLE\\|SYMBOLS\\|VARS\\|SINGLETONS\\):")
'factor-font-lock-symbol)
((looking-at-p "C-ENUM:\\( \\|\n\\)")
'factor-font-lock-constant)
(t 'default))))
((or (char-equal c ?U) (char-equal c ?C))
'factor-font-lock-parsing-word)
((char-equal c ?\") 'factor-font-lock-string)
(t 'factor-font-lock-comment)))))
(defconst fuel-font-lock--font-lock-keywords
`((,fuel-syntax--stack-effect-regex . 'factor-font-lock-stack-effect)
(,fuel-syntax--brace-words-regex 1 'factor-font-lock-parsing-word)
(,fuel-syntax--alien-function-regex (1 'factor-font-lock-type-name)
(2 'factor-font-lock-word))
(,fuel-syntax--alien-function-alias-regex (1 'factor-font-lock-word)
(2 'factor-font-lock-type-name)
(3 'factor-font-lock-word))
(,fuel-syntax--alien-callback-regex (1 'factor-font-lock-type-name)
(2 'factor-font-lock-word))
(,fuel-syntax--vocab-ref-regexp 2 'factor-font-lock-vocabulary-name)
(,fuel-syntax--constructor-decl-regex
(1 'factor-font-lock-word)
(2 'factor-font-lock-type-name)
(3 'factor-font-lock-invalid-syntax nil t))
(,fuel-syntax--typedef-regex (1 'factor-font-lock-type-name)
(2 'factor-font-lock-type-name)
(3 'factor-font-lock-invalid-syntax nil t))
(,fuel-syntax--c-global-regex (1 'factor-font-lock-type-name)
(2 'factor-font-lock-word)
(3 'factor-font-lock-invalid-syntax nil t))
(,fuel-syntax--c-type-regex (1 'factor-font-lock-type-name)
(2 'factor-font-lock-invalid-syntax nil t))
(,fuel-syntax--rename-regex (1 'factor-font-lock-word)
(2 'factor-font-lock-vocabulary-name)
(3 'factor-font-lock-word)
(4 'factor-font-lock-invalid-syntax nil t))
(,fuel-syntax--declaration-words-regex . 'factor-font-lock-declaration)
(,fuel-syntax--word-definition-regex 2 'factor-font-lock-word)
(,fuel-syntax--alias-definition-regex (1 'factor-font-lock-word)
(2 'factor-font-lock-word))
(,fuel-syntax--int-constant-def-regex 2 'factor-font-lock-constant)
(,fuel-syntax--integer-regex . 'factor-font-lock-number)
(,fuel-syntax--float-regex . 'factor-font-lock-number)
(,fuel-syntax--ratio-regex . 'factor-font-lock-ratio)
(,fuel-syntax--type-definition-regex 2 'factor-font-lock-type-name)
(,fuel-syntax--error-regex 2 'factor-font-lock-error-form)
(,fuel-syntax--method-definition-regex (1 'factor-font-lock-type-name)
(2 'factor-font-lock-word))
(,fuel-syntax--before-definition-regex (1 'factor-font-lock-type-name)
(2 'factor-font-lock-word))
(,fuel-syntax--after-definition-regex (1 'factor-font-lock-type-name)
(2 'factor-font-lock-word))
(,fuel-syntax--tuple-decl-regex 2 'factor-font-lock-type-name)
(,fuel-syntax--constructor-regex . 'factor-font-lock-constructor)
(,fuel-syntax--setter-regex . 'factor-font-lock-setter-word)
(,fuel-syntax--getter-regex . 'factor-font-lock-getter-word)
(,fuel-syntax--symbol-definition-regex 2 'factor-font-lock-symbol)
(,fuel-syntax--bad-string-regex . 'factor-font-lock-invalid-syntax)
("\\_<\\(P\\|SBUF\\|DLL\\)\"" 1 'factor-font-lock-parsing-word)
(,fuel-syntax--parsing-words-regex . 'factor-font-lock-parsing-word)))
(defun fuel-font-lock--font-lock-setup (&optional keywords no-syntax)
(set (make-local-variable 'comment-start) "! ")
(set (make-local-variable 'parse-sexp-lookup-properties) t)
(set (make-local-variable 'font-lock-defaults)
`(,(or keywords 'fuel-font-lock--font-lock-keywords)
nil nil nil nil
,@(if no-syntax nil
(list (cons 'font-lock-syntactic-keywords
fuel-syntax--syntactic-keywords)
(cons 'font-lock-syntactic-face-function
'fuel-font-lock--syntactic-face))))))
;;; Fontify strings as Factor code:
(defun fuel-font-lock--font-lock-buffer ()
(let ((name " *fuel font lock*"))
(or (get-buffer name)
(let ((buffer (get-buffer-create name)))
(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

77
misc/fuel/fuel-help.el
View File

@ -19,17 +19,17 @@
(require 'fuel-markup)
(require 'fuel-autodoc)
(require 'fuel-completion)
(require 'fuel-syntax)
(require 'fuel-font-lock)
(require 'fuel-popup)
(require 'fuel-menu)
(require 'fuel-base)
(require 'factor-mode)
(require 'button)
;;; Customization:
;;;###autoload
(defgroup fuel-help nil
"Options controlling FUEL's help system."
:group 'fuel)
@ -103,17 +103,19 @@
;;; Fuel help buffer and internals:
(fuel-popup--define fuel-help--buffer
"*fuel help*" 'fuel-help-mode)
(defun fuel-help--buffer ()
(or (get-buffer "*fuel help*")
(with-current-buffer (get-buffer-create "*fuel help*")
(fuel-help-mode)
(fuel-popup-mode)
(current-buffer))))
(defvar fuel-help--prompt-history nil)
(make-local-variable
(defvar fuel-help--buffer-link nil))
(defvar-local fuel-help--buffer-link nil)
(defun fuel-help--read-word (see)
(let* ((def (fuel-syntax-symbol-at-point))
(let* ((def (factor-symbol-at-point))
(prompt (format "See%s help on%s: " (if see " short" "")
(if def (format " (%s)" def) "")))
(ask (or (not def) fuel-help-always-ask)))
@ -124,17 +126,20 @@
t)
def)))
(defun fuel-help--word-help (&optional see word)
(defun fuel-help--word-help (&optional see word display-only)
(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)
(when (called-interactively-p 'any)
(message "Looking up '%s' ..." def))
(let* ((ret (fuel-eval--send/wait cmd))
(res (fuel-eval--retort-result ret)))
(if (not res)
(message "No help for '%s'" def)
(fuel-help--insert-contents (list def def 'word) res)))))))
(when (called-interactively-p 'any)
(message "No help for '%s'" def))
(fuel-help--insert-contents
(list def def 'word) res display-only)))))))
(defun fuel-help--get-article (name label)
(message "Retrieving article ...")
@ -191,25 +196,23 @@
(t (error "Links of type %s not yet implemented" type))))
(fuel-help--insert-contents llink cached))))
(defun fuel-help--insert-contents (key content)
(defun fuel-help--insert-contents (key content &optional display-only)
(let ((hb (fuel-help--buffer))
(inhibit-read-only t)
(font-lock-verbose nil))
(set-buffer hb)
(erase-buffer)
(if (stringp content)
(insert content)
(fuel-markup--print content)
(fuel-markup--insert-newline)
(delete-blank-lines)
(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 "")))
(with-current-buffer hb
(erase-buffer)
(if (stringp content)
(insert content)
(fuel-markup--print content)
(fuel-markup--insert-newline)
(delete-blank-lines)
(fuel-help--cache-insert key (buffer-string)))
(fuel-help--history-push key)
(setq fuel-help--buffer-link key)
(set-buffer-modified-p nil)
(goto-char (point-min))
(fuel-popup--display nil display-only))))
;;; Bookmarks:
@ -345,7 +348,7 @@ With prefix, the current page is deleted from history."
(defun fuel-help--find-in ()
(save-excursion
(or (fuel-syntax--find-in)
(or (factor-find-in)
(and (goto-char (point-min))
(re-search-forward "Vocabulary: \\(.+\\)$" nil t)
(match-string-no-properties 1)))))
@ -353,19 +356,13 @@ With prefix, the current page is deleted from history."
;;; Help mode definition:
(defun fuel-help-mode ()
;;;###autoload
(define-derived-mode fuel-help-mode special-mode "FUEL Help"
"Major mode for browsing Factor documentation.
\\{fuel-help-mode-map}"
(interactive)
(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)
(setq fuel-syntax--current-vocab-function 'fuel-help--find-in)
(setq fuel-markup--follow-link-function 'fuel-help--follow-link)
(setq buffer-read-only t))
:syntax-table factor-mode-syntax-table
(setq factor-current-vocab-function 'fuel-help--find-in)
(setq fuel-markup--follow-link-function 'fuel-help--follow-link))
(provide 'fuel-help)

101
misc/fuel/fuel-listener.el
View File

@ -15,10 +15,8 @@
(require 'fuel-stack)
(require 'fuel-completion)
(require 'fuel-xref)
(require 'fuel-eval)
(require 'fuel-connection)
(require 'fuel-syntax)
(require 'fuel-menu)
(require 'fuel-base)
@ -27,23 +25,23 @@
;;; Customization:
;;;###autoload
(defgroup fuel-listener nil
"Interacting with a Factor listener inside Emacs."
:group 'fuel)
(defcustom fuel-listener-factor-binary
(expand-file-name (cond ((eq system-type 'windows-nt)
"factor.com")
((eq system-type 'darwin)
"Factor.app/Contents/MacOS/factor")
(t "factor"))
fuel-factor-root-dir)
(defcustom fuel-factor-root-dir nil
"Full path to the factor root directory when starting a listener."
:type 'directory
:group 'fuel-listener)
;;; Is factor.com still valid on Windows...?
(defcustom fuel-listener-factor-binary nil
"Full path to the factor executable to use when starting a listener."
:type '(file :must-match t)
:group 'fuel-listener)
(defcustom fuel-listener-factor-image
(expand-file-name "factor.image" fuel-factor-root-dir)
(defcustom fuel-listener-factor-image nil
"Full path to the factor image to use when starting a listener."
:type '(file :must-match t)
:group 'fuel-listener)
@ -60,8 +58,10 @@ buffer."
:type 'boolean
:group 'fuel-listener)
(defcustom fuel-listener-history-filename (expand-file-name "~/.fuel_history")
"File where listener input history is saved, so that it persists between sessions."
(defcustom fuel-listener-history-filename
(expand-file-name "~/.fuel_history.eld")
"File where listener input history is saved, so that it persists between
sessions."
:type 'filename
:group 'fuel-listener)
@ -75,6 +75,24 @@ buffer."
:type 'boolean
:group 'fuel-listener)
;;; Factor paths:
(defun fuel-listener-factor-binary ()
"Full path to the factor executable to use when starting a listener."
(or fuel-listener-factor-binary
(expand-file-name (cond ((eq system-type 'windows-nt)
"factor.com")
((eq system-type 'darwin)
"Factor.app/Contents/MacOS/factor")
(t "factor"))
fuel-factor-root-dir)))
(defun fuel-listener-factor-image ()
"Full path to the factor image to use when starting a listener."
(or fuel-listener-factor-image
(expand-file-name "factor.image" fuel-factor-root-dir)))
;;; Listener history:
@ -88,10 +106,8 @@ buffer."
(insert "Press C-c C-z to bring me back.\n" ))))))
(defun fuel-listener--history-setup ()
(set (make-local-variable 'comint-input-ring-file-name)
fuel-listener-history-filename)
(set (make-local-variable 'comint-input-ring-size)
fuel-listener-history-size)
(setq-local comint-input-ring-file-name fuel-listener-history-filename)
(setq-local comint-input-ring-size fuel-listener-history-size)
(add-hook 'kill-buffer-hook 'comint-write-input-ring nil t)
(comint-read-input-ring t)
(set-process-sentinel (get-buffer-process (current-buffer))
@ -111,8 +127,8 @@ buffer."
(setq fuel-listener--buffer (current-buffer)))))
(defun fuel-listener--start-process ()
(let ((factor (expand-file-name fuel-listener-factor-binary))
(image (expand-file-name fuel-listener-factor-image))
(let ((factor (expand-file-name (fuel-listener-factor-binary)))
(image (expand-file-name (fuel-listener-factor-image)))
(comint-redirect-perform-sanity-check nil))
(unless (file-executable-p factor)
(error "Could not run factor: %s is not executable" factor))
@ -126,6 +142,7 @@ buffer."
(fuel-listener--history-setup)
(fuel-con--setup-connection (current-buffer))))
;;; TODO Add the ability to debug to non-localhost
(defun fuel-listener--connect-process (port)
(message "Connecting to remote listener ...")
(pop-to-buffer (fuel-listener--buffer))
@ -157,12 +174,9 @@ buffer."
(goto-char (point-max))
(unless seen (error "No prompt found!"))))
;;; Interface: starting and interacting with fuel listener:
(defalias 'switch-to-factor 'run-factor)
(defalias 'switch-to-fuel-listener 'run-factor)
;;;###autoload
(defun run-factor (&optional arg)
"Show the fuel-listener buffer, starting the process if needed."
@ -171,8 +185,10 @@ buffer."
(pop-up-windows fuel-listener-window-allow-split))
(if fuel-listener-use-other-window
(pop-to-buffer buf)
(switch-to-buffer buf))))
(switch-to-buffer buf))
(add-hook 'factor-mode-hook 'fuel-mode)))
;;;###autoload
(defun connect-to-factor (&optional arg)
"Connects to a remote listener running in the same host.
Without prefix argument, the default port, 9000, is used.
@ -182,7 +198,8 @@ remote listener you need to issue the words
fuel-start-remote-listener', from the fuel vocabulary."
(interactive "P")
(let ((port (if (not arg) 9000 (read-number "Port: "))))
(fuel-listener--connect-process port)))
(fuel-listener--connect-process port)
(add-hook 'factor-mode-hook 'fuel-mode)))
(defun fuel-listener-nuke ()
"Try this command if the listener becomes unresponsive."
@ -192,42 +209,44 @@ fuel-start-remote-listener', from the fuel vocabulary."
(comint-redirect-cleanup)
(fuel-con--setup-connection fuel-listener--buffer))
(defun fuel-refresh-all ()
(defun fuel-refresh-all (&optional arg)
"Switch to the listener buffer and invokes Factor's refresh-all.
With prefix, you're teletransported to the listener's buffer."
(interactive)
(interactive "P")
(let ((buf (process-buffer (fuel-listener--process))))
(pop-to-buffer buf)
(comint-send-string nil "\"Refreshing loaded vocabs...\" write nl flush")
(comint-send-string nil " refresh-all \"Done!\" write nl flush\n")))
(with-current-buffer buf
(comint-send-string nil "\"Refreshing loaded vocabs...\" write nl flush")
(comint-send-string nil " refresh-all \"Done!\" write nl flush\n"))
(when arg (pop-to-buffer buf))))
(defun fuel-test-vocab (&optional arg)
"Run the unit tests for the current vocabulary. With prefix argument, ask for
the vocabulary name."
(interactive "P")
(let* ((vocab (or (and (not arg) (fuel-syntax--current-vocab))
(let* ((vocab (or (and (not arg) (factor-current-vocab))
(fuel-completion--read-vocab nil))))
(comint-send-string (fuel-listener--process)
(concat "\"" vocab "\" reload nl flush\n"
"\"" vocab "\" test nl flush\n"))))
;;; Completion support
;;; Completion support:
(defsubst fuel-listener--current-vocab () nil)
(defsubst fuel-listener--usings () nil)
(defun fuel-listener--setup-completion ()
(setq fuel-syntax--current-vocab-function 'fuel-listener--current-vocab)
(setq fuel-syntax--usings-function 'fuel-listener--usings))
(setq factor-current-vocab-function 'fuel-listener--current-vocab)
(setq factor-usings-function 'fuel-listener--usings))
;;; Stack mode support
;;; Stack mode support:
(defun fuel-listener--stack-region ()
(fuel--region-to-string (if (zerop (fuel-syntax--brackets-depth))
(comint-line-beginning-position)
(1+ (fuel-syntax--brackets-start)))))
(fuel-region-to-string
(if (zerop (factor-brackets-depth))
(comint-line-beginning-position)
(1+ (factor-brackets-start)))))
(defun fuel-listener--setup-stack-mode ()
(setq fuel-stack--region-function 'fuel-listener--stack-region))
@ -243,10 +262,9 @@ the vocabulary name."
(define-derived-mode fuel-listener-mode comint-mode "Fuel Listener"
"Major mode for interacting with an inferior Factor listener process.
\\{fuel-listener-mode-map}"
(set (make-local-variable 'comint-prompt-regexp) fuel-con--prompt-regex)
(set (make-local-variable 'comint-use-prompt-regexp) nil)
(set (make-local-variable 'comint-prompt-read-only)
fuel-listener-prompt-read-only-p)
(setq-local comint-prompt-regexp fuel-con--prompt-regex)
(setq-local comint-use-prompt-regexp nil)
(setq-local comint-prompt-read-only fuel-listener-prompt-read-only-p)
(fuel-listener--setup-completion)
(fuel-listener--setup-stack-mode))
@ -271,4 +289,5 @@ the vocabulary name."
(provide 'fuel-listener)
;;; fuel-listener.el ends here

10
misc/fuel/fuel-log.el
View File

@ -37,11 +37,11 @@
(defvar fuel-log--debug-p nil
"If t, all messages are logged no matter what")
;;;###autoload
(define-derived-mode factor-messages-mode fundamental-mode "FUEL Messages"
"Simple mode to log interactions with the factor listener"
(kill-all-local-variables)
(buffer-disable-undo)
(set (make-local-variable 'comint-redirect-subvert-readonly) t)
(setq-local comint-redirect-subvert-readonly t)
(add-hook 'after-change-functions
'(lambda (b e len)
(let ((inhibit-read-only t))
@ -52,8 +52,7 @@
(defun fuel-log--buffer ()
(or (get-buffer fuel-log--buffer-name)
(save-current-buffer
(set-buffer (get-buffer-create fuel-log--buffer-name))
(with-current-buffer (get-buffer-create fuel-log--buffer-name)
(factor-messages-mode)
(current-buffer))))
@ -62,7 +61,7 @@
(with-current-buffer (fuel-log--buffer)
(let ((inhibit-read-only t))
(insert
(fuel--shorten-str (format "\n%s: %s\n" type (apply 'format args))
(fuel-shorten-str (format "\n%s: %s\n" type (apply 'format args))
fuel-log--max-message-size))))))
(defsubst fuel-log--warn (&rest args)
@ -77,4 +76,5 @@
(provide 'fuel-log)
;;; fuel-log.el ends here

67
misc/fuel/fuel-markup.el
View File

@ -14,7 +14,6 @@
;;; Code:
(require 'fuel-eval)
(require 'fuel-font-lock)
(require 'fuel-base)
(require 'fuel-table)
@ -23,26 +22,40 @@
;;; Customization:
(fuel-font-lock--defface fuel-font-lock-markup-title
'bold fuel-help "article titles in help buffers")
(defface fuel-font-lock-markup-title '((t (:inherit bold)))
"article titles in help buffers"
:group 'fuel-help
:group 'fuel-faces
:group 'faces)
(fuel-font-lock--defface fuel-font-lock-markup-heading
'bold fuel-help "headlines in help buffers")
(defface fuel-font-lock-markup-heading '((t (:inherit bold)))
"headlines in help buffers"
:group 'fuel-help
:group 'fuel-faces
:group 'faces)
(fuel-font-lock--defface fuel-font-lock-markup-link
'link fuel-help "links to topics in help buffers")
(defface fuel-font-lock-markup-link '((t (:inherit link)))
"links to topics in help buffers"
:group 'fuel-help
:group 'fuel-faces
:group 'faces)
(fuel-font-lock--defface fuel-font-lock-markup-emphasis
'italic fuel-help "emphasized words in help buffers")
(defface fuel-font-lock-markup-emphasis '((t (:inherit italic)))
"emphasized words in help buffers"
:group 'fuel-help
:group 'fuel-faces
:group 'faces)
(fuel-font-lock--defface fuel-font-lock-markup-strong
'link fuel-help "bold words in help buffers")
(defface fuel-font-lock-markup-strong '((t (:inherit link)))
"bold words in help buffers"
:group 'fuel-help
:group 'fuel-faces
:group 'faces)
;;; Links:
(make-variable-buffer-local
(defvar fuel-markup--follow-link-function 'fuel-markup--echo-link))
(defvar-local fuel-markup--follow-link-function 'fuel-markup--echo-link)
(define-button-type 'fuel-markup--button
'action 'fuel-markup--follow-link
@ -154,8 +167,7 @@
(describe-words . fuel-markup--describe-words)
(vocab-list . fuel-markup--vocab-list)))
(make-variable-buffer-local
(defvar fuel-markup--maybe-nl nil))
(defvar-local fuel-markup--maybe-nl nil)
(defun fuel-markup--print (e)
(cond ((null e) (insert "f"))
@ -228,7 +240,7 @@
(defun fuel-markup--subsections (e)
(dolist (link (cdr e))
(fuel-markup--insert-nl-if-nb)
(insert " - ")
(insert " - ")
(fuel-markup--link (list '$link link))
(fuel-markup--maybe-nl)))
@ -248,7 +260,7 @@
(dolist (art (cdr e))
(fuel-markup--insert-button (car art) (cadr art) 'article)
(insert ", "))
(delete-backward-char 2)
(delete-char -2)
(fuel-markup--insert-newline 'left))
(defun fuel-markup--emphasis (e)
@ -262,9 +274,9 @@
(insert (cadr e))))
(defun fuel-markup--snippet (e)
(insert (mapconcat '(lambda (s)
(insert (mapconcat #'(lambda (s)
(if (stringp s)
(fuel-font-lock--factor-str s)
(factor-font-lock-string s)
(fuel-markup--print-str s)))
(cdr e)
" ")))
@ -274,7 +286,7 @@
(newline)
(dolist (snip (cdr e))
(if (stringp snip)
(insert (fuel-font-lock--factor-str snip))
(insert (factor-font-lock-string snip))
(fuel-markup--print snip))
(newline))
(newline))
@ -311,10 +323,10 @@
(dolist (link (cdr e))
(fuel-markup--link (list '$link link))
(insert ", "))
(delete-backward-char 2))
(delete-char -2))
(defun fuel-markup--index-quotation (q)
(cond ((null q) null)
(cond ((null q) nil)
((listp q) (vconcat (mapcar 'fuel-markup--index-quotation q)))
(t q)))
@ -342,7 +354,7 @@
(insert " ")))
(defun fuel-markup--vocab-list (e)
(let ((rows (mapcar '(lambda (elem)
(let ((rows (mapcar #'(lambda (elem)
(list (list '$vocab-link (car elem))
(cadr elem)))
(cdr e))))
@ -374,7 +386,7 @@
(super (and (cadr objs)
(list (list '$link (cadr objs) (cadr objs) 'word))))
(slots (when (cddr objs)
(list (mapcar '(lambda (s) (list s " ")) (cddr objs))))))
(list (mapcar #'(lambda (s) (list s " ")) (cddr objs))))))
(push `(,class ,@super ,@slots) rows))
(forward-line))
(push `(,heading ($table ,@(reverse rows))) elems))
@ -426,7 +438,7 @@
(dolist (tag (cdr e))
(fuel-markup--tag (list '$tag tag))
(insert ", "))
(delete-backward-char 2)
(delete-char -2)
(fuel-markup--insert-newline)))
(defun fuel-markup--all-tags (e)
@ -444,7 +456,7 @@
(dolist (a (cdr e))
(fuel-markup--author (list '$author a))
(insert ", "))
(delete-backward-char 2)
(delete-char -2)
(fuel-markup--insert-newline)))
(defun fuel-markup--all-authors (e)
@ -465,7 +477,7 @@
(delete-blank-lines)
(newline)
(fuel-table--insert
(mapcar '(lambda (row) (mapcar 'fuel-markup--print-str row)) (cdr e)))
(mapcar #'(lambda (row) (mapcar 'fuel-markup--print-str row)) (cdr e)))
(newline))
(defun fuel-markup--instance (e)
@ -620,4 +632,5 @@
(provide 'fuel-markup)
;;; fuel-markup.el ends here

6
misc/fuel/fuel-menu.el
View File

@ -82,6 +82,7 @@
:button (:toggle . (and (boundp ',mode) ,mode)))))
(defmacro fuel-menu--defmenu (name keymap &rest keys)
(declare (indent 2))
(let ((mmap (make-symbol "mmap")))
`(progn
(let ((,mmap (make-sparse-keymap "FUEL")))
@ -93,10 +94,7 @@
(fuel-menu--add-items ,keymap ,mmap ,keys)
,mmap))))
(put 'fuel-menu--defmenu 'lisp-indent-function 2)
(provide 'fuel-menu)
;;; fuel-menu.el ends here
;;; fuel-menu.el ends here

47
misc/fuel/fuel-mode.el
View File

@ -14,6 +14,7 @@
;;; Code:
(require 'fuel-base)
(require 'fuel-listener)
(require 'fuel-completion)
(require 'fuel-debug)
@ -24,15 +25,14 @@
(require 'fuel-refactor)
(require 'fuel-stack)
(require 'fuel-autodoc)
(require 'fuel-font-lock)
(require 'fuel-autohelp)
(require 'fuel-edit)
(require 'fuel-syntax)
(require 'fuel-menu)
(require 'fuel-base)
;;; Customization:
;;;###autoload
(defgroup fuel-mode nil
"Mode enabling FUEL's ultimate abilities."
:group 'fuel)
@ -43,6 +43,12 @@
:group 'fuel-autodoc
:type 'boolean)
(defcustom fuel-mode-autohelp-p nil
"Whether `fuel-autohelp-mode' gets enabled by default in factor buffers."
:group 'fuel-mode
:group 'fuel-autohelp
:type 'boolean)
(defcustom fuel-mode-stack-p nil
"Whether `fuel-stack-mode' gets enabled by default in factor buffers."
:group 'fuel-mode
@ -52,17 +58,6 @@
;;; User commands
(defun fuel-mode--read-file (arg)
(let* ((file (or (and arg (read-file-name "File: " nil (buffer-file-name) t))
(buffer-file-name)))
(file (expand-file-name file))
(buffer (find-file-noselect file)))
(when (and buffer
(buffer-modified-p buffer)
(y-or-n-p "Save file? "))
(save-buffer buffer))
(cons file buffer)))
(defun fuel-run-file (&optional arg)
"Sends the current file to Factor for compilation.
With prefix argument, ask for the file to run."
@ -93,14 +88,14 @@ buffer in case of errors."
"[\f\n\r\v]+"
t))
(cmd `(:fuel (,(mapcar (lambda (l) `(:factor ,l)) lines))))
(cv (fuel-syntax--current-vocab)))
(cv (factor-current-vocab)))
(fuel-debug--prepare-compilation (buffer-file-name)
(format "Evaluating:\n\n%s" rstr))
(fuel-debug--display-retort
(fuel-eval--send/wait cmd 10000)
(format "%s%s"
(if cv (format "IN: %s " cv) "")
(fuel--shorten-region begin end 70))
(fuel-shorten-region begin end 70))
arg)))
(defun fuel-eval-extended-region (begin end &optional arg)
@ -125,14 +120,6 @@ buffer in case of errors."
(unless (< begin end) (error "No evaluable definition around point"))
(fuel-eval-region begin end arg))))
(defun fuel-update-usings (&optional arg)
"Asks factor for the vocabularies needed by this file,
optionally updating the its USING: line.
With prefix argument, ask for the file name."
(interactive "P")
(let ((file (car (fuel-mode--read-file arg))))
(when file (fuel-debug--uses-for-file file))))
(defun fuel-load-usings ()
"Loads all vocabularies in the current buffer's USING: from.
Useful to activate autodoc help messages in a vocabulary not yet
@ -148,13 +135,13 @@ for details."
;;; Minor mode definition:
(make-variable-buffer-local
(defvar fuel-mode-string " F"
"Modeline indicator for fuel-mode"))
(defvar-local fuel-mode-string " F"
"Modeline indicator for fuel-mode")
(defvar fuel-mode-map (make-sparse-keymap)
"Key map for fuel-mode")
;;;###autoload
(define-minor-mode fuel-mode
"Toggle Fuel's mode.
With no argument, this command toggles the mode.
@ -172,6 +159,9 @@ interacting with a factor listener is at your disposal.
(setq fuel-autodoc-mode-string "/A")
(when fuel-mode-autodoc-p (fuel-autodoc-mode fuel-mode))
(setq fuel-autohelp-mode-string "/H")
(when fuel-mode-autohelp-p (fuel-autohelp-mode fuel-mode))
(setq fuel-stack-mode-string "/S")
(when fuel-mode-stack-p (fuel-stack-mode fuel-mode))
@ -234,7 +224,7 @@ interacting with a factor listener is at your disposal.
--
(menu "Switch to"
("Listener" "\C-c\C-z" run-factor)
("Related Factor file" "\C-c\C-o" factor-mode-visit-other-file)
("Related Factor file" "\C-c\C-o" factor-visit-other-file)
("Other Factor buffer" "\C-c\C-s" fuel-switch-to-buffer)
("Other Factor buffer other window" "\C-x4s"
fuel-switch-to-buffer-other-window)
@ -243,4 +233,5 @@ interacting with a factor listener is at your disposal.
(provide 'fuel-mode)
;;; fuel-mode.el ends here

3
misc/fuel/fuel-pkg.el
View File

@ -1,3 +0,0 @@
(define-package "fuel" "1.0"
"Factor's Ultimate Emacs Library"
nil)

36
misc/fuel/fuel-popup.el
View File

@ -14,24 +14,23 @@
;;; Code:
(make-variable-buffer-local
(defvar fuel-popup--created-window nil))
(defvar-local fuel-popup--created-window nil)
(make-variable-buffer-local
(defvar fuel-popup--selected-window nil))
(defvar-local fuel-popup--selected-window nil)
(defun fuel-popup--display (&optional buffer)
(defun fuel-popup--display (&optional buffer display-only)
(when buffer (set-buffer buffer))
(let ((selected-window (selected-window))
(buffer (current-buffer)))
(unless (eq selected-window (get-buffer-window buffer))
(let ((windows))
(walk-windows (lambda (w) (push w windows)) nil t)
(prog1 (pop-to-buffer buffer)
(set (make-local-variable 'fuel-popup--created-window)
(prog1 (if display-only
(display-buffer buffer)
(pop-to-buffer buffer))
(setq-local fuel-popup--created-window
(unless (memq (selected-window) windows) (selected-window)))
(set (make-local-variable 'fuel-popup--selected-window)
selected-window))))))
(setq-local fuel-popup--selected-window selected-window))))))
(defun fuel-popup--quit ()
(interactive)
@ -41,29 +40,14 @@
(when (eq created (selected-window)) (delete-window created))
(when (window-live-p selected) (select-window selected))))
;;;###autoload
(define-minor-mode fuel-popup-mode
"Mode for displaying read only stuff"
nil nil
'(("q" . fuel-popup--quit))
(setq buffer-read-only t))
(defmacro fuel-popup--define (fun name mode)
`(defun ,fun ()
(or (get-buffer ,name)
(with-current-buffer (get-buffer-create ,name)
(funcall ,mode)
(fuel-popup-mode)
(current-buffer)))))
(put 'fuel-popup--define 'lisp-indent-function 1)
(defmacro fuel--with-popup (buffer &rest body)
`(with-current-buffer ,buffer
(let ((inhibit-read-only t))
,@body)))
(put 'fuel--with-popup 'lisp-indent-function 1)
(provide 'fuel-popup)
;;; fuel-popup.el ends here

57
misc/fuel/fuel-refactor.el
View File

@ -13,10 +13,12 @@
;;; Code:
(require 'fuel-base)
(require 'fuel-scaffold)
(require 'fuel-stack)
(require 'fuel-syntax)
(require 'fuel-base)
(require 'fuel-xref)
(require 'fuel-debug-uses)
(require 'factor-mode)
(require 'etags)
@ -25,12 +27,12 @@
(defconst fuel-refactor--next-defun-regex
(format "^\\(:\\|MEMO:\\|MACRO:\\):? +\\(\\w+\\)\\(%s\\)\\([^;]+?\\) ;\\_>"
fuel-syntax--stack-effect-regex))
factor-stack-effect-regex))
(defun fuel-refactor--previous-defun ()
(let ((pos) (result))
(while (and (not result)
(setq pos (fuel-syntax--beginning-of-defun)))
(setq pos (factor-beginning-of-defun)))
(setq result (looking-at fuel-refactor--next-defun-regex)))
(when (and result pos)
(let ((name (match-string-no-properties 2))
@ -79,9 +81,9 @@
(and result found))))
(defsubst fuel-refactor--insertion-point ()
(max (save-excursion (fuel-syntax--beginning-of-defun) (point))
(max (save-excursion (factor-beginning-of-defun) (point))
(save-excursion
(re-search-backward fuel-syntax--end-of-def-regex nil t)
(re-search-backward factor-end-of-def-regex nil t)
(forward-line 1)
(skip-syntax-forward "-"))))
@ -92,7 +94,7 @@
(indent-region start (point))
(move-overlay fuel-stack--overlay start (point))))
(defun fuel-refactor--extract-other (start end code)
(defun fuel-refactor--extract-other (start end word code)
(unwind-protect
(when (y-or-n-p "Apply refactoring to rest of buffer? ")
(save-excursion
@ -106,7 +108,7 @@
(let* ((rp (< begin end))
(code (and rp (buffer-substring begin end)))
(existing (and code (fuel-refactor--reuse-existing code)))
(code-str (and code (or existing (fuel--region-to-string begin end))))
(code-str (and code (or existing (fuel-region-to-string begin end))))
(word (or (car existing) (read-string "New word name: ")))
(stack-effect (or existing
(and code-str (fuel-stack--infer-effect code-str))
@ -123,7 +125,7 @@
(if rp
(fuel-refactor--extract-other start
(or (car (cddr existing)) (point))
code)
word code)
(unwind-protect
(sit-for fuel-stack-highlight-period)
(delete-overlay fuel-stack--overlay)))))))
@ -148,9 +150,11 @@
"Extracts current innermost sexp (up to point) as a separate
word."
(interactive)
(fuel-refactor-extract-region (1+ (fuel-syntax--beginning-of-sexp-pos))
(if (looking-at-p ";") (point)
(fuel-syntax--end-of-symbol-pos))))
(fuel-refactor-extract-region (1+ (factor-beginning-of-sexp-pos))
(if (looking-at-p ";")
(point)
(save-excursion
(factor-end-of-symbol) (point)))))
;;; Convert word to generic + method:
@ -160,8 +164,8 @@ word."
The word's body is put in a new method for the generic."
(interactive)
(let ((p (point)))
(fuel-syntax--beginning-of-defun)
(unless (re-search-forward fuel-syntax--word-signature-regex nil t)
(factor-beginning-of-defun)
(unless (re-search-forward factor-word-signature-regex nil t)
(goto-char p)
(error "Cannot find a proper word definition here"))
(let ((begin (match-beginning 0))
@ -186,11 +190,11 @@ The word's body is put in a new method for the generic."
(defun fuel-refactor-inline-word ()
"Inserts definition of word at point."
(interactive)
(let ((word (fuel-syntax-symbol-at-point)))
(let ((word (factor-symbol-at-point)))
(unless word (error "No word at point"))
(let ((code (fuel-refactor--word-def word)))
(unless code (error "Word's definition not found"))
(fuel-syntax--beginning-of-symbol)
(factor-beginning-of-symbol)
(kill-word 1)
(let ((start (point)))
(insert code)
@ -207,17 +211,17 @@ The word's body is put in a new method for the generic."
(defun fuel-refactor--def-word ()
(save-excursion
(fuel-syntax--beginning-of-defun)
(or (and (looking-at fuel-syntax--method-definition-regex)
(factor-beginning-of-defun)
(or (and (looking-at factor-method-definition-regex)
(match-string-no-properties 2))
(and (looking-at fuel-syntax--word-definition-regex)
(and (looking-at factor-word-definition-regex)
(match-string-no-properties 2)))))
(defun fuel-refactor-rename-word (&optional arg)
"Rename globally the word whose definition point is at.
With prefix argument, use word at point instead."
(interactive "P")
(let* ((from (if arg (fuel-syntax-symbol-at-point) (fuel-refactor--def-word)))
(let* ((from (if arg (factor-symbol-at-point) (fuel-refactor--def-word)))
(from (read-string "Rename word: " from))
(to (read-string (format "Rename '%s' to: " from)))
(buffer (current-buffer)))
@ -229,18 +233,26 @@ With prefix argument, use word at point instead."
(defun fuel-refactor--insert-using (vocab)
(save-excursion
(goto-char (point-min))
(let ((usings (sort (cons vocab (fuel-syntax--usings)) 'string<)))
(let ((usings (sort (cons vocab (factor-usings)) 'string<)))
(fuel-debug--replace-usings (buffer-file-name) usings))))
(defun fuel-refactor--vocab-root (vocab)
(let ((cmd `(:fuel* (,vocab fuel-scaffold-get-root) "fuel")))
(fuel-eval--retort-result (fuel-eval--send/wait cmd))))
(defun fuel-update-usings (&optional arg)
"Asks factor for the vocabularies needed by this file,
optionally updating the its USING: line.
With prefix argument, ask for the file name."
(interactive "P")
(let ((file (car (fuel-mode--read-file arg))))
(when file (fuel-debug--uses-for-file file))))
(defun fuel-refactor--extract-vocab (begin end)
(when (< begin end)
(let* ((str (buffer-substring begin end))
(buffer (current-buffer))
(vocab (fuel-syntax--current-vocab))
(vocab (factor-current-vocab))
(vocab-hint (and vocab (format "%s." vocab)))
(root-hint (fuel-refactor--vocab-root vocab))
(vocab (fuel-scaffold-vocab t vocab-hint root-hint)))
@ -290,4 +302,5 @@ The region is extended to the closest definition boundaries."
(provide 'fuel-refactor)
;;; fuel-refactor.el ends here

83
misc/fuel/fuel-scaffold.el
View File

@ -16,12 +16,13 @@
(require 'fuel-eval)
(require 'fuel-edit)
(require 'fuel-syntax)
(require 'fuel-base)
(require 'factor-mode)
;;; Customisation:
;;;###autoload
(defgroup fuel-scaffold nil
"Options for FUEL's scaffolding."
:group 'fuel)
@ -35,6 +36,19 @@
;;; Auxiliary functions:
(defun fuel-mode--code-file (kind &optional file)
(let* ((file (or file (buffer-file-name)))
(bn (file-name-nondirectory file)))
(and (string-match (format "\\(.+\\)-%s\\.factor$" kind) bn)
(expand-file-name (concat (match-string 1 bn) ".factor")
(file-name-directory file)))))
(defun fuel-mode--in-docs (&optional file)
(fuel-mode--code-file "docs"))
(defun fuel-mode--in-tests (&optional file)
(fuel-mode--code-file "tests"))
(defun fuel-scaffold--vocab-roots ()
(let ((cmd '(:fuel* (vocab-roots get :get) "fuel")))
(fuel-eval--retort-result (fuel-eval--send/wait cmd))))
@ -47,13 +61,12 @@
(defun fuel-scaffold--first-vocab ()
(goto-char (point-min))
(re-search-forward fuel-syntax--current-vocab-regex nil t))
(re-search-forward factor-current-vocab-regex nil t))
(defsubst fuel-scaffold--vocab (file)
(save-excursion
(set-buffer (find-file-noselect file))
(with-current-buffer (find-file-noselect file)
(fuel-scaffold--first-vocab)
(fuel-syntax--current-vocab)))
(factor-current-vocab)))
(defconst fuel-scaffold--tests-header-format
"! Copyright (C) %s %s
@ -62,6 +75,10 @@ USING: %s tools.test ;
IN: %s
")
(defvar fuel-scaffold-test-autoinsert-p nil)
(defvar fuel-scaffold-help-autoinsert-p nil)
(defvar fuel-scaffold-help-header-only-p nil)
(defsubst fuel-scaffold--check-auto (var)
(and var (or (eq var 'always) (y-or-n-p "Insert template? "))))
@ -85,7 +102,8 @@ IN: %s
(fuel-eval--send/wait cmd)))
(defsubst fuel-scaffold--create-authors (vocab)
(let ((cmd `(:fuel* (,vocab ,fuel-scaffold-developer-name fuel-scaffold-authors) "fuel")))
(let ((cmd `(:fuel* (,vocab ,fuel-scaffold-developer-name
fuel-scaffold-authors) "fuel")))
(fuel-eval--send/wait cmd)))
(defsubst fuel-scaffold--create-tags (vocab tags)
@ -115,12 +133,13 @@ IN: %s
(defun fuel-scaffold--maybe-insert ()
(ignore-errors
(or (fuel-scaffold--tests (factor-mode--in-tests))
(fuel-scaffold--help (factor-mode--in-docs)))))
(or (fuel-scaffold--tests (fuel-mode--in-tests))
(fuel-scaffold--help (fuel-mode--in-docs)))))
;;; User interface:
;;;###autoload
(defun fuel-scaffold-vocab (&optional other-window name-hint root-hint)
"Creates a directory in the given root for a new vocabulary and
adds source and authors.txt files. Prompts the user for optional summary,
@ -158,6 +177,7 @@ You can configure `fuel-scaffold-developer-name' (set by default to
(goto-char (point-max))
name))
;;;###autoload
(defun fuel-scaffold-help (&optional arg)
"Creates, if it does not already exist, a help file with
scaffolded help for each word in the current vocabulary.
@ -166,80 +186,93 @@ With prefix argument, ask for the vocabulary name.
You can configure `fuel-scaffold-developer-name' (set by default to
`user-full-name') for the name to be inserted in the generated file."
(interactive "P")
(let* ((vocab (or (and (not arg) (fuel-syntax--current-vocab))
(let* ((vocab (or (and (not arg) (factor-current-vocab))
(fuel-completion--read-vocab nil)))
(ret (fuel-scaffold--create-docs vocab))
(file (fuel-eval--retort-result ret)))
(unless file
(error "Error creating help file" (car (fuel-eval--retort-error ret))))
(error "Error creating help file: %s"
(car (fuel-eval--retort-error ret))))
(find-file file)))
;;;###autoload
(defun fuel-scaffold-tests (&optional arg)
"Creates, if it does not already exist, a tests file for the current vocabulary.
"Creates, if it does not already exist, a tests file for the current
vocabulary.
With prefix argument, ask for the vocabulary name.
You can configure `fuel-scaffold-developer-name' (set by default to
`user-full-name') for the name to be inserted in the generated file."
(interactive "P")
(let* ((vocab (or (and (not arg) (fuel-syntax--current-vocab))
(let* ((vocab (or (and (not arg) (factor-current-vocab))
(fuel-completion--read-vocab nil)))
(ret (fuel-scaffold--create-tests vocab))
(file (fuel-eval--retort-result ret)))
(unless file
(error "Error creating tests file" (car (fuel-eval--retort-error ret))))
(error "Error creating tests file: %s"
(car (fuel-eval--retort-error ret))))
(find-file file)))
(defun fuel-scaffold-authors (&optional arg)
"Creates, if it does not already exist, an authors file for the current vocabulary.
"Creates, if it does not already exist, an authors file for the current
vocabulary.
With prefix argument, ask for the vocabulary name.
You can configure `fuel-scaffold-developer-name' (set by default to
`user-full-name') for the name to be inserted in the generated file."
(interactive "P")
(let* ((vocab (or (and (not arg) (fuel-syntax--current-vocab))
(let* ((vocab (or (and (not arg) (factor-current-vocab))
(fuel-completion--read-vocab nil)))
(ret (fuel-scaffold--create-authors vocab))
(file (fuel-eval--retort-result ret)))
(unless file
(error "Error creating authors file" (car (fuel-eval--retort-error ret))))
(error "Error creating authors file: %s"
(car (fuel-eval--retort-error ret))))
(find-file file)))
(defun fuel-scaffold-tags (&optional arg)
"Creates, if it does not already exist, a tags file for the current vocabulary."
"Creates, if it does not already exist, a tags file for the current
vocabulary."
(interactive "P")
(let* ((vocab (or (and (not arg) (fuel-syntax--current-vocab))
(let* ((vocab (or (and (not arg) (factor-current-vocab))
(fuel-completion--read-vocab nil)))
(tags (read-string "Tags: "))
(ret (fuel-scaffold--create-tags vocab tags))
(file (fuel-eval--retort-result ret)))
(unless file
(error "Error creating tags file" (car (fuel-eval--retort-error ret))))
(error "Error creating tags file: %s"
(car (fuel-eval--retort-error ret))))
(find-file file)))
(defun fuel-scaffold-summary (&optional arg)
"Creates, if it does not already exist, a summary file for the current vocabulary."
"Creates, if it does not already exist, a summary file for the current
vocabulary."
(interactive "P")
(let* ((vocab (or (and (not arg ) (fuel-syntax--current-vocab))
(let* ((vocab (or (and (not arg ) (factor-current-vocab))
(fuel-completion--read-vocab nil)))
(summary (read-string "Summary: "))
(ret (fuel-scaffold--create-summary vocab summary))
(file (fuel-eval--retort-result ret)))
(unless file
(error "Error creating summary file" (car (fuel-eval--retort-error ret))))
(error "Error creating summary file: %s"
(car (fuel-eval--retort-error ret))))
(find-file file)))
(defun fuel-scaffold-platforms (&optional arg)
"Creates, if it does not already exist, a platforms file for the current vocabulary."
"Creates, if it does not already exist, a platforms file for the current
vocabulary."
(interactive "P")
(let* ((vocab (or (and (not arg ) (fuel-syntax--current-vocab))
(let* ((vocab (or (and (not arg ) (factor-current-vocab))
(fuel-completion--read-vocab nil)))
(platforms (read-string "Platforms: "))
(ret (fuel-scaffold--create-platforms vocab platforms))
(file (fuel-eval--retort-result ret)))
(unless file
(error "Error creating platforms file" (car (fuel-eval--retort-error ret))))
(error "Error creating platforms file: %s"
(car (fuel-eval--retort-error ret))))
(find-file file)))
(provide 'fuel-scaffold)
;;; fuel-scaffold.el ends here

48
misc/fuel/fuel-stack.el
View File

@ -15,22 +15,25 @@
;;; Code:
(require 'fuel-autodoc)
(require 'fuel-syntax)
(require 'fuel-eval)
(require 'fuel-font-lock)
(require 'fuel-base)
(require 'factor-mode)
;;; Customization
;;;###autoload
(defgroup fuel-stack nil
"Customization for FUEL's stack inference engine."
:group 'fuel)
(fuel-font-lock--defface fuel-font-lock-stack-region
'highlight fuel-stack "highlighting the stack effect region")
(defface fuel-stack-region-face '((t (:inherit highlight)))
"Highlights the region being stack inferenced."
:group 'fuel-stack
:group 'fuel-faces
:group 'fuel)
(defcustom fuel-stack-highlight-period 2.0
(defcustom fuel-stack-highlight-period 1.0
"Time, in seconds, the region is highlighted when showing its
stack effect.
@ -60,7 +63,7 @@ Set it to 0 to disable highlighting."
(defvar fuel-stack--overlay
(let ((overlay (make-overlay 0 0)))
(overlay-put overlay 'face 'fuel-font-lock-stack-region)
(overlay-put overlay 'face 'fuel-stack-region-face)
(delete-overlay overlay)
overlay))
@ -70,11 +73,11 @@ Set it to 0 to disable highlighting."
(when (> fuel-stack-highlight-period 0)
(move-overlay fuel-stack--overlay begin end))
(condition-case nil
(let* ((str (fuel--region-to-string begin end))
(let* ((str (fuel-region-to-string begin end))
(effect (fuel-stack--infer-effect/prop str)))
(if effect (message "%s" effect)
(message "Couldn't infer effect for '%s'"
(fuel--shorten-region begin end 60)))
(fuel-shorten-region begin end 60)))
(sit-for fuel-stack-highlight-period))
(error))
(delete-overlay fuel-stack--overlay))
@ -85,21 +88,21 @@ With prefix argument, use current region instead"
(interactive "P")
(if arg
(call-interactively 'fuel-stack-effect-region)
(fuel-stack-effect-region (1+ (fuel-syntax--beginning-of-sexp-pos))
(if (looking-at-p ";") (point)
(fuel-syntax--end-of-symbol-pos)))))
(fuel-stack-effect-region (1+ (factor-beginning-of-sexp-pos))
(if (looking-at-p ";")
(point)
(save-excursion
(factor-end-of-symbol) (point))))))
;;; Stack mode:
(make-variable-buffer-local
(defvar fuel-stack-mode-string " S"
"Modeline indicator for fuel-stack-mode"))
(defvar-local fuel-stack-mode-string " S"
"Modeline indicator for fuel-stack-mode")
(make-variable-buffer-local
(defvar fuel-stack--region-function
'(lambda ()
(fuel--region-to-string (1+ (fuel-syntax--beginning-of-sexp-pos))))))
(defvar-local fuel-stack--region-function
'(lambda ()
(fuel-region-to-string (1+ (factor-beginning-of-sexp-pos)))))
(defun fuel-stack--eldoc ()
(when (looking-at-p " \\|$")
@ -109,9 +112,10 @@ With prefix argument, use current region instead"
(fuel-stack--infer-effect/prop r))))
(when e
(if fuel-stack-mode-show-sexp-p
(concat (fuel--shorten-str r 30) " -> " e)
(concat (fuel-shorten-str r 30) " -> " e)
e)))))
;;;###autoload
(define-minor-mode fuel-stack-mode
"Toggle Fuel's Stack mode.
With no argument, this command toggles the mode.
@ -126,10 +130,10 @@ sexp are automatically displayed in the echo area."
(setq fuel-autodoc--fallback-function
(when fuel-stack-mode 'fuel-stack--eldoc))
(set (make-local-variable 'eldoc-minor-mode-string) nil)
(setq-local eldoc-minor-mode-string nil)
(unless fuel-autodoc-mode
(set (make-local-variable 'eldoc-documentation-function)
(when fuel-stack-mode 'fuel-stack--eldoc))
(setq-local eldoc-documentation-function
(when fuel-stack-mode 'fuel-stack--eldoc))
(eldoc-mode fuel-stack-mode)
(message "Fuel Stack Autodoc %s" (if fuel-stack-mode "enabled" "disabled"))))

475
misc/fuel/fuel-syntax.el
View File

@ -1,475 +0,0 @@
;;; fuel-syntax.el --- auxiliar definitions for factor code navigation.
;; 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>
;; Keywords: languages
;;; Commentary:
;; Auxiliar constants and functions to parse factor code.
;;; Code:
(require 'thingatpt)
;;; Thing-at-point support for factor symbols:
(defun fuel-syntax--beginning-of-symbol ()
"Move point to the beginning of the current symbol."
(skip-syntax-backward "w_()"))
(defsubst fuel-syntax--beginning-of-symbol-pos ()
(save-excursion (fuel-syntax--beginning-of-symbol) (point)))
(defun fuel-syntax--end-of-symbol ()
"Move point to the end of the current symbol."
(skip-syntax-forward "w_()"))
(defsubst fuel-syntax--end-of-symbol-pos ()
(save-excursion (fuel-syntax--end-of-symbol) (point)))
(put 'factor-symbol 'end-op 'fuel-syntax--end-of-symbol)
(put 'factor-symbol 'beginning-op 'fuel-syntax--beginning-of-symbol)
(defsubst fuel-syntax-symbol-at-point ()
(let ((s (substring-no-properties (thing-at-point 'factor-symbol))))
(and (> (length s) 0) s)))
;;; Regexps galore:
(defconst fuel-syntax--parsing-words
'(":" "::" ";" "&:" "<<" "<PRIVATE" ">>"
"ABOUT:" "AFTER:" "ALIAS:" "ALIEN:" "ARTICLE:"
"B" "BEFORE:"
"C:" "CALLBACK:" "C-GLOBAL:" "C-TYPE:" "CHAR:" "COM-INTERFACE:" "CONSTANT:" "CONSULT:" "call-next-method"
"DEFER:" "DESTRUCTOR:"
"EBNF:" ";EBNF" "ENUM:" "ERROR:" "EXCLUDE:"
"f" "FORGET:" "FROM:" "FUNCTION:" "FUNCTION-ALIAS:"
"GAME:" "GENERIC#" "GENERIC:"
"GLSL-SHADER:" "GLSL-PROGRAM:"
"HELP:" "HOOK:"
"IN:" "initial:" "INSTANCE:" "INTERSECTION:"
"LIBRARY:"
"M:" "M::" "MACRO:" "MACRO::" "MAIN:" "MATH:"
"MEMO:" "MEMO:" "METHOD:" "MIXIN:"
"NAN:"
"POSTPONE:" "PREDICATE:" "PRIMITIVE:" "PRIVATE>" "PROTOCOL:" "PROVIDE:"
"QUALIFIED-WITH:" "QUALIFIED:"
"read-only" "RENAME:" "REQUIRE:" "REQUIRES:"
"SINGLETON:" "SINGLETONS:" "SLOT:" "SPECIALIZED-ARRAY:" "SPECIALIZED-ARRAYS:" "STRING:" "STRUCT:" "SYMBOL:" "SYMBOLS:" "SYNTAX:"
"TUPLE:" "t" "t?" "TYPEDEF:" "TYPED:" "TYPED::"
"UNIFORM-TUPLE:" "UNION:" "UNION-STRUCT:" "USE:" "USING:"
"VARIANT:" "VERTEX-FORMAT:"))
(defconst fuel-syntax--parsing-words-regex
(regexp-opt fuel-syntax--parsing-words 'words))
(defconst fuel-syntax--bracers
'("B" "BV" "C" "CS" "H" "T" "V" "W"))
(defconst fuel-syntax--brace-words-regex
(format "%s{" (regexp-opt fuel-syntax--bracers t)))
(defconst fuel-syntax--declaration-words
'("flushable" "foldable" "inline" "parsing" "recursive" "delimiter"))
(defconst fuel-syntax--declaration-words-regex
(regexp-opt fuel-syntax--declaration-words 'words))
(defsubst fuel-syntax--second-word-regex (prefixes)
(format "%s +\\([^ \r\n]+\\)" (regexp-opt prefixes t)))
(defconst fuel-syntax--method-definition-regex
"^M::? +\\([^ ]+\\) +\\([^ ]+\\)")
(defconst fuel-syntax--before-definition-regex
"^BEFORE: +\\([^ ]+\\) +\\([^ ]+\\)")
(defconst fuel-syntax--after-definition-regex
"^AFTER: +\\([^ ]+\\) +\\([^ ]+\\)")
(defconst fuel-syntax--integer-regex
"\\_<-?[0-9]+\\_>")
(defconst fuel-syntax--raw-float-regex
"[0-9]*\\.[0-9]*\\([eEpP][+-]?[0-9]+\\)?")
(defconst fuel-syntax--float-regex
(format "\\_<-?%s\\_>" fuel-syntax--raw-float-regex))
(defconst fuel-syntax--number-regex
(format "\\([0-9]+\\|%s\\)" fuel-syntax--raw-float-regex))
(defconst fuel-syntax--ratio-regex
(format "\\_<[+-]?%s/-?%s\\_>"
fuel-syntax--number-regex
fuel-syntax--number-regex))
(defconst fuel-syntax--bad-string-regex
"\\_<\"[^>]\\([^\"\n]\\|\\\\\"\\)*\n")
(defconst fuel-syntax--word-definition-regex
(format "\\_<\\(%s\\)?: +\\_<\\(\\w+\\)\\_>"
(regexp-opt
'(":" "GENERIC" "DEFER" "HOOK" "MAIN" "MATH" "POSTPONE"
"SYMBOL" "SYNTAX" "TYPED" "TYPED:" "RENAME"))))
(defconst fuel-syntax--alias-definition-regex
"^ALIAS: +\\(\\_<.+?\\_>\\) +\\(\\_<.+?\\_>\\)")
(defconst fuel-syntax--vocab-ref-regexp
(fuel-syntax--second-word-regex
'("IN:" "USE:" "FROM:" "EXCLUDE:" "QUALIFIED:" "QUALIFIED-WITH:")))
(defconst fuel-syntax--int-constant-def-regex
(fuel-syntax--second-word-regex '("ALIEN:" "CHAR:" "NAN:")))
(defconst fuel-syntax--type-definition-regex
(fuel-syntax--second-word-regex
'("C-STRUCT:" "C-UNION:" "COM-INTERFACE:" "MIXIN:" "TUPLE:" "SINGLETON:" "SPECIALIZED-ARRAY:" "STRUCT:" "UNION:" "UNION-STRUCT:")))
(defconst fuel-syntax--error-regex
(fuel-syntax--second-word-regex '("ERROR:")))
(defconst fuel-syntax--tuple-decl-regex
"^TUPLE: +\\([^ \n]+\\) +< +\\([^ \n]+\\)\\_>")
(defconst fuel-syntax--constructor-regex "<[^ >]+>")
(defconst fuel-syntax--getter-regex "\\(^\\|\\_<\\)[^ ]+?>>\\_>")
(defconst fuel-syntax--setter-regex "\\_<>>.+?\\_>")
(defconst fuel-syntax--symbol-definition-regex
(fuel-syntax--second-word-regex '("&:" "SYMBOL:" "VAR:")))
(defconst fuel-syntax--stack-effect-regex
"\\( ( [^\n]* )\\)\\|\\( (( [^\n]* ))\\)")
(defconst fuel-syntax--using-lines-regex "^USING: +\\([^;]+\\);")
(defconst fuel-syntax--use-line-regex "^USE: +\\(.*\\)$")
(defconst fuel-syntax--current-vocab-regex "^IN: +\\([^ \r\n\f]+\\)")
(defconst fuel-syntax--sub-vocab-regex "^<\\([^ \n]+\\) *$")
(defconst fuel-syntax--alien-function-regex
"\\_<FUNCTION: +\\(\\w+\\)[\n ]+\\(\\w+\\)")
(defconst fuel-syntax--alien-function-alias-regex
"\\_<FUNCTION-ALIAS: +\\(\\w+\\)[\n ]+\\(\\w+\\)[\n ]+\\(\\w+\\)")
(defconst fuel-syntax--alien-callback-regex
"\\_<CALLBACK: +\\(\\w+\\) +\\(\\w+\\)")
(defconst fuel-syntax--indent-def-starts '("" ":"
"AFTER" "BEFORE"
"COM-INTERFACE" "CONSULT"
"ENUM" "ERROR"
"FROM" "FUNCTION:" "FUNCTION-ALIAS:"
"INTERSECTION:"
"M" "M:" "MACRO" "MACRO:"
"MEMO" "MEMO:" "METHOD"
"SYNTAX"
"PREDICATE" "PRIMITIVE" "PROTOCOL"
"SINGLETONS"
"STRUCT" "SYMBOLS" "TAG" "TUPLE"
"TYPED" "TYPED:"
"UNIFORM-TUPLE"
"UNION-STRUCT" "UNION"
"VARIANT" "VERTEX-FORMAT"))
(defconst fuel-syntax--no-indent-def-starts '("ARTICLE"
"HELP"
"SPECIALIZED-ARRAYS"))
(defconst fuel-syntax--indent-def-start-regex
(format "^\\(%s:\\)\\( \\|\n\\)" (regexp-opt fuel-syntax--indent-def-starts)))
(defconst fuel-syntax--definition-start-regex
(format "^\\(%s:\\) " (regexp-opt (append fuel-syntax--no-indent-def-starts
fuel-syntax--indent-def-starts))))
(defconst fuel-syntax--definition-end-regex
(format "\\(\\(^\\| +\\);\\( *%s\\)*\\($\\| +\\)\\)"
fuel-syntax--declaration-words-regex))
(defconst fuel-syntax--single-liner-regex
(regexp-opt '("ABOUT:"
"ALIAS:"
"CONSTANT:" "C:" "C-GLOBAL:" "C-TYPE:"
"DEFER:" "DESTRUCTOR:"
"FORGET:"
"GAME:" "GENERIC:" "GENERIC#" "GLSL-PROGRAM:"
"HOOK:"
"IN:" "INSTANCE:"
"LIBRARY:"
"MAIN:" "MATH:" "MIXIN:"
"NAN:"
"POSTPONE:" "PRIVATE>" "<PRIVATE"
"QUALIFIED-WITH:" "QUALIFIED:"
"RENAME:"
"SINGLETON:" "SLOT:" "SPECIALIZED-ARRAY:" "SYMBOL:"
"TYPEDEF:"
"USE:"
"VAR:")))
(defconst fuel-syntax--begin-of-def-regex
(format "^USING: \\|\\(%s\\)\\|\\(^%s .*\\)"
fuel-syntax--definition-start-regex
fuel-syntax--single-liner-regex))
(defconst fuel-syntax--end-of-def-line-regex
(format "^.*%s" fuel-syntax--definition-end-regex))
(defconst fuel-syntax--end-of-def-regex
(format "\\(%s\\)\\|\\(^%s .*\\)"
fuel-syntax--end-of-def-line-regex
fuel-syntax--single-liner-regex))
(defconst fuel-syntax--word-signature-regex
(format ":[^ ]* \\([^ ]+\\)\\(%s\\)*" fuel-syntax--stack-effect-regex))
(defconst fuel-syntax--defun-signature-regex
(format "\\(%s\\|%s\\)"
fuel-syntax--word-signature-regex
"M[^:]*: [^ ]+ [^ ]+"))
(defconst fuel-syntax--constructor-decl-regex
"\\_<C: +\\(\\w+\\) +\\(\\w+\\)\\( .*\\)?$")
(defconst fuel-syntax--typedef-regex
"\\_<TYPEDEF: +\\(\\w+\\) +\\(\\w+\\)\\( .*\\)?$")
(defconst fuel-syntax--c-global-regex
"\\_<C-GLOBAL: +\\(\\w+\\) +\\(\\w+\\)\\( .*\\)?$")
(defconst fuel-syntax--c-type-regex
"\\_<C-TYPE: +\\(\\w+\\)\\( .*\\)?$")
(defconst fuel-syntax--rename-regex
"\\_<RENAME: +\\(\\w+\\) +\\(\\w+\\) +=> +\\(\\w+\\)\\( .*\\)?$")
;;; Factor syntax table
(setq fuel-syntax--syntax-table
(let ((table (make-syntax-table)))
;; Default is word constituent
(dotimes (i 256)
(modify-syntax-entry i "w" table))
;; Whitespace (TAB is not whitespace)
(modify-syntax-entry ?\f " " table)
(modify-syntax-entry ?\r " " table)
(modify-syntax-entry ?\ " " table)
(modify-syntax-entry ?\n " " table)
table))
(defconst fuel-syntax--syntactic-keywords
`(;; Strings and chars
("\\_<<\\(\"\\)\\_>" (1 "<b"))
("\\_<\\(\"\\)>\\_>" (1 ">b"))
("\\( \\|^\\)\\(DLL\\|P\\|SBUF\\)?\\(\"\\)\\(\\([^\n\r\f\"\\]\\|\\\\.\\)*\\)\\(\"\\)"
(3 "\"") (6 "\""))
("CHAR: \\(\"\\) [^\\\"]*?\\(\"\\)\\([^\\\"]\\|\\\\.\\)*?\\(\"\\)"
(1 "w") (2 "<b") (4 ">b"))
("\\(CHAR:\\|\\\\\\) \\(\\w\\|!\\)\\( \\|$\\)" (2 "w"))
;; Comments
("\\_<\\(#?!\\) .*\\(\n\\|$\\)" (1 "<") (2 ">"))
("\\_<\\(#?!\\)\\(\n\\|$\\)" (1 "<") (2 ">"))
;; postpone
("\\_<POSTPONE:\\( \\).*\\(\n\\)" (1 "<b") (2 ">b"))
;; Multiline constructs
("\\_<\\(E\\)BNF:\\( \\|\n\\)" (1 "<b"))
("\\_<;EBN\\(F\\)\\_>" (1 ">b"))
("\\_<\\(U\\)SING: \\(;\\)" (1 "<b") (2 ">b"))
("\\_<USING:\\( \\)" (1 "<b"))
("\\_<\\(C\\)-ENUM: \\(;\\)" (1 "<b") (2 ">b"))
("\\_<ENUM:\\( \\|\n\\)" (1 "<b"))
("\\_<TUPLE: +\\w+? +< +\\w+? *\\( \\|\n\\)\\([^;]\\|$\\)" (1 "<b"))
("\\_<TUPLE: +\\w+? *\\( \\|\n\\)\\([^;<\n]\\|\\_>\\)" (1 "<b"))
("\\_<\\(SYMBOLS\\|SPECIALIZED-ARRAYS\\|SINGLETONS\\|VARIANT\\): *?\\( \\|\n\\)\\([^;\n]\\|\\_>\\)"
(2 "<b"))
("\\(\n\\| \\);\\_>" (1 ">b"))
;; Let and lambda:
("\\_<\\(!(\\) .* \\()\\)" (1 "<") (2 ">"))
("\\(\\[\\)\\(let\\|let\\*\\)\\( \\|$\\)" (1 "(]"))
("\\(\\[\\)\\(|\\) +[^|]* \\(|\\)" (1 "(]") (2 "(|") (3 ")|"))
(" \\(|\\) " (1 "(|"))
(" \\(|\\)$" (1 ")"))
;; Opening brace words:
("\\_<\\w*\\({\\)\\_>" (1 "(}"))
("\\_<\\(}\\)\\_>" (1 "){"))
;; Parenthesis:
("\\_<\\((\\)\\_>" (1 "()"))
("\\_<\\w*\\((\\)\\_>" (1 "()"))
("\\_<\\()\\)\\_>" (1 ")("))
("\\_<(\\((\\)\\_>" (1 "()"))
("\\_<\\()\\))\\_>" (1 ")("))
;; Quotations:
("\\_<'\\(\\[\\)\\_>" (1 "(]")) ; fried
("\\_<$\\(\\[\\)\\_>" (1 "(]")) ; parse-time
("\\_<\\(\\[\\)\\_>" (1 "(]"))
("\\_<\\(\\]\\)\\_>" (1 ")["))))
;;; Source code analysis:
(defsubst fuel-syntax--brackets-depth ()
(nth 0 (syntax-ppss)))
(defsubst fuel-syntax--brackets-start ()
(nth 1 (syntax-ppss)))
(defun fuel-syntax--brackets-end ()
(save-excursion
(goto-char (fuel-syntax--brackets-start))
(condition-case nil
(progn (forward-sexp)
(1- (point)))
(error -1))))
(defsubst fuel-syntax--indentation-at (pos)
(save-excursion (goto-char pos) (current-indentation)))
(defsubst fuel-syntax--increased-indentation (&optional i)
(+ (or i (current-indentation)) factor-indent-width))
(defsubst fuel-syntax--decreased-indentation (&optional i)
(- (or i (current-indentation)) factor-indent-width))
(defsubst fuel-syntax--at-begin-of-def ()
(looking-at fuel-syntax--begin-of-def-regex))
(defsubst fuel-syntax--at-begin-of-indent-def ()
(looking-at fuel-syntax--indent-def-start-regex))
(defsubst fuel-syntax--at-end-of-def ()
(looking-at fuel-syntax--end-of-def-regex))
(defsubst fuel-syntax--looking-at-emptiness ()
(looking-at "^[ ]*$\\|$"))
(defsubst fuel-syntax--is-last-char (pos)
(save-excursion
(goto-char (1+ pos))
(looking-at-p "[ ]*$")))
(defsubst fuel-syntax--line-offset (pos)
(- pos (save-excursion
(goto-char pos)
(beginning-of-line)
(point))))
(defun fuel-syntax--previous-non-blank ()
(forward-line -1)
(while (and (not (bobp)) (fuel-syntax--looking-at-emptiness))
(forward-line -1)))
(defun fuel-syntax--beginning-of-block-pos ()
(save-excursion
(if (> (fuel-syntax--brackets-depth) 0)
(fuel-syntax--brackets-start)
(fuel-syntax--beginning-of-defun)
(point))))
(defun fuel-syntax--at-setter-line ()
(save-excursion
(beginning-of-line)
(when (re-search-forward fuel-syntax--setter-regex
(line-end-position)
t)
(let* ((to (match-beginning 0))
(from (fuel-syntax--beginning-of-block-pos)))
(goto-char from)
(let ((depth (fuel-syntax--brackets-depth)))
(and (or (re-search-forward fuel-syntax--constructor-regex to t)
(re-search-forward fuel-syntax--setter-regex to t))
(= depth (fuel-syntax--brackets-depth))))))))
(defun fuel-syntax--at-constructor-line ()
(save-excursion
(beginning-of-line)
(re-search-forward fuel-syntax--constructor-regex (line-end-position) t)))
(defsubst fuel-syntax--at-using ()
(looking-at fuel-syntax--using-lines-regex))
(defun fuel-syntax--in-using ()
(let ((p (point)))
(save-excursion
(and (re-search-backward "^USING: " nil t)
(re-search-forward " ;" nil t)
(< p (match-end 0))))))
(defsubst fuel-syntax--beginning-of-defun (&optional times)
(re-search-backward fuel-syntax--begin-of-def-regex nil t times))
(defsubst fuel-syntax--end-of-defun ()
(re-search-forward fuel-syntax--end-of-def-regex nil t))
(defsubst fuel-syntax--end-of-defun-pos ()
(save-excursion
(re-search-forward fuel-syntax--end-of-def-regex nil t)
(point)))
(defun fuel-syntax--beginning-of-body ()
(let ((p (point)))
(and (fuel-syntax--beginning-of-defun)
(re-search-forward fuel-syntax--defun-signature-regex p t)
(not (re-search-forward fuel-syntax--end-of-def-regex p t)))))
(defun fuel-syntax--beginning-of-sexp ()
(if (> (fuel-syntax--brackets-depth) 0)
(goto-char (fuel-syntax--brackets-start))
(fuel-syntax--beginning-of-body)))
(defsubst fuel-syntax--beginning-of-sexp-pos ()
(save-excursion (fuel-syntax--beginning-of-sexp) (point)))
;;; USING/IN:
(make-variable-buffer-local
(defvar fuel-syntax--current-vocab-function 'fuel-syntax--find-in))
(defsubst fuel-syntax--current-vocab ()
(funcall fuel-syntax--current-vocab-function))
(defun fuel-syntax--find-in ()
(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))
(defsubst fuel-syntax--usings ()
(funcall fuel-syntax--usings-function))
(defun fuel-syntax--file-has-private ()
(save-excursion
(goto-char (point-min))
(and (re-search-forward "\\_<<PRIVATE\\_>" nil t)
(re-search-forward "\\_<PRIVATE>\\_>" nil t))))
(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)))
(when (and (not no-private) (fuel-syntax--file-has-private))
(goto-char (point-max))
(push (concat (fuel-syntax--find-in) ".private") usings))
usings)))
(provide 'fuel-syntax)
;;; fuel-syntax.el ends here

3
misc/fuel/fuel-table.el
View File

@ -43,7 +43,7 @@
(let ((fill-column width))
(insert str)
(fill-region (point-min) (point-max))
(mapcar '(lambda (s) (fuel-table--pad-str s width))
(mapcar #'(lambda (s) (fuel-table--pad-str s width))
(split-string (buffer-string) "\n"))))))
(defun fuel-table--pad-row (row)
@ -136,4 +136,5 @@
(provide 'fuel-table)
;;; fuel-table.el ends here

112
misc/fuel/fuel-xref.el
View File

@ -17,17 +17,17 @@
(require 'fuel-completion)
(require 'fuel-help)
(require 'fuel-eval)
(require 'fuel-syntax)
(require 'fuel-popup)
(require 'fuel-font-lock)
(require 'fuel-menu)
(require 'fuel-base)
(require 'factor-mode)
(require 'button)
;;; Customization:
;;;###autoload
(defgroup fuel-xref nil
"FUEL's cross-referencing engine."
:group 'fuel)
@ -38,16 +38,26 @@ cursor at the first ocurrence of the used word."
:group 'fuel-xref
:type 'boolean)
(fuel-edit--define-custom-visit
fuel-xref-follow-link-method
fuel-xref
"How new buffers are opened when following a crossref link.")
(defcustom fuel-xref-follow-link-method nil
"How new buffers are opened when following a crossref link."
:group 'fuel-xref
:type '(choice (const :tag "Other window" window)
(const :tag "Other frame" frame)
(const :tag "Current window" nil)))
(fuel-font-lock--defface fuel-font-lock-xref-link
'link fuel-xref "highlighting links in cross-reference buffers")
(defface fuel-xref-link-face '((t (:inherit link)))
"Highlighting links in cross-reference buffers."
:group 'fuel-xref
:group 'fuel-faces
:group 'fuel)
(fuel-font-lock--defface fuel-font-lock-xref-vocab
'italic fuel-xref "vocabulary names in cross-reference buffers")
(defface fuel-xref-vocab-face '((t))
"Vocabulary names in cross-reference buffers."
:group 'fuel-xref
:group 'fuel-faces
:group 'fuel)
(defvar-local fuel-xref--word nil)
;;; Buttons:
@ -55,7 +65,7 @@ cursor at the first ocurrence of the used word."
(define-button-type 'fuel-xref--button-type
'action 'fuel-xref--follow-link
'follow-link t
'face 'fuel-font-lock-xref-link)
'face 'fuel-xref-link-face)
(defun fuel-xref--follow-link (button)
(let ((file (button-get button 'file))
@ -66,20 +76,24 @@ cursor at the first ocurrence of the used word."
(error "File '%s' is not readable" file))
(let ((word fuel-xref--word))
(fuel-edit--visit-file file fuel-xref-follow-link-method)
(when (numberp line) (goto-line line))
(when (numberp line)
(goto-char (point-min))
(forward-line (1- line)))
(when (and word fuel-xref-follow-link-to-word-p)
(and (re-search-forward (format "\\_<%s\\_>" word)
(fuel-syntax--end-of-defun-pos)
(factor-end-of-defun-pos)
t)
(goto-char (match-beginning 0)))))))
;;; The xref buffer:
(fuel-popup--define fuel-xref--buffer
"*fuel xref*" 'fuel-xref-mode)
(make-local-variable (defvar fuel-xref--word nil))
(defun fuel-xref--buffer ()
(or (get-buffer "*fuel xref*")
(with-current-buffer (get-buffer-create "*fuel xref")
(fuel-xref-mode)
(fuel-popup-mode)
(current-buffer))))
(defvar fuel-xref--help-string
"(Press RET or click to follow crossrefs, or h for help on word at point)")
@ -91,19 +105,19 @@ cursor at the first ocurrence of the used word."
(t (format "%s %ss %s %s:" count thing cc word))))
(defun fuel-xref--insert-ref (ref &optional no-vocab)
(when (and (stringp (first ref))
(stringp (third ref))
(numberp (fourth ref)))
(when (and (stringp (cl-first ref))
(stringp (cl-third ref))
(numberp (cl-fourth ref)))
(insert " ")
(insert-text-button (first ref)
(insert-text-button (cl-first ref)
:type 'fuel-xref--button-type
'help-echo (format "File: %s (%s)"
(third ref)
(fourth ref))
'file (third ref)
'line (fourth ref))
(when (and (not no-vocab) (stringp (second ref)))
(insert (format " (in %s)" (second ref))))
(cl-third ref)
(cl-fourth ref))
'file (cl-third ref)
'line (cl-fourth ref))
(when (and (not no-vocab) (stringp (cl-second ref)))
(insert (format " (in %s)" (cl-second ref))))
(newline)
t))
@ -139,7 +153,7 @@ cursor at the first ocurrence of the used word."
(fuel-xref--fill-and-display word "using" refs)))
(defun fuel-xref--word-callers-files (word)
(mapcar 'third (fuel-xref--callers word)))
(mapcar 'cl-third (fuel-xref--callers word)))
(defun fuel-xref--show-callees (word)
(let* ((cmd `(:fuel* (((:quote ,word) fuel-callees-xref))))
@ -189,9 +203,9 @@ cursor at the first ocurrence of the used word."
With prefix argument, ask for word."
(interactive "P")
(let ((word (if arg (fuel-completion--read-word "Find callers for: "
(fuel-syntax-symbol-at-point)
(factor-symbol-at-point)
fuel-xref--word-history)
(fuel-syntax-symbol-at-point))))
(factor-symbol-at-point))))
(when word
(message "Looking up %s's users ..." word)
(if (and (not arg)
@ -204,9 +218,9 @@ With prefix argument, ask for word."
With prefix argument, ask for word."
(interactive "P")
(let ((word (if arg (fuel-completion--read-word "Find callees for: "
(fuel-syntax-symbol-at-point)
(factor-symbol-at-point)
fuel-xref--word-history)
(fuel-syntax-symbol-at-point))))
(factor-symbol-at-point))))
(when word
(message "Looking up %s's callees ..." word)
(if (and (not arg)
@ -221,7 +235,7 @@ With prefix argument, ask for word."
With prefix argument, force reload of vocabulary list."
(interactive "P")
(let ((vocab (fuel-completion--read-vocab arg
(fuel-syntax-symbol-at-point)
(factor-symbol-at-point)
fuel-xref--vocab-history)))
(fuel-xref--show-vocab-uses vocab)))
@ -230,7 +244,7 @@ With prefix argument, force reload of vocabulary list."
With prefix argument, force reload of vocabulary list."
(interactive "P")
(let ((vocab (fuel-completion--read-vocab arg
(fuel-syntax-symbol-at-point)
(factor-symbol-at-point)
fuel-xref--vocab-history)))
(fuel-xref--show-vocab-usage vocab)))
@ -244,11 +258,11 @@ With prefix argument, force reload of vocabulary list."
"Show a list of words in current file.
With prefix argument, ask for the vocab."
(interactive "P")
(let ((vocab (or (and (not arg) (fuel-syntax--current-vocab))
(let ((vocab (or (and (not arg) (factor-current-vocab))
(fuel-completion--read-vocab nil))))
(when vocab
(fuel-xref--show-vocab-words vocab
(fuel-syntax--file-has-private)))))
(factor-file-has-private)))))
@ -259,27 +273,21 @@ With prefix argument, ask for the vocab."
(let ((fuel-help-always-ask nil))
(fuel-help)))
(defvar fuel-xref-mode-map
(let ((map (make-sparse-keymap)))
(suppress-keymap map)
(set-keymap-parent map button-buffer-map)
(define-key map "h" 'fuel-xref-show-help)
map))
(defun fuel-xref-mode ()
;;;###autoload
(define-derived-mode fuel-xref-mode fundamental-mode "FUEL Xref"
"Mode for displaying FUEL cross-reference information.
\\{fuel-xref-mode-map}"
(interactive)
(kill-all-local-variables)
:syntax-table factor-mode-syntax-table
(buffer-disable-undo)
(use-local-map fuel-xref-mode-map)
(set-syntax-table fuel-syntax--syntax-table)
(setq mode-name "FUEL Xref")
(setq major-mode 'fuel-xref-mode)
(font-lock-add-keywords nil
'(("(in \\(.+\\))" 1 'fuel-font-lock-xref-vocab)))
(suppress-keymap fuel-xref-mode-map)
(set-keymap-parent fuel-xref-mode-map button-buffer-map)
(define-key fuel-xref-mode-map "h" 'fuel-xref-show-help)
(font-lock-add-keywords nil '(("(in \\(.+\\))" 1 'fuel-xref-vocab-face)))
(setq buffer-read-only t))
(provide 'fuel-xref)
;;; fuel-xref.el ends here