Merge branch 'master' of git://github.com/seckar/factor

extra/fuel/fuel-tests.factor

@@ -0,0 +1,33 @@
+! Copyright (C) 2009 Nicholas Seckar.
+! See http://factorcode.org/license.txt for BSD license.
+USING: continuations eval fuel fuel.private namespaces tools.test words ;
+IN: fuel.tests
+
+: fake-continuation ( -- continuation )
+    f f f "fake" f <continuation> ;
+
+: make-uses-restart ( -- restart )
+    "Use the words vocabulary" \ word?
+    fake-continuation <restart> ;
+
+: make-defer-restart ( -- restart )
+    "Defer word in current vocabulary" f
+    fake-continuation <restart> ;
+
+{ f } [ make-defer-restart is-use-restart ] unit-test
+{ t } [ make-uses-restart is-use-restart ] unit-test
+
+{ "words" } [ make-uses-restart get-restart-vocab ] unit-test
+
+{ f } [ make-defer-restart is-suggested-restart ] unit-test
+{ f } [ make-uses-restart is-suggested-restart ] unit-test
+{ f } [ { "io" } :uses-suggestions
+        [ make-uses-restart is-suggested-restart ] with-variable
+] unit-test
+{ t } [ { "words" } :uses-suggestions
+        [ make-uses-restart is-suggested-restart ] with-variable
+] unit-test
+
+{ } [
+    { "kernel" } [ "\\ dup drop" eval( -- ) ] fuel-use-suggested-vocabs
+] unit-test

extra/fuel/fuel.factor

@@ -1,9 +1,9 @@
 ! Copyright (C) 2008, 2009 Jose Antonio Ortega Ruiz.
 ! See http://factorcode.org/license.txt for BSD license.
 
-USING: assocs compiler.units fuel.eval fuel.help fuel.remote fuel.xref
+USING: accessors assocs compiler.units continuations fuel.eval fuel.help
-help.topics io.pathnames kernel namespaces parser sequences
+fuel.remote fuel.xref help.topics io.pathnames kernel namespaces parser
-tools.scaffold vocabs.loader ;
+sequences tools.scaffold vocabs.loader words ;
 
 IN: fuel
 
@@ -28,6 +28,22 @@ IN: fuel
 <PRIVATE
 
 SYMBOL: :uses
+SYMBOL: :uses-suggestions
+
+: is-use-restart ( restart -- ? )
+    name>> [ "Use the " head? ] [ " vocabulary" tail? ] bi and ;
+
+: get-restart-vocab ( restart -- vocab/f )
+    obj>> dup word? [ vocabulary>> ] [ drop f ] if ;
+
+: is-suggested-restart ( restart -- ? )
+    dup is-use-restart [
+        get-restart-vocab :uses-suggestions get member?
+    ] [ drop f ] if ;
+
+: try-suggested-restarts ( -- )
+    restarts get [ is-suggested-restart ] filter
+    dup length 1 = [ first restart ] [ drop ] if ;
 
 : fuel-set-use-hook ( -- )
     [ amended-use get clone :uses prefix fuel-eval-set-result ]
@@ -38,6 +54,10 @@ SYMBOL: :uses
 
 PRIVATE>
 
+: fuel-use-suggested-vocabs ( suggestions quot -- ... )
+    [ :uses-suggestions set ] dip
+    [ try-suggested-restarts rethrow ] recover ; inline
+
 : fuel-run-file ( path -- )
     [ fuel-set-use-hook run-file ] curry with-scope ; inline
 

misc/fuel/fuel-debug-uses.el

@@ -88,9 +88,16 @@
         fuel-debug--uses nil
         fuel-debug--uses-restarts nil))
 
+(defun fuel-debug--current-usings (file)
+  (with-current-buffer (find-file-noselect file)
+    (sort (fuel-syntax--find-usings t) 'string<)))
+
 (defun fuel-debug--uses-for-file (file)
   (let* ((lines (fuel-debug--file-lines file))
-         (cmd `(:fuel ((V{ ,@lines } fuel-get-uses)) t t)))
+         (old-usings (fuel-debug--current-usings file))
+         (cmd `(:fuel ((V{ ,@old-usings }
+                           [ 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")
@@ -105,8 +112,7 @@
 
 (defun fuel-debug--uses-display (uses)
   (let* ((inhibit-read-only t)
-         (old (with-current-buffer (find-file-noselect fuel-debug--uses-file)
+         (old (fuel-debug--current-usings fuel-debug--uses-file))
-                (sort (fuel-syntax--find-usings t) 'string<)))
          (new (sort uses 'string<)))
     (erase-buffer)
     (fuel-debug--uses-insert-title)