minor improvements to the plugin

CHANGES.txt

@@ -39,6 +39,11 @@ HTTP server now supports virtual hosting.
 You can now set timeouts for I/O operations with the set-timeout generic
 word. The HTTP server sets a timeout of 60 seconds for client requests.
 
+The Factor plugin now supports connecting to Factor instances on
+arbitrary host and port names. This allows interactive development on
+one machine while testing on another. A new command was added to
+evaluate the word definition at the caret in the listener.
+
 Factor 0.74:
 ------------
 

actions.xml

@@ -23,6 +23,11 @@
 				FactorPlugin.evalInListener(view,sel);
 		</CODE>
 	</ACTION>
+	<ACTION NAME="factor-eval-word-def">
+		<CODE>
+			FactorPlugin.evalWordDef(view);
+		</CODE>
+	</ACTION>
 	<ACTION NAME="factor-run-file">
 		<CODE>
 			buffer.save(view,null);

factor/jedit/FactorParsedData.java

@@ -38,9 +38,25 @@ public class FactorParsedData extends SideKickParsedData
 	public String in;
 	public Cons use;
 
-	FactorParsedData(FactorSideKickParser parser, String fileName)
+	public FactorParsedData(FactorSideKickParser parser, String fileName)
 	{
 		super(fileName);
 		this.parser = parser;
 	}
+	
+	public String getVocabularyDeclarations()
+	{
+		StringBuffer buf = new StringBuffer("IN: ");
+		buf.append(in);
+		buf.append("\nUSING: ");
+		Cons u = use;
+		while(u != null)
+		{
+			buf.append(" ");
+			buf.append(u.car);
+			u = u.next();
+		}
+		buf.append(" ;");
+		return buf.toString();
+	}
 }

factor/jedit/FactorPlugin.java

@@ -123,9 +123,9 @@ public class FactorPlugin extends EditPlugin
 				argsArray, null, new File(MiscUtilities
 				.getParentOfPath(imagePath)));
 
-			process.getOutputStream().close();
+			/* process.getOutputStream().close();
 			process.getInputStream().close();
-			process.getErrorStream().close();
+			process.getErrorStream().close(); */
 		}
 		catch(Exception e)
 		{
@@ -691,4 +691,32 @@ public class FactorPlugin extends EditPlugin
 		
 		return token.rules.getName();
 	} //}}}
+
+	//{{{ evalWordDef() method
+	public static void evalWordDef(View view)
+	{
+		FactorParsedData data = getParsedData(view);
+                if(data == null)
+                {
+                        view.getToolkit().beep();
+                        return;
+                }
+
+                JEditTextArea textArea = view.getTextArea();
+
+                IAsset asset = data.getAssetAtOffset(textArea.getCaretPosition());
+
+                if(asset == null || asset.getEnd() == null)
+                {
+                        view.getToolkit().beep();
+                        return;
+                }
+		
+		int start = asset.getStart().getOffset();
+		String text = textArea.getBuffer().getText(start,
+			asset.getEnd().getOffset() - start);
+		
+		String eval = data.getVocabularyDeclarations() + "\n" + text;
+		evalInListener(view,eval);
+	} //}}}
 }

factor/jedit/FactorPlugin.props

@@ -15,6 +15,7 @@ plugin.factor.jedit.FactorPlugin.depend.3=plugin console.ConsolePlugin 4.0.2
 plugin.factor.jedit.FactorPlugin.menu=factor-listener \
 	factor-run-file \
 	factor-eval-selection \
+	factor-eval-word-def \
 	- \
 	sidekick-tree \
 	- \
@@ -40,6 +41,7 @@ plugin.factor.jedit.FactorPlugin.menu=factor-listener \
 factor-listener.label=Listener
 factor-run-file.label=Run current file
 factor-eval-selection.label=Evaluate selection
+factor-eval-word-def.label=Evaluate word definition
 factor-apropos.label=Apropos at caret
 factor-insert-use.label=Use word at caret
 factor-see.label=See word at caret

