diff --git a/misc/fuel/LICENSE b/misc/fuel/LICENSE new file mode 100644 index 0000000000..e9cd58a5e4 --- /dev/null +++ b/misc/fuel/LICENSE @@ -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. diff --git a/misc/fuel/README b/misc/fuel/README deleted file mode 100644 index e952176f2c..0000000000 --- a/misc/fuel/README +++ /dev/null @@ -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 "/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 "/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 ) - (setq fuel-listener-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 accept also C- (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 , 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 | - | | 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 | - |-----------------+-----------------------------| diff --git a/misc/fuel/README.md b/misc/fuel/README.md new file mode 100644 index 0000000000..c77cb3b34e --- /dev/null +++ b/misc/fuel/README.md @@ -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 "/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 "") + +# 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 ) + (setq fuel-listener-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 accept also C- (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 , 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 | +| | 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 | +|-----------------+-----------------------------| diff --git a/misc/fuel/factor-mode.el b/misc/fuel/factor-mode.el index c461b5fe94..ff0aff0e9b 100644 --- a/misc/fuel/factor-mode.el +++ b/misc/fuel/factor-mode.el @@ -1,10 +1,12 @@ ;;; factor-mode.el -- mode for editing Factor source +;; Copyright (C) 2013 Erik Charlebois ;; Copyright (C) 2008, 2009, 2010 Jose Antonio Ortega Ruiz ;; See http://factorcode.org/license.txt for BSD license. +;; Maintainer: Erik Charlebois ;; Author: Jose Antonio Ortega Ruiz -;; Keywords: languages, fuel, factor +;; Keywords: languages, factor ;; Start date: Tue Dec 02, 2008 21:32 ;;; Comentary: @@ -14,159 +16,688 @@ ;;; Code: -(require 'fuel-base) -(require 'fuel-syntax) -(require 'fuel-font-lock) - +(require 'thingatpt) +(require 'font-lock) (require 'ring) ;;; Customization: -(defgroup factor-mode nil +;;;###autoload +(defgroup factor nil "Major mode for Factor source code." - :group 'fuel :group 'languages) -(defcustom factor-mode-cycle-always-ask-p t +(defcustom factor-cycling-no-ask nil + "Whether to never create source/doc/tests file when cycling." + :type 'boolean + :group 'factor) + +(defcustom factor-cycle-always-ask-p t "Whether to always ask for file creation when cycling to a -source/docs/tests file. - -When set to false, you'll be asked only once." +source/docs/tests file. When set to false, you'll be asked only once." :type 'boolean - :group 'factor-mode) + :group 'factor) -(defcustom factor-mode-use-fuel t - "Whether to use the full FUEL facilities in factor mode. - -Set this variable to nil if you just want to use Emacs as the -external editor of your Factor environment, e.g., by putting -these lines in your .emacs: - - (add-to-list 'load-path \"/path/to/factor/misc/fuel\") - (setq factor-mode-use-fuel nil) - (require 'factor-mode) -" +(defcustom factor-indent-tabs-mode nil + "Indentation can insert tabs in Factor mode if this is non-nil." :type 'boolean - :group 'factor-mode) + :safe 'booleanp + :group 'factor) -(defcustom factor-mode-default-indent-width 4 - "Default indentation width for factor-mode. - -This value will be used for the local variable -`factor-mode-indent-width' in new factor buffers. For existing -code, we first check if `factor-mode-indent-width' is set -explicitly in a local variable section or line (e.g. -'! -*- factor-mode-indent-witdth: 2 -*-'). If that's not the case, -`factor-mode' tries to infer its correct value from the existing -code in the buffer." +(defcustom factor-indent-level 2 + "Indentation of Factor statements." :type 'integer - :group 'fuel) + :safe 'integerp + :group 'factor) -(defcustom factor-mode-hook nil - "Hook run when entering Factor mode." - :type 'hook - :group 'factor-mode) +(defcustom factor-comment-column 32 + "Indentation column of comments." + :type 'integer + :safe 'integerp + :group 'factor) -;;; Syntax table: +;;; Faces: -(defun factor-mode--syntax-setup () - (set-syntax-table fuel-syntax--syntax-table) - (set (make-local-variable 'beginning-of-defun-function) - 'fuel-syntax--beginning-of-defun) - (set (make-local-variable 'end-of-defun-function) 'fuel-syntax--end-of-defun) - (set (make-local-variable 'open-paren-in-column-0-is-defun-start) nil)) +;;;###autoload +(defgroup factor-faces nil + "Faces used by factor-mode." + :group 'factor + :group 'faces) + +(defface factor-font-lock-constructor '((t (:inherit font-lock-type-face))) + "Factor for constructor words." + :group 'factor-faces + :group 'faces) + +(defface factor-font-lock-constant '((t (:inherit font-lock-constant-face))) + "Face for constant and literal values." + :group 'factor-faces + :group 'faces) + +(defface factor-font-lock-number '((t (:inherit font-lock-constant-face))) + "Face for integer and floating-point constants." + :group 'factor-faces + :group 'faces) + +(defface factor-font-lock-ratio '((t (:inherit font-lock-constant-face))) + "Face for ratio constants." + :group 'factor-faces + :group 'faces) + +(defface factor-font-lock-declaration '((t (:inherit font-lock-keyword-face))) + "declaration words" + :group 'factor-faces + :group 'faces) + +(defface factor-font-lock-ebnf-form '((t (:inherit font-lock-constant-face))) + "EBNF: ... ;EBNF form" + :group 'factor-faces + :group 'faces) + +(defface factor-font-lock-error-form '((t (:inherit font-lock-warning-face))) + "ERROR: ... ; form" + :group 'factor-faces + :group 'faces) + +(defface factor-font-lock-parsing-word '((t (:inherit font-lock-keyword-face))) + "parsing words" + :group 'factor-faces + :group 'faces) + +(defface factor-font-lock-macro-word + '((t (:inherit font-lock-preprocessor-face))) + "macro words" + :group 'factor-faces + :group 'faces) + +(defface factor-font-lock-postpone-body '((t (:inherit font-lock-comment-face))) + "postponed form" + :group 'factor-faces + :group 'faces) + +(defface factor-font-lock-setter-word + '((t (:inherit font-lock-function-name-face))) + "setter words (>>foo)" + :group 'factor-faces + :group 'faces) + +(defface factor-font-lock-getter-word + '((t (:inherit font-lock-function-name-face))) + "getter words (foo>>)" + :group 'factor-faces + :group 'faces) + +(defface factor-font-lock-string '((t (:inherit font-lock-string-face))) + "strings" + :group 'factor-faces + :group 'faces) + +(defface factor-font-lock-symbol '((t (:inherit font-lock-variable-name-face))) + "name of symbol being defined" + :group 'factor-faces + :group 'faces) + +(defface factor-font-lock-type-name '((t (:inherit font-lock-type-face))) + "type names" + :group 'factor-faces + :group 'faces) + +(defface factor-font-lock-vocabulary-name + '((t (:inherit font-lock-constant-face))) + "vocabulary names" + :group 'factor-faces + :group 'faces) + +(defface factor-font-lock-word + '((t (:inherit font-lock-function-name-face))) + "Face for the word, generic or method being defined." + :group 'factor-faces + :group 'faces) + +(defface factor-font-lock-invalid-syntax + '((t (:inherit font-lock-warning-face))) + "syntactically invalid constructs" + :group 'factor-faces + :group 'faces) + +(defface factor-font-lock-comment '((t (:inherit font-lock-comment-face))) + "Face for Factor comments." + :group 'factor-faces + :group 'faces) + +(defface factor-font-lock-stack-effect '((t :inherit font-lock-comment-face)) + "Face for Factor stack effect declarations." + :group 'factor-faces + :group 'faces) + + +;;; Thing-at-point: + +(defun factor-beginning-of-symbol () + "Move point to the beginning of the current symbol." + (skip-syntax-backward "w_()")) + +(defun factor-end-of-symbol () + "Move point to the end of the current symbol." + (skip-syntax-forward "w_()")) + +(put 'factor-symbol 'end-op 'factor-end-of-symbol) +(put 'factor-symbol 'beginning-op 'factor-beginning-of-symbol) + +(defsubst factor-symbol-at-point () + (let* ((thing (thing-at-point 'factor-symbol)) + (s (when thing (substring-no-properties thing)))) + (and (> (length s) 0) s))) + + +;;; Regexps galore: + +(defconst factor-parsing-words + '(":" "::" ";" "&:" "<<" ">" + "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:" + "FORGET:" "FROM:" "FUNCTION:" "FUNCTION-ALIAS:" + "GAME:" "GENERIC#" "GENERIC:" + "GLSL-SHADER:" "GLSL-PROGRAM:" + "HELP:" "HINTS:" "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:" "TYPEDEF:" "TYPED:" "TYPED::" + "UNIFORM-TUPLE:" "UNION:" "UNION-STRUCT:" "USE:" "USING:" + "VARIANT:" "VERTEX-FORMAT:")) + +(defconst factor-parsing-words-regex + (regexp-opt factor-parsing-words 'symbols)) + +(defconst factor-constant-words + '("f" "t")) + +(defconst factor-constant-words-regex + (regexp-opt factor-constant-words 'symbols)) + +(defconst factor-bracer-words + '("B" "BV" "C" "CS" "H" "T" "V" "W")) + +(defconst factor-brace-words-regex + (format "%s{" (regexp-opt factor-bracer-words t))) + +(defconst factor-declaration-words + '("flushable" "foldable" "inline" "parsing" "recursive" "delimiter")) + +(defconst factor-declaration-words-regex + (regexp-opt factor-declaration-words 'symbols)) + +(defsubst factor-second-word-regex (prefixes) + (format "%s +\\([^ \r\n]+\\)" (regexp-opt prefixes t))) + +(defconst factor-method-definition-regex + "^M::? +\\([^ ]+\\) +\\([^ ]+\\)") + +(defconst factor-before-definition-regex + "^BEFORE: +\\([^ ]+\\) +\\([^ ]+\\)") + +(defconst factor-after-definition-regex + "^AFTER: +\\([^ ]+\\) +\\([^ ]+\\)") + +(defconst factor-integer-regex + "\\_<-?[0-9]+\\_>") + +(defconst factor-raw-float-regex + "[0-9]*\\.[0-9]*\\([eEpP][+-]?[0-9]+\\)?") + +(defconst factor-float-regex + (format "\\_<-?%s\\_>" factor-raw-float-regex)) + +(defconst factor-number-regex + (format "\\([0-9]+\\|%s\\)" factor-raw-float-regex)) + +(defconst factor-ratio-regex + (format "\\_<[+-]?%s/-?%s\\_>" factor-number-regex factor-number-regex)) + +(defconst factor-bad-string-regex + "\\_<\"[^>]\\([^\"\n]\\|\\\\\"\\)*\n") + +(defconst factor-word-definition-regex + (format "\\_<\\(%s\\)?: +\\_<\\(%s\\)\\_>" + (regexp-opt + '(":" "GENERIC" "DEFER" "HOOK" "MAIN" "MATH" "POSTPONE" + "SYMBOL" "SYNTAX" "TYPED" "TYPED:" "RENAME")) + "\\(\\sw\\|\\s_\\|\\s(\\|\\s)\\)+")) + +(defconst factor-alias-definition-regex + "^ALIAS: +\\(\\_<.+?\\_>\\) +\\(\\_<.+?\\_>\\)") + +(defconst factor-vocab-ref-regexp + (factor-second-word-regex + '("IN:" "USE:" "FROM:" "EXCLUDE:" "QUALIFIED:" "QUALIFIED-WITH:"))) + +(defconst factor-int-constant-def-regex + (factor-second-word-regex '("ALIEN:" "CHAR:" "NAN:"))) + +(defconst factor-type-definition-regex + (factor-second-word-regex + '("C-STRUCT:" "C-UNION:" "COM-INTERFACE:" "MIXIN:" "TUPLE:" "SINGLETON:" + "SPECIALIZED-ARRAY:" "STRUCT:" "UNION:" "UNION-STRUCT:"))) + +(defconst factor-error-regex + (factor-second-word-regex '("ERROR:"))) + +(defconst factor-tuple-decl-regex + "^TUPLE: +\\([^ \n]+\\) +< +\\([^ \n]+\\)\\_>") + +(defconst factor-constructor-regex + "<[^ >]+>") + +(defconst factor-getter-regex + "\\(^\\|\\_<\\)[^ ]+?>>\\_>") + +(defconst factor-setter-regex + "\\_<>>.+?\\_>") + +(defconst factor-symbol-definition-regex + (factor-second-word-regex '("&:" "SYMBOL:" "VAR:"))) + +(defconst factor-stack-effect-regex + "\\( ( [^\n]* )\\)\\|\\( (( [^\n]* ))\\)") + +(defconst factor-using-lines-regex "^USING: +\\([^;]+\\);") + +(defconst factor-use-line-regex "^USE: +\\(.*\\)$") + +(defconst factor-current-vocab-regex "^IN: +\\([^ \r\n\f]+\\)") + +(defconst factor-sub-vocab-regex "^<\\([^ \n]+\\) *$") + +(defconst factor-alien-function-regex + "\\_" " +\\(\\w+\\)\\( .*\\)?$") + + +;;; Font lock: + +(defconst factor-font-lock-keywords + `((,factor-stack-effect-regex . 'factor-font-lock-stack-effect) + (,factor-brace-words-regex 1 'factor-font-lock-parsing-word) + (,factor-alien-function-regex (1 'factor-font-lock-type-name) + (2 'factor-font-lock-word)) + (,factor-alien-function-alias-regex (1 'factor-font-lock-word) + (2 'factor-font-lock-type-name) + (3 'factor-font-lock-word)) + (,factor-alien-callback-regex (1 'factor-font-lock-type-name) + (2 'factor-font-lock-word)) + (,factor-vocab-ref-regexp 2 'factor-font-lock-vocabulary-name) + (,factor-constructor-decl-regex + (1 'factor-font-lock-word) + (2 'factor-font-lock-type-name) + (3 'factor-font-lock-invalid-syntax nil t)) + (,factor-typedef-regex (1 'factor-font-lock-type-name) + (2 'factor-font-lock-type-name) + (3 'factor-font-lock-invalid-syntax nil t)) + (,factor-c-global-regex (1 'factor-font-lock-type-name) + (2 'factor-font-lock-word) + (3 'factor-font-lock-invalid-syntax nil t)) + (,factor-c-type-regex (1 'factor-font-lock-type-name) + (2 'factor-font-lock-invalid-syntax nil t)) + (,factor-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)) + (,factor-declaration-words-regex . 'factor-font-lock-comment) + (,factor-word-definition-regex 2 'factor-font-lock-word) + (,factor-alias-definition-regex (1 'factor-font-lock-word) + (2 'factor-font-lock-word)) + (,factor-int-constant-def-regex 2 'factor-font-lock-constant) + (,factor-integer-regex . 'factor-font-lock-number) + (,factor-float-regex . 'factor-font-lock-number) + (,factor-ratio-regex . 'factor-font-lock-ratio) + (,factor-type-definition-regex 2 'factor-font-lock-type-name) + (,factor-error-regex 2 'factor-font-lock-error-form) + (,factor-method-definition-regex (1 'factor-font-lock-type-name) + (2 'factor-font-lock-word)) + (,factor-before-definition-regex (1 'factor-font-lock-type-name) + (2 'factor-font-lock-word)) + (,factor-after-definition-regex (1 'factor-font-lock-type-name) + (2 'factor-font-lock-word)) + (,factor-tuple-decl-regex 2 'factor-font-lock-type-name) + (,factor-constructor-regex . 'factor-font-lock-constructor) + (,factor-setter-regex . 'factor-font-lock-setter-word) + (,factor-getter-regex . 'factor-font-lock-getter-word) + (,factor-symbol-definition-regex 2 'factor-font-lock-symbol) + (,factor-bad-string-regex . 'factor-font-lock-invalid-syntax) + ("\\_<\\(P\\|SBUF\\|DLL\\)\"" 1 'factor-font-lock-parsing-word) + (,factor-constant-words-regex . 'factor-font-lock-constant) + (,factor-parsing-words-regex . 'factor-font-lock-parsing-word))) + + +;;; Source code analysis: + +(defsubst factor-brackets-depth () + (nth 0 (syntax-ppss))) + +(defsubst factor-brackets-start () + (nth 1 (syntax-ppss))) + +(defun factor-brackets-end () + (save-excursion + (goto-char (factor-brackets-start)) + (condition-case nil + (progn (forward-sexp) + (1- (point))) + (error -1)))) + +(defsubst factor-indentation-at (pos) + (save-excursion (goto-char pos) (current-indentation))) + +(defsubst factor-at-begin-of-def () + (looking-at factor-begin-of-def-regex)) + +(defsubst factor-at-begin-of-indent-def () + (looking-at factor-indent-def-start-regex)) + +(defsubst factor-at-end-of-def () + (looking-at factor-end-of-def-regex)) + +(defsubst factor-looking-at-emptiness () + (looking-at "^[ ]*$\\|$")) + +(defsubst factor-is-last-char (pos) + (save-excursion + (goto-char (1+ pos)) + (looking-at-p "[ ]*$"))) + +(defsubst factor-line-offset (pos) + (- pos (save-excursion + (goto-char pos) + (beginning-of-line) + (point)))) + +(defun factor-previous-non-blank () + (forward-line -1) + (while (and (not (bobp)) (factor-looking-at-emptiness)) + (forward-line -1))) + +(defsubst factor-beginning-of-defun (&optional times) + (re-search-backward factor-begin-of-def-regex nil t times)) + +(defsubst factor-end-of-defun () + (re-search-forward factor-end-of-def-regex nil t)) + +(defun factor-beginning-of-block-pos () + (save-excursion + (if (> (factor-brackets-depth) 0) + (factor-brackets-start) + (factor-beginning-of-defun) + (point)))) + +(defun factor-at-setter-line () + (save-excursion + (beginning-of-line) + (when (re-search-forward factor-setter-regex + (line-end-position) + t) + (let* ((to (match-beginning 0)) + (from (factor-beginning-of-block-pos))) + (goto-char from) + (let ((depth (factor-brackets-depth))) + (and (or (re-search-forward factor-constructor-regex to t) + (re-search-forward factor-setter-regex to t)) + (= depth (factor-brackets-depth)))))))) + +(defun factor-at-constructor-line () + (save-excursion + (beginning-of-line) + (re-search-forward factor-constructor-regex (line-end-position) t))) + +(defsubst factor-at-using () + (looking-at factor-using-lines-regex)) + +(defun factor-in-using () + (let ((p (point))) + (save-excursion + (and (re-search-backward "^USING: " nil t) + (re-search-forward " ;" nil t) + (< p (match-end 0)))))) + +(defsubst factor-end-of-defun-pos () + (save-excursion + (re-search-forward factor-end-of-def-regex nil t) + (point))) + +(defun factor-beginning-of-body () + (let ((p (point))) + (and (factor-beginning-of-defun) + (re-search-forward factor-defun-signature-regex p t) + (not (re-search-forward factor-end-of-def-regex p t))))) + +(defun factor-beginning-of-sexp () + (if (> (factor-brackets-depth) 0) + (goto-char (factor-brackets-start)) + (factor-beginning-of-body))) + +(defsubst factor-beginning-of-sexp-pos () + (save-excursion (factor-beginning-of-sexp) (point))) + + +;;; USING/IN: + +(defvar-local factor-current-vocab-function 'factor-find-in) + +(defsubst factor-current-vocab () + (funcall factor-current-vocab-function)) + +(defun factor-find-in () + (save-excursion + (when (re-search-backward factor-current-vocab-regex nil t) + (match-string-no-properties 1)))) + +(defvar-local factor-usings-function 'factor-find-usings) + +(defsubst factor-usings () + (funcall factor-usings-function)) + +(defun factor-file-has-private () + (save-excursion + (goto-char (point-min)) + (and (re-search-forward "\\_<" nil t) + (re-search-forward "\\_\\_>" nil t)))) + +(defun factor-find-usings (&optional no-private) + (save-excursion + (let ((usings)) + (goto-char (point-max)) + (while (re-search-backward factor-using-lines-regex nil t) + (dolist (u (split-string (match-string-no-properties 1) nil t)) + (push u usings))) + (when (and (not no-private) (factor-file-has-private)) + (goto-char (point-max)) + (push (concat (factor-find-in) ".private") usings)) + usings))) ;;; Indentation: -(make-variable-buffer-local - (defvar factor-mode-indent-width factor-mode-default-indent-width - "Indentation width in factor buffers. A local variable.")) +(defsubst factor-increased-indentation (&optional i) + (+ (or i (current-indentation)) factor-indent-level)) -(defun factor-mode--guess-indent-width () - "Chooses an indentation value from existing code." - (let ((word-cont "^ +[^ ]") - (iw)) - (save-excursion - (beginning-of-buffer) - (while (not iw) - (if (not (re-search-forward fuel-syntax--definition-start-regex nil t)) - (setq iw factor-mode-default-indent-width) - (forward-line) - (when (looking-at word-cont) - (setq iw (current-indentation)))))) - iw)) +(defsubst factor-decreased-indentation (&optional i) + (- (or i (current-indentation)) factor-indent-level)) -(defun factor-mode--indent-in-brackets () +(defun factor-indent-in-brackets () (save-excursion (beginning-of-line) - (when (> (fuel-syntax--brackets-depth) 0) - (let* ((bs (fuel-syntax--brackets-start)) - (be (fuel-syntax--brackets-end)) + (when (> (factor-brackets-depth) 0) + (let* ((bs (factor-brackets-start)) + (be (factor-brackets-end)) (ln (line-number-at-pos))) (when (> ln (line-number-at-pos bs)) (cond ((and (> be 0) (= (- be (point)) (current-indentation)) (= ln (line-number-at-pos be))) - (fuel-syntax--indentation-at bs)) - ((or (fuel-syntax--is-last-char bs) + (factor-indentation-at bs)) + ((or (factor-is-last-char bs) (not (eq ?\ (char-after (1+ bs))))) - (fuel-syntax--increased-indentation - (fuel-syntax--indentation-at bs))) - (t (+ 2 (fuel-syntax--line-offset bs))))))))) + (factor-increased-indentation + (factor-indentation-at bs))) + (t (+ 2 (factor-line-offset bs))))))))) -(defun factor-mode--indent-definition () +(defun factor-indent-definition () (save-excursion (beginning-of-line) - (when (fuel-syntax--at-begin-of-def) 0))) + (when (factor-at-begin-of-def) 0))) -(defsubst factor-mode--previous-non-empty () +(defsubst factor-previous-non-empty () (forward-line -1) (while (and (not (bobp)) - (fuel-syntax--looking-at-emptiness)) + (factor-looking-at-emptiness)) (forward-line -1))) -(defun factor-mode--indent-setter-line () - (when (fuel-syntax--at-setter-line) +(defun factor-indent-setter-line () + (when (factor-at-setter-line) (or (save-excursion - (let ((indent (and (fuel-syntax--at-constructor-line) + (let ((indent (and (factor-at-constructor-line) (current-indentation)))) (while (not (or indent (bobp) - (fuel-syntax--at-begin-of-def) - (fuel-syntax--at-end-of-def))) - (if (fuel-syntax--at-constructor-line) - (setq indent (fuel-syntax--increased-indentation)) + (factor-at-begin-of-def) + (factor-at-end-of-def))) + (if (factor-at-constructor-line) + (setq indent (factor-increased-indentation)) (forward-line -1))) indent)) (save-excursion - (factor-mode--previous-non-empty) + (factor-previous-non-empty) (current-indentation))))) -(defun factor-mode--indent-continuation () +(defun factor-indent-continuation () (save-excursion - (factor-mode--previous-non-empty) - (cond ((or (fuel-syntax--at-end-of-def) - (fuel-syntax--at-setter-line)) - (fuel-syntax--decreased-indentation)) - ((fuel-syntax--at-begin-of-indent-def) - (fuel-syntax--increased-indentation)) + (factor-previous-non-empty) + (cond ((or (factor-at-end-of-def) + (factor-at-setter-line)) + (factor-decreased-indentation)) + ((factor-at-begin-of-indent-def) + (factor-increased-indentation)) (t (current-indentation))))) -(defun factor-mode--calculate-indentation () +(defun factor-calculate-indentation () "Calculate Factor indentation for line at point." (or (and (bobp) 0) - (factor-mode--indent-definition) - (factor-mode--indent-in-brackets) - (factor-mode--indent-setter-line) - (factor-mode--indent-continuation) + (factor-indent-definition) + (factor-indent-in-brackets) + (factor-indent-setter-line) + (factor-indent-continuation) 0)) -(defun factor-mode--indent-line () - "Indent current line as Factor code" - (let ((target (factor-mode--calculate-indentation)) +(defun factor-indent-line (&optional ignored) + "Indents the current Factor line." + (interactive) + (let ((target (factor-calculate-indentation)) (pos (- (point-max) (point)))) (if (= target (current-indentation)) (if (< (current-column) (current-indentation)) @@ -177,39 +708,31 @@ code in the buffer." (if (> (- (point-max) pos) (point)) (goto-char (- (point-max) pos)))))) -(defun factor-mode--indentation-setup () - (set (make-local-variable 'indent-line-function) 'factor-mode--indent-line) - (setq factor-indent-width (factor-mode--guess-indent-width)) - (setq indent-tabs-mode nil)) - ;;; Buffer cycling: -(defconst factor-mode--cycle-endings +(defconst factor-cycle-endings '(".factor" "-tests.factor" "-docs.factor")) -(make-local-variable - (defvar factor-mode--cycling-no-ask nil)) - -(defvar factor-mode--cycle-ring - (let ((ring (make-ring (length factor-mode--cycle-endings)))) - (dolist (e factor-mode--cycle-endings ring) +(defvar factor-cycle-ring + (let ((ring (make-ring (length factor-cycle-endings)))) + (dolist (e factor-cycle-endings ring) (ring-insert ring e)) ring)) -(defconst factor-mode--cycle-basename-regex - (format "\\(.+?\\)\\(%s\\)$" (regexp-opt factor-mode--cycle-endings))) +(defconst factor-cycle-basename-regex + (format "\\(.+?\\)\\(%s\\)$" (regexp-opt factor-cycle-endings))) -(defun factor-mode--cycle-split (basename) - (when (string-match factor-mode--cycle-basename-regex basename) +(defun factor-cycle-split (basename) + (when (string-match factor-cycle-basename-regex basename) (cons (match-string 1 basename) (match-string 2 basename)))) -(defun factor-mode--cycle-next (file skip) +(defun factor-cycle-next (file skip) (let* ((dir (file-name-directory file)) (basename (file-name-nondirectory file)) - (p/s (factor-mode--cycle-split basename)) + (p/s (factor-cycle-split basename)) (prefix (car p/s)) - (ring factor-mode--cycle-ring) + (ring factor-cycle-ring) (idx (or (ring-member ring (cdr p/s)) 0)) (len (ring-size ring)) (i 1) @@ -219,37 +742,21 @@ code in the buffer." (path (expand-file-name (concat prefix suffix) dir))) (when (or (file-exists-p path) (and (not skip) - (not (member suffix factor-mode--cycling-no-ask)) + (not (member suffix factor-cycling-no-ask)) (y-or-n-p (format "Create %s? " path)))) (setq result path)) - (when (and (not factor-mode-cycle-always-ask-p) - (not (member suffix factor-mode--cycling-no-ask))) - (setq factor-mode--cycling-no-ask - (cons name factor-mode--cycling-no-ask)))) + (when (and (not factor-cycle-always-ask-p) + (not (member suffix factor-cycling-no-ask))) + (setq factor-cycling-no-ask + (cons name factor-cycling-no-ask)))) (setq i (1+ i))) result)) -(defsubst factor-mode--cycling-setup () - (setq factor-mode--cycling-no-ask nil)) - -(defun factor-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))))) - -(defsubst factor-mode--in-docs (&optional file) - (factor-mode--code-file "docs")) - -(defsubst factor-mode--in-tests (&optional file) - (factor-mode--code-file "tests")) - -(defun factor-mode-visit-other-file (&optional create) +(defun factor-visit-other-file (&optional create) "Cycle between code, tests and docs factor files. With prefix, non-existing files will be created." (interactive "P") - (let ((file (factor-mode--cycle-next (buffer-file-name) (not create)))) + (let ((file (factor-cycle-next (buffer-file-name) (not create)))) (unless file (error "No other file found")) (find-file file) (unless (file-exists-p file) @@ -257,45 +764,83 @@ With prefix, non-existing files will be created." (save-buffer)))) -;;; Keymap: +;;; factor-mode: -(defun factor-mode--insert-and-indent (n) - (interactive "*p") - (let ((start (point))) - (self-insert-command n) - (save-excursion (font-lock-fontify-region start (point)))) - (indent-according-to-mode)) +(defvar factor-mode-syntax-table + (let ((table (make-syntax-table prog-mode-syntax-table))) + (modify-syntax-entry ?\" "\"" table) + (modify-syntax-entry ?! "< 2b" table) + (modify-syntax-entry ?\n "> b" table) + (modify-syntax-entry ?# "_ 1b" table) + (modify-syntax-entry ?$ "_" table) + (modify-syntax-entry ?@ "_" table) + (modify-syntax-entry ?? "_" table) + (modify-syntax-entry ?_ "_" table) + (modify-syntax-entry ?: "_" table) + (modify-syntax-entry ?< "_" table) + (modify-syntax-entry ?> "_" table) + (modify-syntax-entry ?& "_" table) + (modify-syntax-entry ?| "_" table) + (modify-syntax-entry ?% "_" table) + (modify-syntax-entry ?= "_" table) + (modify-syntax-entry ?/ "_" table) + (modify-syntax-entry ?+ "_" table) + (modify-syntax-entry ?* "_" table) + (modify-syntax-entry ?- "_" table) + (modify-syntax-entry ?\; "_" table) + (modify-syntax-entry ?\( "()" table) + (modify-syntax-entry ?\) ")(" table) + (modify-syntax-entry ?\{ "(}" table) + (modify-syntax-entry ?\} "){" table) + (modify-syntax-entry ?\[ "(]" table) + (modify-syntax-entry ?\] ")[" table) + table)) -(defvar factor-mode-map - (let ((map (make-sparse-keymap))) - (define-key map [?\]] 'factor-mode--insert-and-indent) - (define-key map [?}] 'factor-mode--insert-and-indent) - (define-key map "\C-m" 'newline-and-indent) - (define-key map "\C-c\C-o" 'factor-mode-visit-other-file) - map)) +(defun factor-font-lock-string (str) + "Fontify STR as if it was Factor code." + (with-temp-buffer + (set-syntax-table factor-mode-syntax-table) + (setq-local parse-sexp-ignore-comments t) + (setq-local parse-sexp-lookup-properties t) + (setq-local font-lock-defaults '(factor-font-lock-keywords nil nil nil nil)) -(defun factor-mode--keymap-setup () - (use-local-map factor-mode-map)) - - -;;; Factor mode: + (insert str) + (let ((font-lock-verbose nil)) + (font-lock-fontify-buffer)) + (buffer-string))) ;;;###autoload -(defun factor-mode () +(define-derived-mode factor-mode prog-mode "Factor" "A mode for editing programs written in the Factor programming language. \\{factor-mode-map}" - (interactive) - (kill-all-local-variables) - (setq major-mode 'factor-mode) - (setq mode-name "Factor") - (fuel-font-lock--font-lock-setup) - (factor-mode--keymap-setup) - (factor-mode--indentation-setup) - (factor-mode--syntax-setup) - (factor-mode--cycling-setup) - (when factor-mode-use-fuel (require 'fuel-mode) (fuel-mode)) - (run-hooks 'factor-mode-hook)) + + (setq-local comment-start "! ") + (setq-local comment-end "") + (setq-local comment-column factor-comment-column) + (setq-local comment-start-skip "!+ *") + (setq-local parse-sexp-ignore-comments t) + (setq-local parse-sexp-lookup-properties t) + (setq-local font-lock-defaults '(factor-font-lock-keywords nil nil nil nil)) + + (define-key factor-mode-map [remap ff-get-other-file] + 'factor-visit-other-file) + + (setq-local electric-indent-chars + (append '(?\] ?\} ?\n) electric-indent-chars)) + + (setq-local indent-line-function 'factor-indent-line) + (setq-local indent-tabs-mode factor-indent-tabs-mode) + + (setq-local beginning-of-defun-function 'factor-beginning-of-defun) + (setq-local end-of-defun-function 'factor-end-of-defun)) + +;;;###autoload +(add-to-list 'auto-mode-alist '("\\.factor\\'" . factor-mode)) + +;;;###autoload +(add-to-list 'interpreter-mode-alist '("factor" . factor-mode)) (provide 'factor-mode) + ;;; factor-mode.el ends here diff --git a/misc/fuel/fu.el b/misc/fuel/fu.el deleted file mode 100644 index 01ec0d60e6..0000000000 --- a/misc/fuel/fu.el +++ /dev/null @@ -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 -;; 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 diff --git a/misc/fuel/fuel-autodoc.el b/misc/fuel/fuel-autodoc.el index d02e4fcfb9..1bf88f2f43 100644 --- a/misc/fuel/fuel-autodoc.el +++ b/misc/fuel/fuel-autodoc.el @@ -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 diff --git a/misc/fuel/fuel-autohelp.el b/misc/fuel/fuel-autohelp.el new file mode 100644 index 0000000000..e7dbd843b4 --- /dev/null +++ b/misc/fuel/fuel-autohelp.el @@ -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 +;; 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 diff --git a/misc/fuel/fuel-base.el b/misc/fuel/fuel-base.el index 5e8364e3a7..3300c38b2d 100644 --- a/misc/fuel/fuel-base.el +++ b/misc/fuel/fuel-base.el @@ -4,7 +4,7 @@ ;; See http://factorcode.org/license.txt for BSD license. ;; Author: Jose Antonio Ortega Ruiz -;; 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 diff --git a/misc/fuel/fuel-completion.el b/misc/fuel/fuel-completion.el index 8d78225273..50325af776 100644 --- a/misc/fuel/fuel-completion.el +++ b/misc/fuel/fuel-completion.el @@ -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))))))) diff --git a/misc/fuel/fuel-connection.el b/misc/fuel/fuel-connection.el index 824f21d62b..e6e98c542a 100644 --- a/misc/fuel/fuel-connection.el +++ b/misc/fuel/fuel-connection.el @@ -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 diff --git a/misc/fuel/fuel-debug-uses.el b/misc/fuel/fuel-debug-uses.el index 8b25744011..36076a2637 100644 --- a/misc/fuel/fuel-debug-uses.el +++ b/misc/fuel/fuel-debug-uses.el @@ -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 diff --git a/misc/fuel/fuel-debug.el b/misc/fuel/fuel-debug.el index 07da0d2d3c..7cedfb0fbc 100644 --- a/misc/fuel/fuel-debug.el +++ b/misc/fuel/fuel-debug.el @@ -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 diff --git a/misc/fuel/fuel-edit.el b/misc/fuel/fuel-edit.el index f89e2b3eb8..ae022f0b87 100644 --- a/misc/fuel/fuel-edit.el +++ b/misc/fuel/fuel-edit.el @@ -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))) diff --git a/misc/fuel/fuel-eval.el b/misc/fuel/fuel-eval.el index 985722854f..76c6708101 100644 --- a/misc/fuel/fuel-eval.el +++ b/misc/fuel/fuel-eval.el @@ -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 diff --git a/misc/fuel/fuel-font-lock.el b/misc/fuel/fuel-font-lock.el deleted file mode 100644 index d54b0cd337..0000000000 --- a/misc/fuel/fuel-font-lock.el +++ /dev/null @@ -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 -;; 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 ()") - (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 diff --git a/misc/fuel/fuel-help.el b/misc/fuel/fuel-help.el index 5edcea651f..30534b706e 100644 --- a/misc/fuel/fuel-help.el +++ b/misc/fuel/fuel-help.el @@ -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) diff --git a/misc/fuel/fuel-listener.el b/misc/fuel/fuel-listener.el index d9c3a0d16f..ea4392f1bd 100644 --- a/misc/fuel/fuel-listener.el +++ b/misc/fuel/fuel-listener.el @@ -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 diff --git a/misc/fuel/fuel-log.el b/misc/fuel/fuel-log.el index ab8b636a6a..09c80fc190 100644 --- a/misc/fuel/fuel-log.el +++ b/misc/fuel/fuel-log.el @@ -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 diff --git a/misc/fuel/fuel-markup.el b/misc/fuel/fuel-markup.el index b9095a39bb..11e7ad927b 100644 --- a/misc/fuel/fuel-markup.el +++ b/misc/fuel/fuel-markup.el @@ -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 diff --git a/misc/fuel/fuel-menu.el b/misc/fuel/fuel-menu.el index 6abcd82172..e1060e9aca 100644 --- a/misc/fuel/fuel-menu.el +++ b/misc/fuel/fuel-menu.el @@ -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 diff --git a/misc/fuel/fuel-mode.el b/misc/fuel/fuel-mode.el index ecee020b54..8a4a51b718 100644 --- a/misc/fuel/fuel-mode.el +++ b/misc/fuel/fuel-mode.el @@ -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 diff --git a/misc/fuel/fuel-pkg.el b/misc/fuel/fuel-pkg.el deleted file mode 100644 index 21e5250918..0000000000 --- a/misc/fuel/fuel-pkg.el +++ /dev/null @@ -1,3 +0,0 @@ -(define-package "fuel" "1.0" - "Factor's Ultimate Emacs Library" - nil) diff --git a/misc/fuel/fuel-popup.el b/misc/fuel/fuel-popup.el index b8a967d3b0..2b63130f24 100644 --- a/misc/fuel/fuel-popup.el +++ b/misc/fuel/fuel-popup.el @@ -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 diff --git a/misc/fuel/fuel-refactor.el b/misc/fuel/fuel-refactor.el index a410bb5047..e5e2a50d27 100644 --- a/misc/fuel/fuel-refactor.el +++ b/misc/fuel/fuel-refactor.el @@ -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 diff --git a/misc/fuel/fuel-scaffold.el b/misc/fuel/fuel-scaffold.el index 0078300fd1..196ed83b0e 100644 --- a/misc/fuel/fuel-scaffold.el +++ b/misc/fuel/fuel-scaffold.el @@ -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 diff --git a/misc/fuel/fuel-stack.el b/misc/fuel/fuel-stack.el index 7329848aa2..51642372cb 100644 --- a/misc/fuel/fuel-stack.el +++ b/misc/fuel/fuel-stack.el @@ -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")))) diff --git a/misc/fuel/fuel-syntax.el b/misc/fuel/fuel-syntax.el deleted file mode 100644 index e7d4f0ef17..0000000000 --- a/misc/fuel/fuel-syntax.el +++ /dev/null @@ -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 -;; 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 - '(":" "::" ";" "&:" "<<" ">" - "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 - "\\_" " +\\(\\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 "\\_>" (1 ">b")) - ("\\( \\|^\\)\\(DLL\\|P\\|SBUF\\)?\\(\"\\)\\(\\([^\n\r\f\"\\]\\|\\\\.\\)*\\)\\(\"\\)" - (3 "\"") (6 "\"")) - ("CHAR: \\(\"\\) [^\\\"]*?\\(\"\\)\\([^\\\"]\\|\\\\.\\)*?\\(\"\\)" - (1 "w") (2 "b")) - ("\\(CHAR:\\|\\\\\\) \\(\\w\\|!\\)\\( \\|$\\)" (2 "w")) - ;; Comments - ("\\_<\\(#?!\\) .*\\(\n\\|$\\)" (1 "<") (2 ">")) - ("\\_<\\(#?!\\)\\(\n\\|$\\)" (1 "<") (2 ">")) - ;; postpone - ("\\_b")) - ;; Multiline constructs - ("\\_<\\(E\\)BNF:\\( \\|\n\\)" (1 "" (1 ">b")) - ("\\_<\\(U\\)SING: \\(;\\)" (1 "b")) - ("\\_b")) - ("\\_\\)" (1 "\\)" - (2 "" (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 "\\_<" nil t) - (re-search-forward "\\_\\_>" 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 diff --git a/misc/fuel/fuel-table.el b/misc/fuel/fuel-table.el index 1af2e25712..fd86429034 100644 --- a/misc/fuel/fuel-table.el +++ b/misc/fuel/fuel-table.el @@ -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 diff --git a/misc/fuel/fuel-xref.el b/misc/fuel/fuel-xref.el index 480540262f..53e2902f6a 100644 --- a/misc/fuel/fuel-xref.el +++ b/misc/fuel/fuel-xref.el @@ -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