Documents no longer mutatte their model's value

basis/documents/documents-tests.factor

@@ -138,3 +138,11 @@ namespaces tools.test make arrays kernel fry ;
 [ ] [ "d" get clear-doc ] unit-test
 
 [ 0 ] [ "d" get undos>> length ] unit-test
+
+[ ] [ <document> "d" set ] unit-test
+
+[ ] [ "d" get value>> "value" set ] unit-test
+
+[ ] [ "Hello world" "d" get set-doc-string ] unit-test
+
+[ { "" } ] [ "value" get ] unit-test

basis/documents/documents.factor

@@ -27,7 +27,7 @@ TUPLE: document < model locs undos redos inside-undo? ;
     drop ;
 
 : <document> ( -- document )
-    V{ "" } clone document new-model
+    { "" } document new-model
     V{ } clone >>locs
     dup clear-undo ;
 
@@ -104,7 +104,7 @@ CONSTANT: doc-start { 0 0 }
     tuck [ loc-col/str head-slice ] [ loc-col/str tail-slice ] 2bi*
     pick append-last over prepend-first ;
 
-: (set-doc-range) ( new-lines from to lines -- )
+: (set-doc-range) ( doc-lines from to lines -- changed-lines )
     [ prepare-insert ] 3keep
     [ [ first ] bi@ 1+ ] dip
     replace-slice ;
@@ -136,8 +136,7 @@ PRIVATE>
         new-lines from text+loc :> new-to
         from to document doc-range :> old-string
         old-string string from to new-to <edit> document add-undo
-        new-lines from to document value>> (set-doc-range)
-        document notify-connections
+        new-lines from to document [ (set-doc-range) ] change-model
         new-to document update-locs
     ] unless ;
 

basis/ui/tools/listener/listener-tests.factor

@@ -34,6 +34,27 @@ IN: ui.tools.listener.tests
     [ [ [ 1 2 3 ] ] ] [ "promise" get 5 seconds ?promise-timeout ] unit-test
 ] with-interactive-vocabs
 
+[
+    [ ] [ <pane> <pane-stream> <interactor> "interactor" set ] unit-test
+
+    [ ] [ "interactor" get register-self ] unit-test
+
+    [ ] [ <promise> "promise" set ] unit-test
+
+    [
+        self "interactor" get (>>thread)
+        "interactor" get stream-readln "promise" get fulfill
+    ] "Interactor test" spawn drop
+
+    [ ] [ "hi" "interactor" get set-editor-string ] unit-test
+
+    [ ] [ [ "interactor" get interactor-busy? ] [ yield ] [ ] while ] unit-test
+
+    [ ] [ "interactor" get evaluate-input ] unit-test
+
+    [ "hi" ] [ "promise" get 5 seconds ?promise-timeout ] unit-test
+] with-interactive-vocabs
+
 ! Hang
 [ ] [ <pane> <pane-stream> <interactor> "interactor" set ] unit-test
 

core/sequences/sequences-docs.factor

@@ -494,11 +494,9 @@ HELP: delete-slice
 { $side-effects "seq" } ;
 
 HELP: replace-slice
-{ $values { "new" sequence } { "seq" "a mutable sequence" } { "from" "a non-negative integer" } { "to" "a non-negative integer" } }
+{ $values { "new" sequence } { "seq" sequence } { "from" "a non-negative integer" } { "to" "a non-negative integer" } { "seq'" sequence } }
 { $description "Replaces a range of elements beginning at index " { $snippet "from" } " and ending before index " { $snippet "to" } " with a new sequence." }
-{ $notes "If the " { $snippet "to - from" } " is equal to the length of " { $snippet "new" } ", the sequence remains the same size, and does not have to support resizing. However, if " { $snippet "to - from" } " is not equal to the length of " { $snippet "new" } ", the " { $link set-length } " word is called on " { $snippet "seq" } ", so fixed-size sequences should not be passed in this case." }
-{ $errors "Throws an error if " { $snippet "new" } " contains elements whose types are not permissible in " { $snippet "seq" } "." }
-{ $side-effects "seq" } ;
+{ $errors "Throws an error if " { $snippet "new" } " contains elements whose types are not permissible in " { $snippet "seq" } "." } ;
 
 { push prefix suffix } related-words
 
@@ -1442,7 +1440,9 @@ ARTICLE: "sequences-slices" "Subsequences and slices"
 { $subsection unclip-last-slice }
 { $subsection cut-slice }
 "A utility for words which use slices as iterators:"