library/collections/arrays.factor

@@ -25,8 +25,10 @@ BUILTIN: array 8 array? ;
 : set-array-nth ( obj n a -- ) swap 2 fixnum+ set-slot ; inline
 : dispatch ( n vtable -- ) 2 slot array-nth call ;
 
-: copy-array ( to from n -- )
-    [ 3dup swap array-nth pick rot set-array-nth ] repeat 2drop ;
+: copy-array ( to from -- )
+    dup array-capacity [
+        3dup swap array-nth pick rot set-array-nth
+    ] repeat 2drop ;
 
 M: array length array-capacity ;
 M: array nth array-nth ;

library/collections/hashtables.factor

@@ -38,6 +38,10 @@ IN: kernel-internals
     [ array-nth swap call ] 2keep
     set-array-nth ; inline
 
+: each-bucket ( hash quot -- | quot: n hash -- )
+    over bucket-count [ [ -rot call ] 3keep ] repeat 2drop ;
+    inline
+
 : hash-size+ ( hash -- ) dup hash-size 1 + swap set-hash-size ;
 : hash-size- ( hash -- ) dup hash-size 1 - swap set-hash-size ;
 
@@ -76,17 +80,9 @@ IN: hashtables
 : grow-hash? ( hash -- ? )
     dup bucket-count 3 * 2 /i swap hash-size < ;
 
-: (hash>alist) ( alist n hash -- alist )
-    2dup bucket-count >= [
-        2drop
-    ] [
-        [ hash-bucket [ swons ] each ] 2keep
-        >r 1 + r> (hash>alist)
-    ] ifte ;
-
 : hash>alist ( hash -- alist )
     #! Push a list of key/value pairs in a hashtable.
-    [ ] 0 rot (hash>alist) ;
+    [ ] swap [ hash-bucket [ swons ] each ] each-bucket ;
 
 : (set-hash) ( value key hash -- )
     dup hash-size+ [ set-assoc ] set-hash* ;
@@ -116,10 +112,7 @@ IN: hashtables
 
 : hash-clear ( hash -- )
     #! Remove all entries from a hashtable.
-    0 over set-hash-size
-    dup bucket-count [
-        [ f swap pick set-hash-bucket ] keep
-    ] repeat drop ;
+    0 over set-hash-size [ f -rot set-hash-bucket ] each-bucket ;
 
 : buckets>list ( hash -- list )
     #! Push a list of key/value pairs in a hashtable.
@@ -146,9 +139,8 @@ IN: hashtables
 
 M: hashtable clone ( hash -- hash )
     dup bucket-count <hashtable>
