FUEL: New command: fuel-refactor-extract-vocab.

extra/fuel/fuel.factor

@@ -169,3 +169,5 @@ MEMO: fuel-get-article-title ( name -- )
     developer-name set
     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 ;

misc/fuel/fuel-mode.el

@@ -196,6 +196,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 ?d ?> 'fuel-show-callees)
 (fuel-mode--key ?d ?< 'fuel-show-callers)

misc/fuel/fuel-refactor.el

@@ -13,6 +13,7 @@
 
 ;;; Code:
 
+(require 'fuel-scaffold)
 (require 'fuel-stack)
 (require 'fuel-syntax)
 (require 'fuel-base)
@@ -70,7 +71,46 @@ word."
                                 (if (looking-at-p ";") (point)
                                   (fuel-syntax--end-of-symbol-pos))))
 
+
+;;; Extract vocab:
 
+(defun fuel-refactor--insert-using (vocab)
+  (save-excursion
+    (goto-char (point-min))
+    (let ((usings (sort (cons vocab (fuel-syntax--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-refactor--extract-vocab (begin end)
+  (when (< begin end)
+    (let* ((str (buffer-substring begin end))
+           (buffer (current-buffer))
+           (vocab (fuel-syntax--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)))
+      (with-current-buffer buffer
+        (delete-region begin end)
+        (fuel-refactor--insert-using vocab))
+      (newline)
+      (insert str)
+      (newline)
+      (save-buffer)
+      (fuel-update-usings))))
+
+(defun fuel-refactor-extract-vocab (begin end)
+  "Creates a new vocab with the words in current region.
+The region is extended to the closest definition boundaries."
+  (interactive "r")
+  (fuel-refactor--extract-vocab (save-excursion (goto-char begin)
+                                                (mark-defun)
+                                                (point))
+                                (save-excursion (goto-char end)
+                                                (mark-defun)
+                                                (mark))))
 
 (provide 'fuel-refactor)
 ;;; fuel-refactor.el ends here

misc/fuel/fuel-scaffold.el

@@ -41,25 +41,26 @@
 
 ;;; User interface:
 
-(defun fuel-scaffold-vocab ()
+(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, tests and authors.txt files.
 
 You can configure `fuel-scaffold-developer-name' (set by default to
 `user-full-name') for the name to be inserted in the generated files."
   (interactive)
-  (let* ((name (read-string "Vocab name: "))
+  (let* ((name (read-string "Vocab name: " name-hint))
          (root (completing-read "Vocab root: "
                                 (fuel-scaffold--vocab-roots)
-                                nil t "resource:"))
+                                nil t (or root-hint "resource:")))
          (cmd `(:fuel* ((,root ,name ,fuel-scaffold-developer-name)
                         (fuel-scaffold-vocab)) "fuel"))
          (ret (fuel-eval--send/wait cmd))
          (file (fuel-eval--retort-result ret)))
     (unless file
       (error "Error creating vocab (%s)" (car (fuel-eval--retort-error ret))))
-    (find-file file)
+    (if other-window (find-file-other-window file) (find-file file))
-    (goto-char (point-max))))
+    (goto-char (point-max))
+    name))
 
 (defun fuel-scaffold-help (&optional arg)
   "Creates, if it does not already exist, a help file with