Minor fixes

diff --git a/TODO.FACTOR.txt b/TODO.FACTOR.txt
index 1a71ec2bb3f1c4bb34bc4266389134cf1726d5e8..9a4f5948075ee65da555ac4679628b6f551aef6e 100644 (file)
--- a/TODO.FACTOR.txt
+++ b/TODO.FACTOR.txt
@@ -1,6 +1,5 @@
 + 0.85:
 
-- :edit should apply to the innermost error
 - doc sweep
 - the editor should fill up the interior of the scroller completely
 - pane output in UI should use less memory
@@ -50,7 +49,6 @@
 - roundoff is still not quite right with tracks
 - fix top level window positioning
 - x11.app has a problem with A+ keys
-- status bar showing number of words needing a recompile
 - services do not launch if factor not running
 - fix ui listener delay
 - editor:
@@ -97,7 +95,6 @@
 
 - stdcall callbacks
 - see if alien calls can be made faster
-- [ r> ] infer should throw an inference error
 - compiler tests are not as reliable now because of try-compile usage
   - we can just do [ t ] [ \ foo compiled? ] unit-test
 - [ [ dup call ] dup call ] infer hangs

diff --git a/library/compiler/inference/errors.factor b/library/compiler/inference/errors.factor
index 8f6fab5e8b14aac5c3b34669faf7f3ca69a9f6f1..21124eda84306446a0190182e2437e72de11a166 100644 (file)
--- a/library/compiler/inference/errors.factor
+++ b/library/compiler/inference/errors.factor
@@ -17,9 +17,13 @@ M: unbalanced-branches-error error.
 M: literal-expected summary
     drop "Literal value expected" ;
 
-M: check-retain summary
+M: too-many->r summary
     drop
-    "Quotation leaves elements behind on retain stack" ;
+    "Quotation pushes elements on retain stack without popping them" ;
+
+M: too-many-r> summary
+    drop
+    "Quotation pops retain stack elements which it did not push" ;
 
 M: no-effect error.
     "The word " write

diff --git a/library/compiler/inference/inference.factor b/library/compiler/inference/inference.factor
index 2877f0221673ee8313845c4176b2c577a22b50ac..0e7cb7fb16a6a8f7df8c2ec919b77148335aab76 100644 (file)
--- a/library/compiler/inference/inference.factor
+++ b/library/compiler/inference/inference.factor
@@ -82,13 +82,20 @@ M: quotation infer-quot
     recursive-state get >r swap recursive-state set
     infer-quot r> recursive-state set ;
 
-TUPLE: check-retain ;
+TUPLE: too-many->r ;
 
-: check-retain ( -- )
+: check->r ( -- )
     meta-r get empty? [
-        <check-retain> inference-error
+        <too-many->r> inference-error
     ] unless ;
 
+TUPLE: too-many-r> ;
+
+: check-r> ( -- )
+    meta-r get empty? [
+        <too-many-r>> inference-error
+    ] when ;
+
 : undo-infer ( -- )
     recorded get
     [ "infer" word-prop not ] subset
@@ -101,7 +108,7 @@ TUPLE: check-retain ;
             V{ } clone recorded set
             f init-inference
             call