-    over hash-size over set-hash-size [
-        hash-array swap hash-array dup length copy-array
-    ] keep ;
+    over hash-size over set-hash-size
+    [ hash-array swap hash-array copy-array ] keep ;
 
 M: hashtable = ( obj hash -- ? )
     2dup eq? [

library/generic/slots.factor

@@ -46,7 +46,7 @@ sequences strings words ;
     [ 3unlist define-slot ] each-with ;
 
 : reader-word ( class name -- word )
-    [ swap word-name , "-" , , ] make-string create-in ;
+    >r word-name "-" r> append3 create-in ;
 
 : writer-word ( class name -- word )
     [ swap "set-" , word-name , "-" , , ] make-string create-in ;

library/generic/tuple.factor

@@ -100,7 +100,6 @@ UNION: arrayed array tuple ;
 : define-tuple ( tuple slots -- )
     2dup check-shape
     >r create-in
-    dup save-location
     dup intern-symbol
     dup tuple-predicate
     dup tuple "metaclass" set-word-prop
@@ -190,7 +189,7 @@ M: mirror length ( mirror -- len )
 : clone-tuple ( tuple -- tuple )
     #! Make a shallow copy of a tuple, without cloning its
     #! delegate.
-    dup array-capacity dup <tuple> [ -rot copy-array ] keep ;
+    [ array-capacity <tuple> dup ] keep copy-array ;
 
 M: tuple clone ( tuple -- tuple )
     #! Clone a tuple and its delegate.

library/test/test.factor

@@ -62,50 +62,6 @@ SYMBOL: failures
     failures off
     vocabularies get [ "temporary" off ] bind ;
 
-: eligible-tests ( -- list )
-    [
-        [
-            "lists/cons" "lists/lists" "lists/assoc"
-            "lists/namespaces" "lists/combinators" "combinators"
-            "continuations" "errors" "hashtables" "strings"
-            "namespaces" "generic" "tuple" "files" "parser"
-            "parse-number" "image" "init" "io/io"
-            "listener" "vectors" "words" "unparser" "random"
-            "stream" "math/bitops"
-            "math/math-combinators" "math/rational" "math/float"
-            "math/complex" "math/irrational" "math/integer"
-            "math/matrices"
-            "httpd/url-encoding" "httpd/html" "httpd/httpd"
-            "httpd/http-client"
-            "crashes" "sbuf" "threads" "parsing-word"
-            "inference" "dataflow" "interpreter" "alien"
-            "line-editor" "gadgets" "memory" "redefine"
-            "annotate" "sequences"
-        ] %
-        
-        os "win32" = [
-            "buffer" ,
-        ] when
-        
-        cpu "unknown" = not "compile" get and [
-            [
-                "io/buffer" "compiler/optimizer"
-                "compiler/simple"
-                "compiler/stack" "compiler/ifte"
-                "compiler/generic" "compiler/bail-out"
-                "compiler/linearizer" "compiler/intrinsics"
-            ] %
-        ] when
-        
-        [
-            "benchmark/empty-loop" "benchmark/fac"
-            "benchmark/fib" "benchmark/sort"
-            "benchmark/continuations" "benchmark/ack"
-            "benchmark/hashtables" "benchmark/strings"
-            "benchmark/vectors" "benchmark/prettyprint"
-        ] %
-    ] make-list ;
-
 : passed.
     "Tests passed:" print . ;
 
@@ -113,6 +69,45 @@ SYMBOL: failures
     "Tests failed:" print
     failures get [ unswons write ": " write error. ] each ;
 
-: all-tests ( -- )
-    prepare-tests eligible-tests [ test ] subset
-    terpri passed. failed. ;
+: run-tests ( list -- )
+    prepare-tests [ test ] subset terpri passed. failed. ;
+
+: tests
+    [
+        "lists/cons" "lists/lists" "lists/assoc"
+        "lists/namespaces" "lists/combinators" "combinators"
+        "continuations" "errors" "hashtables" "strings"
+        "namespaces" "generic" "tuple" "files" "parser"
+        "parse-number" "image" "init" "io/io"
+        "listener" "vectors" "words" "unparser" "random"
+        "stream" "math/bitops"
+        "math/math-combinators" "math/rational" "math/float"
+        "math/complex" "math/irrational" "math/integer"
+        "math/matrices"
+        "httpd/url-encoding" "httpd/html" "httpd/httpd"
+        "httpd/http-client"
+        "crashes" "sbuf" "threads" "parsing-word"
+        "inference" "dataflow" "interpreter" "alien"
+        "line-editor" "gadgets" "memory" "redefine"
+        "annotate" "sequences"
+    ] run-tests ;
+
+: benchmarks
+    [
+        "benchmark/empty-loop" "benchmark/fac"
+        "benchmark/fib" "benchmark/sort"
+        "benchmark/continuations" "benchmark/ack"
+        "benchmark/hashtables" "benchmark/strings"
+        "benchmark/vectors" "benchmark/prettyprint"
+    ] run-tests ;
+
+: compiler-tests
+    [
+        "io/buffer" "compiler/optimizer"
+        "compiler/simple"
+        "compiler/stack" "compiler/ifte"
+        "compiler/generic" "compiler/bail-out"
+        "compiler/linearizer" "compiler/intrinsics"
+    ] run-tests ;
+
+: all-tests tests compiler-tests benchmarks ;