-{ $subsection <flat-slice> } ;
+{ $subsection <flat-slice> }
+"Replacing slices with new elements:"
+{ $subsection replace-slice } ;
 
 ARTICLE: "sequences-combinators" "Sequence combinators"
 "Iteration:"
@@ -1547,7 +1547,6 @@ ARTICLE: "sequences-destructive" "Destructive operations"
 { $subsection move }
 { $subsection exchange }
 { $subsection copy }
-{ $subsection replace-slice }
 "Many operations have constructive and destructive variants:"
 { $table
     { "Constructive" "Destructive" }

core/sequences/sequences-tests.factor

@@ -134,28 +134,28 @@ unit-test
 
 [ V{ } ] [ 6 >vector 0 6 pick delete-slice ] unit-test
 
-[ V{ 1 2 "a" "b" 5 6 7 } ] [
-    { "a" "b" } 2 4 V{ 1 2 3 4 5 6 7 } clone
-    [ replace-slice ] keep
+[ { 1 2 "a" "b" 5 6 7 } ] [
+    { "a" "b" } 2 4 { 1 2 3 4 5 6 7 }
+    replace-slice
 ] unit-test
 
-[ V{ 1 2 "a" "b" 6 7 } ] [
-    { "a" "b" } 2 5 V{ 1 2 3 4 5 6 7 } clone
-    [ replace-slice ] keep
+[ { 1 2 "a" "b" 6 7 } ] [
+    { "a" "b" } 2 5 { 1 2 3 4 5 6 7 }
+    replace-slice
 ] unit-test
 
-[ V{ 1 2 "a" "b" 4 5 6 7 } ] [
-    { "a" "b" } 2 3 V{ 1 2 3 4 5 6 7 } clone
-    [ replace-slice ] keep
+[ { 1 2 "a" "b" 4 5 6 7 } ] [
+    { "a" "b" } 2 3 { 1 2 3 4 5 6 7 }
+    replace-slice
 ] unit-test
 
-[ V{ 1 2 3 4 5 6 7 "a" "b" } ] [
-    { "a" "b" } 7 7 V{ 1 2 3 4 5 6 7 } clone
-    [ replace-slice ] keep
+[ { 1 2 3 4 5 6 7 "a" "b" } ] [
+    { "a" "b" } 7 7 { 1 2 3 4 5 6 7 }
+    replace-slice
 ] unit-test
 
-[ V{ "a" 3 } ] [
-    { "a" } 0 2 V{ 1 2 3 } clone [ replace-slice ] keep
+[ { "a" 3 } ] [
+    { "a" } 0 2 { 1 2 3 } replace-slice
 ] unit-test
 
 [ { 1 4 9 } ] [ { 1 2 3 } clone dup [ sq ] change-each ] unit-test
@@ -165,7 +165,7 @@ unit-test
 [ 5 ] [ 1 >bignum "\u000001\u000005\u000007" nth-unsafe ] unit-test
 
 [ SBUF" before&after" ] [
-    "&" 6 11 SBUF" before and after" [ replace-slice ] keep
+    "&" 6 11 SBUF" before and after" replace-slice
 ] unit-test
 
 [ 3 "a" ] [ { "a" "b" "c" "a" "d" } [ "a" = ] find-last ] unit-test

core/sequences/sequences.factor

@@ -637,8 +637,6 @@ PRIVATE>
         [ over - ] 2dip move-backward
     ] if ;
 
-PRIVATE>
-
 : open-slice ( shift from seq -- )
     pick 0 = [
         3drop
@@ -648,18 +646,19 @@ PRIVATE>
         set-length
     ] if ;
 
+PRIVATE>
+
 : delete-slice ( from to seq -- )
     check-slice [ over [ - ] dip ] dip open-slice ;
 
 : delete-nth ( n seq -- )
     [ dup 1+ ] dip delete-slice ;
 
-: replace-slice ( new from to seq -- )
-    [ [ [ dup pick length + ] dip - over ] dip open-slice ] keep
-    copy ;
+: replace-slice ( new from to seq -- seq' )
+    tuck [ swap head-slice ] [ swap tail-slice ] 2bi* surround ;
 
 : remove-nth ( n seq -- seq' )
-    [ swap head-slice ] [ swap 1+ tail-slice ] 2bi append ;
+    [ [ { } ] dip dup 1+ ] dip replace-slice ;
 
 : pop ( seq -- elt )
     [ length 1- ] [ [ nth ] [ shorten ] 2bi ] bi ;