diff --git a/extra/fuel/fuel.factor b/extra/fuel/fuel.factor
index a399ab2776..46d6ba12c7 100644
--- a/extra/fuel/fuel.factor
+++ b/extra/fuel/fuel.factor
@@ -148,6 +148,8 @@ MEMO: fuel-get-article-title ( name -- )
: fuel-word-see ( name -- ) (fuel-word-see) fuel-eval-set-result ;
+: fuel-word-def ( name -- ) (fuel-word-def) fuel-eval-set-result ;
+
: fuel-vocab-help ( name -- ) (fuel-vocab-help) fuel-eval-set-result ;
: fuel-vocab-summary ( name -- )
@@ -170,4 +172,5 @@ MEMO: fuel-get-article-title ( name -- )
dup require dup scaffold-help vocab-docs-path
(normalize-path) fuel-eval-set-result ;
-: fuel-scaffold-get-root ( name -- ) find-vocab-root fuel-eval-set-result ;
\ No newline at end of file
+: fuel-scaffold-get-root ( name -- ) find-vocab-root fuel-eval-set-result ;
+
diff --git a/extra/fuel/help/help.factor b/extra/fuel/help/help.factor
index 537e92ddd8..298124ffb4 100644
--- a/extra/fuel/help/help.factor
+++ b/extra/fuel/help/help.factor
@@ -87,13 +87,16 @@ SYMBOL: vocab-list
PRIVATE>
-: (fuel-word-help) ( object -- object )
+: (fuel-word-help) ( name -- elem )
fuel-find-word [ [ auto-use? on (fuel-word-element) ] with-scope ] [ f ] if* ;
: (fuel-word-see) ( word -- elem )
[ name>> \ article swap ]
[ [ see ] with-string-writer \ $code swap 2array ] bi 3array ; inline
+: (fuel-word-def) ( name -- str )
+ fuel-find-word [ [ def>> pprint ] with-string-writer ] when* ; inline
+
: (fuel-vocab-summary) ( name -- str ) >vocab-link summary ; inline
: (fuel-vocab-help) ( name -- str )
diff --git a/misc/fuel/README b/misc/fuel/README
index 41dabe564e..eb280d796c 100644
--- a/misc/fuel/README
+++ b/misc/fuel/README
@@ -80,7 +80,8 @@ beast.
- C-cz : switch to listener
- C-co : cycle between code, tests and docs factor files
- - M-. : edit word at point in Emacs
+ - M-. : edit word at point in Emacs (see fuel-edit-word-method custom var)
+ - M-, : go back to where M-. was last invoked
- M-TAB : complete word at point
- C-cC-eu : update USING: line
- C-cC-ev : edit vocabulary (M-x fuel-edit-vocabulary)
@@ -104,6 +105,7 @@ beast.
- C-cC-xs : extract innermost sexp (up to point) as a separate word
- C-cC-xr : extract region as a separate word
+ - C-cC-xi : replace word at point by its definition
- C-cC-xv : extract region as a separate vocabulary
*** In the listener:
diff --git a/misc/fuel/fuel-edit.el b/misc/fuel/fuel-edit.el
index e5988d1392..20e1f1eb01 100644
--- a/misc/fuel/fuel-edit.el
+++ b/misc/fuel/fuel-edit.el
@@ -17,6 +17,19 @@
(require 'fuel-eval)
(require 'fuel-base)
+(require 'etags)
+
+
+;;; Customization
+
+(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:
@@ -27,7 +40,9 @@
(error "Couldn't find edit location"))
(unless (file-readable-p (car loc))
(error "Couldn't open '%s' for read" (car loc)))
- (find-file-other-window (car loc))
+ (cond ((eq fuel-edit-word-method 'window) (find-file-other-window (car loc)))
+ ((eq fuel-edit-word-method 'frame) (find-file-other-frame (car loc)))
+ (t (find-file (car loc))))
(goto-line (if (numberp (cadr loc)) (cadr loc) 1))))
(defun fuel-edit--read-vocabulary-name (refresh)
@@ -46,6 +61,7 @@
(defvar fuel-edit--word-history nil)
(defvar fuel-edit--vocab-history nil)
+(defvar fuel-edit--previous-location nil)
(defun fuel-edit-vocabulary (&optional refresh vocab)
"Visits vocabulary file in Emacs.
@@ -74,10 +90,12 @@ With prefix, asks for the word to edit."
(interactive "P")
(let* ((word (or (and (not arg) (fuel-syntax-symbol-at-point))
(fuel-completion--read-word "Edit word: ")))
- (cmd `(:fuel* ((:quote ,word) fuel-get-edit-location))))
+ (cmd `(:fuel* ((:quote ,word) fuel-get-edit-location)))
+ (marker (and (not arg) (point-marker))))
(condition-case nil
(fuel-edit--try-edit (fuel-eval--send/wait cmd))
- (error (fuel-edit-vocabulary nil word)))))
+ (error (fuel-edit-vocabulary nil word)))
+ (when marker (ring-insert find-tag-marker-ring marker))))
(defun fuel-edit-word-doc-at-point (&optional arg word)
"Opens a new window visiting the documentation file for the word at point.
@@ -86,7 +104,8 @@ With prefix, asks for the word to edit."
(let* ((word (or word
(and (not arg) (fuel-syntax-symbol-at-point))
(fuel-completion--read-word "Edit word: ")))
- (cmd `(:fuel* ((:quote ,word) fuel-get-doc-location))))
+ (cmd `(:fuel* ((:quote ,word) fuel-get-doc-location)))
+ (marker (and (not arg) (point-marker))))
(condition-case nil
(fuel-edit--try-edit (fuel-eval--send/wait cmd))
(error
@@ -95,10 +114,19 @@ With prefix, asks for the word to edit."
(y-or-n-p (concat "No documentation found. "
"Do you want to open the vocab's "
"doc file? ")))
+ (when marker (ring-insert find-tag-marker-ring marker))
(find-file-other-window
(format "%s-docs.factor"
(file-name-sans-extension (buffer-file-name)))))))))
+(defun fuel-edit-pop-edit-word-stack ()
+ "Pop back to where \\[fuel-edit-word-at-point] or \\[fuel-edit-word-doc-at-point]
+was last invoked."
+ (interactive)
+ (condition-case nil
+ (pop-tag-mark)
+ (error "No previous location for find word or vocab invokation")))
+
(provide 'fuel-edit)
;;; fuel-edit.el ends here
diff --git a/misc/fuel/fuel-font-lock.el b/misc/fuel/fuel-font-lock.el
index 7b129eef2a..99a7c7b8fb 100644
--- a/misc/fuel/fuel-font-lock.el
+++ b/misc/fuel/fuel-font-lock.el
@@ -66,7 +66,8 @@
(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")))
+ (word function-name "word, generic or method being defined")
+ (invalid-syntax warning "syntactically invalid constructs")))
;;; Font lock:
@@ -92,8 +93,8 @@
(,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))
- "Font lock keywords definition for Factor mode.")
+ (,fuel-syntax--symbol-definition-regex 2 'factor-font-lock-symbol)
+ (,fuel-syntax--bad-string-regex . 'factor-font-lock-invalid-syntax)))
(defun fuel-font-lock--font-lock-setup (&optional keywords no-syntax)
(set (make-local-variable 'comment-start) "! ")
diff --git a/misc/fuel/fuel-mode.el b/misc/fuel/fuel-mode.el
index ed0104d1cb..9936d052fc 100644
--- a/misc/fuel/fuel-mode.el
+++ b/misc/fuel/fuel-mode.el
@@ -181,6 +181,7 @@ interacting with a factor listener is at your disposal.
(define-key fuel-mode-map "\C-\M-x" 'fuel-eval-definition)
(define-key fuel-mode-map "\C-\M-r" 'fuel-eval-extended-region)
(define-key fuel-mode-map "\M-." 'fuel-edit-word-at-point)
+(define-key fuel-mode-map "\M-," 'fuel-edit-pop-edit-word-stack)
(define-key fuel-mode-map "\C-c\M-<" 'fuel-show-callers)
(define-key fuel-mode-map "\C-c\M->" 'fuel-show-callees)
(define-key fuel-mode-map (kbd "M-TAB") 'fuel-completion--complete-symbol)
@@ -197,6 +198,7 @@ interacting with a factor listener is at your disposal.
(fuel-mode--key ?x ?s 'fuel-refactor-extract-sexp)
(fuel-mode--key ?x ?r 'fuel-refactor-extract-region)
(fuel-mode--key ?x ?v 'fuel-refactor-extract-vocab)
+(fuel-mode--key ?x ?i 'fuel-refactor-inline-word)
(fuel-mode--key ?d ?> 'fuel-show-callees)
(fuel-mode--key ?d ?< 'fuel-show-callers)
diff --git a/misc/fuel/fuel-refactor.el b/misc/fuel/fuel-refactor.el
index 38367b4cd8..788033cf88 100644
--- a/misc/fuel/fuel-refactor.el
+++ b/misc/fuel/fuel-refactor.el
@@ -18,36 +18,106 @@
(require 'fuel-syntax)
(require 'fuel-base)
+
+;;; Word definitions in buffer
+
+(defconst fuel-refactor--next-defun-regex
+ (format "^\\(:\\|MEMO:\\|MACRO:\\):? +\\(\\w+\\)\\(%s\\)\\([^;]+?\\) ;\\_>"
+ fuel-syntax--stack-effect-regex))
+
+(defun fuel-refactor--previous-defun ()
+ (let ((pos) (result))
+ (while (and (not result)
+ (setq pos (fuel-syntax--beginning-of-defun)))
+ (setq result (looking-at fuel-refactor--next-defun-regex)))
+ (when (and result pos)
+ (let ((name (match-string-no-properties 2))
+ (body (match-string-no-properties 4))
+ (end (match-end 0)))
+ (list (split-string body nil t) name pos end)))))
+
+(defun fuel-refactor--find (code to)
+ (let ((candidate) (result))
+ (while (and (not result)
+ (setq candidate (fuel-refactor--previous-defun))
+ (> (point) to))
+ (when (equal (car candidate) code)
+ (setq result (cdr candidate))))
+ result))
+
+(defun fuel-refactor--reuse-p (word)
+ (save-excursion
+ (mark-defun)
+ (move-overlay fuel-stack--overlay (1+ (point)) (mark))
+ (unwind-protect
+ (and (y-or-n-p (format "Use existing word '%s'? " word)) word)
+ (delete-overlay fuel-stack--overlay))))
+
+(defun fuel-refactor--code-rx (code)
+ (let ((words (split-string code nil t)))
+ (mapconcat 'regexp-quote words "[ \n\f\r]+")))
+
;;; Extract word:
+(defun fuel-refactor--reuse-existing (code)
+ (save-excursion
+ (mark-defun)
+ (let ((code (split-string (substring-no-properties code) nil t))
+ (down (mark))
+ (found)
+ (result))
+ (while (and (not result)
+ (setq found (fuel-refactor--find code (point-min))))
+ (when found (setq result (fuel-refactor--reuse-p (car found)))))
+ (goto-char (point-max))
+ (while (and (not result)
+ (setq found (fuel-refactor--find code down)))
+ (when found (setq result (fuel-refactor--reuse-p (car found)))))
+ (and result found))))
+
+(defun fuel-refactor--insert-word (word stack-effect code)
+ (let ((beg (save-excursion (fuel-syntax--beginning-of-defun) (point)))
+ (end (save-excursion
+ (re-search-backward fuel-syntax--end-of-def-regex nil t)
+ (forward-line 1)
+ (skip-syntax-forward "-"))))
+ (let ((start (goto-char (max beg end))))
+ (open-line 1)
+ (insert ": " word " " stack-effect "\n" code " ;\n")
+ (indent-region start (point))
+ (move-overlay fuel-stack--overlay start (point)))))
+
+(defun fuel-refactor--extract-other (start end code)
+ (unwind-protect
+ (when (y-or-n-p "Apply refactoring to rest of buffer? ")
+ (save-excursion
+ (let ((rx (fuel-refactor--code-rx code))
+ (end (point)))
+ (query-replace-regexp rx word t (point-min) start)
+ (query-replace-regexp rx word t end (point-max)))))
+ (delete-overlay fuel-stack--overlay)))
+
(defun fuel-refactor--extract (begin end)
- (let* ((word (read-string "New word name: "))
- (code (buffer-substring begin end))
- (code-str (fuel--region-to-string begin end))
- (stack-effect (or (fuel-stack--infer-effect code-str)
- (read-string "Stack effect: "))))
- (unless (< begin end) (error "No proper region to extract"))
+ (unless (< begin end) (error "No proper region to extract"))
+ (let* ((code (buffer-substring begin end))
+ (existing (fuel-refactor--reuse-existing code))
+ (code-str (or existing (fuel--region-to-string begin end)))
+ (stack-effect (or existing
+ (fuel-stack--infer-effect code-str)
+ (read-string "Stack effect: ")))
+ (word (or (car existing) (read-string "New word name: "))))
(goto-char begin)
(delete-region begin end)
(insert word)
(indent-region begin (point))
- (set-mark (point))
- (let ((beg (save-excursion (fuel-syntax--beginning-of-defun) (point)))
- (end (save-excursion
- (re-search-backward fuel-syntax--end-of-def-regex nil t)
- (forward-line 1)
- (skip-syntax-forward "-")
- (point))))
- (goto-char (max beg end)))
- (open-line 1)
- (let ((start (point)))
- (insert ": " word " " stack-effect "\n" code " ;\n")
- (indent-region start (point))
- (move-overlay fuel-stack--overlay start (point))
- (goto-char (mark))
- (sit-for fuel-stack-highlight-period)
- (delete-overlay fuel-stack--overlay))))
+ (save-excursion
+ (let ((start (or (cadr existing) (point))))
+ (unless existing
+ (fuel-refactor--insert-word word stack-effect code))
+ (fuel-refactor--extract-other start
+ (or (car (cddr existing)) (point))
+ code)))))
(defun fuel-refactor-extract-region (begin end)
"Extracts current region as a separate word."
@@ -71,6 +141,29 @@ word."
(if (looking-at-p ";") (point)
(fuel-syntax--end-of-symbol-pos))))
+
+;;; Inline word:
+
+(defun fuel-refactor--word-def (word)
+ (let ((def (fuel-eval--retort-result
+ (fuel-eval--send/wait `(:fuel* (,word fuel-word-def) "fuel")))))
+ (when def
+ (substring (substring def 2) 0 -2))))
+
+(defun fuel-refactor-inline-word ()
+ "Inserts definition of word at point."
+ (interactive)
+ (let ((word (fuel-syntax-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)
+ (kill-word 1)
+ (let ((start (point)))
+ (insert code)
+ (save-excursion (font-lock-fontify-region start (point)))
+ (indent-region start (point))))))
+
;;; Extract vocab:
diff --git a/misc/fuel/fuel-syntax.el b/misc/fuel/fuel-syntax.el
index be7293f181..7f0fa313c2 100644
--- a/misc/fuel/fuel-syntax.el
+++ b/misc/fuel/fuel-syntax.el
@@ -93,6 +93,9 @@
(defconst fuel-syntax--float-regex
"\\_<-?[0-9]+\\.[0-9]*\\([eE][+-]?[0-9]+\\)?\\_>")
+(defconst fuel-syntax--bad-string-regex
+ "\"[^\"]*$")
+
(defconst fuel-syntax--word-definition-regex
(fuel-syntax--second-word-regex
'(":" "::" "GENERIC:" "DEFER:" "HOOK:" "MAIN:" "MATH:" "POSTPONE:"
@@ -211,8 +214,7 @@
(modify-syntax-entry ?\ " " table)
(modify-syntax-entry ?\n " " table)
- ;; Strings
- (modify-syntax-entry ?\" "\"" table)
+ ;; Char quote
(modify-syntax-entry ?\\ "/" table)
table))
@@ -223,6 +225,8 @@
("\\_<\\(#?!\\)\\(\n\\|$\\)" (1 "<") (2 ">"))
;; CHARs:
("CHAR: \\(.\\)\\( \\|$\\)" (1 "w"))
+ ;; Strings
+ ("\\(\"\\)[^\n\r\f]*\\(\"\\)" (1 "\"") (2 "\""))
;; Let and lambda:
("\\_<\\(!(\\) .* \\()\\)" (1 "<") (2 ">"))
("\\(\\[\\)\\(let\\|wlet\\|let\\*\\)\\( \\|$\\)" (1 "(]"))