-            check-retain
+            check->r
         ] [
             undo-infer
             rethrow

diff --git a/library/compiler/inference/inference.facts b/library/compiler/inference/inference.facts
index a92105f53364d4a3a776b344211d89dde1e7d2fb..8a329d28f4c1c2e10ed1b5d33e6b8567efbc6980 100644 (file)
--- a/library/compiler/inference/inference.facts
+++ b/library/compiler/inference/inference.facts
@@ -11,7 +11,8 @@ HELP: inference-error
     { $list
         { $link no-effect }
         { $link literal-expected }
-        { $link check-retain }
+        { $link too-many->r }
+        { $link too-many-r> }
         { $link unbalanced-branches-error }
         { $link effect-error }
         { $link recursive-declare-error }
@@ -25,9 +26,13 @@ HELP: literal-expected
 HELP: terminated?
 { $var-description "During inference, a flag set to " { $link t } " if the current control flow path unconditionally throws an error." } ;
 
-HELP: check-retain
-{ $error-description "Thrown if inference notices a quotation leaving behind elements on the retain stack." }
-{ $notes "Usually this error indicates a coding mistake; check that usages of " { $link >r } " and " { $link r> } " are balanced in this case. Writing code which intentionally does this is considered bad style." } ;
+HELP: too-many->r
+{ $error-description "Thrown if inference notices a quotation pushing elements on the retain stack without popping them at the end." }
+{ $notes "See " { $link "shuffle-words" } " for retain stack usage conventions." } ;
+
+HELP: too-many-r>
+{ $error-description "Thrown if inference notices a quotation popping elements from the return stack it did not place there." }
+{ $notes "See " { $link "shuffle-words" } " for retain stack usage conventions." } ;
 
 HELP: infer
 { $values { "quot" "a quotation" } { "effect" "a pair of integers" } }

diff --git a/library/compiler/inference/stack.factor b/library/compiler/inference/stack.factor
index fd23a0c2599968ad9eea4a1848cf211a042c368f..d0958ac9f9c02318ec78af1688fc569b34d31578 100644 (file)
--- a/library/compiler/inference/stack.factor
+++ b/library/compiler/inference/stack.factor
@@ -50,6 +50,7 @@ sequences words parser words ;
 \ >r { object } { } <effect> "infer-effect" set-word-prop
 
 \ r> [
+    check-r>
     #r> dup node,
     0 1 pick node-inputs
     pop-r push-d

diff --git a/library/io/unix/io.factor b/library/io/unix/io.factor
index 5a2a96c51843d0b6e95f467d9b0448f17cf04d7f..3afcfc81879ea4f62a867480b0d61e31d16bc5e8 100644 (file)
--- a/library/io/unix/io.factor
+++ b/library/io/unix/io.factor
@@ -223,7 +223,6 @@ M: read-task task-container drop read-tasks get-global ;
     ] when pending-error drop ;
 
 : stream-read-part ( count port -- string )
-    >r 0 max >fixnum r>
     [ wait-to-read ] 2keep
     [ dupd buffer> ] unless-eof nip ;
 
@@ -243,6 +242,7 @@ M: read-task task-container drop read-tasks get-global ;
     [ underlying ] [ >string ] if ; inline
 
 M: input-port stream-read
+    >r 0 max >fixnum r>
     2dup stream-read-part dup [
         pick over length > [
             pick <sbuf>

diff --git a/library/syntax/parse-stream.factor b/library/syntax/parse-stream.factor
index 551d6e1252b338357201faaeb91a34e0042a94cc..686ae6d62b44a41645d8766c9dde828446d13cb6 100644 (file)
--- a/library/syntax/parse-stream.factor
+++ b/library/syntax/parse-stream.factor
@@ -8,7 +8,12 @@ namespaces sequences words ;
     "scratchpad" set-in { "syntax" "scratchpad" } set-use ;\r
 \r
 : with-parser ( quot -- )\r
-    [ [ <parse-error> rethrow ] recover ] with-scope ;\r
+    [\r
+        [\r
+            dup [ parse-error? ] is? [ <parse-error> ] unless\r
+            rethrow\r
+        ] recover\r
+    ] with-scope ;\r
 \r
 : parse-lines ( lines -- quot )\r
     [\r

diff --git a/library/ui/test/commands.factor b/library/ui/test/commands.factor
index 6750d5e97b5abc8a6ecf20654575ee382f2dc446..59b24d90961f789a0359506eab930239b3ad201d 100644 (file)
--- a/library/ui/test/commands.factor
+++ b/library/ui/test/commands.factor
@@ -3,4 +3,4 @@ USING: gadgets test ;
 
 [ "A+a" ] [ T{ key-down f { A+ } "a" } gesture>string ] unit-test
 [ "b" ] [ T{ key-down f f "b" } gesture>string ] unit-test
-[ "Mouse Down 2" ] [ T{ button-down f f 2 } gesture>string ] unit-test
+[ "Press Button 2" ] [ T{ button-down f f 2 } gesture>string ] unit-test

diff --git a/library/ui/text/editor.factor b/library/ui/text/editor.factor
index a8d34168292a72c3d8c68a03e78df7a049a0b737..6bacb3c6b860679dc487d759d18804dec16acf44 100644 (file)
--- a/library/ui/text/editor.factor
+++ b/library/ui/text/editor.factor
@@ -122,7 +122,9 @@ M: editor model-changed
     dup caret-loc swap caret-dim <rect> ;
 
 : scroll>caret ( editor -- )
-    dup caret-rect swap scroll>rect ;
+    dup gadget-grafted? [
+        dup caret-rect over scroll>rect
+    ] when drop ;
 
 M: loc-monitor model-changed
     loc-monitor-editor control-self scroll>caret ;