Minor fixes

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

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

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

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" } }

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

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>

library/syntax/parse-stream.factor

@@ -8,7 +8,12 @@ namespaces sequences words ;
     "scratchpad" set-in { "syntax" "scratchpad" } set-use ;
 
 : with-parser ( quot -- )
-    [ [ <parse-error> rethrow ] recover ] with-scope ;
+    [
+        [
+            dup [ parse-error? ] is? [ <parse-error> ] unless
+            rethrow
+        ] recover
+    ] with-scope ;
 
 : parse-lines ( lines -- quot )
     [

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

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 ;