From 2ec720176a295f147cbb461f6b804e05c78ee57d Mon Sep 17 00:00:00 2001
From: Robby Findler <robby@racket-lang.org>
Date: Thu, 22 Sep 2011 10:36:28 -0500
Subject: [PATCH] extend and refactor minor stuff in the framework

specifically add an argument to move/copy-to-edit so that it
does copy-only and export a function for trigger a submission
to the input port of a text:ports<%> object programmatically
---
 collects/framework/private/text.rkt       | 50 +++++++++++++----------
 collects/scribblings/framework/text.scrbl | 21 ++++++++--
 2 files changed, 45 insertions(+), 26 deletions(-)

diff --git a/collects/framework/private/text.rkt b/collects/framework/private/text.rkt
index 1535d8d7fe..30be968f00 100644
--- a/collects/framework/private/text.rkt
+++ b/collects/framework/private/text.rkt
@@ -500,7 +500,7 @@
      (set! edition (+ edition 1))
      (inner (void) after-delete start len))
     
-    (define/public (move/copy-to-edit dest-edit start end dest-position)
+    (define/public (move/copy-to-edit dest-edit start end dest-position #:try-to-move? [try-to-move? #t])
       (split-snip start)
       (split-snip end)
       (let loop ([snip (find-snip end 'before)])
@@ -509,13 +509,16 @@
            (void)]
           [else
            (let ([prev (send snip previous)]
-                 [released/copied (if (send snip release-from-owner)
-                                      snip
-                                      (let* ([copy (send snip copy)]
-                                             [snip-start (get-snip-position snip)]
-                                             [snip-end (+ snip-start (send snip get-count))])
-                                        (delete snip-start snip-end)
-                                        snip))])
+                 [released/copied 
+                  (if try-to-move?
+                      (if (send snip release-from-owner)
+                          snip
+                          (let* ([copy (send snip copy)]
+                                 [snip-start (get-snip-position snip)]
+                                 [snip-end (+ snip-start (send snip get-count))])
+                            (delete snip-start snip-end)
+                            snip))
+                      (send snip copy))])
              (send dest-edit insert released/copied dest-position dest-position)
              (loop prev))])))
     
@@ -2108,23 +2111,26 @@
                 (= start end)
                 (submit-to-port? key))
            (insert "\n" (last-position) (last-position))
-           (set-position (last-position) (last-position))
-           (for-each/snips-chars
-            unread-start-point
-            (last-position)
-            (λ (s/c line-col-pos) 
-              (cond
-                [(is-a? s/c snip%)
-                 (channel-put read-chan (cons s/c line-col-pos))]
-                [(char? s/c)
-                 (for-each (λ (b) (channel-put read-chan (cons b line-col-pos)))
-                           (bytes->list (string->bytes/utf-8 (string s/c))))])))
-           (set! unread-start-point (last-position))
-           (set! insertion-point (last-position))
-           (on-submit)]
+           (do-submission)]
           [else
            (super on-local-char key)])))
     
+    (define/public-final (do-submission)
+      (set-position (last-position) (last-position))
+      (for-each/snips-chars
+       unread-start-point
+       (last-position)
+       (λ (s/c line-col-pos) 
+         (cond
+           [(is-a? s/c snip%)
+            (channel-put read-chan (cons s/c line-col-pos))]
+           [(char? s/c)
+            (for-each (λ (b) (channel-put read-chan (cons b line-col-pos)))
+                      (bytes->list (string->bytes/utf-8 (string s/c))))])))
+      (set! unread-start-point (last-position))
+      (set! insertion-point (last-position))
+      (on-submit))
+    
     ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
     ;;
     ;; box input port management
diff --git a/collects/scribblings/framework/text.scrbl b/collects/scribblings/framework/text.scrbl
index cc2453b3dc..cb81645ea3 100644
--- a/collects/scribblings/framework/text.scrbl
+++ b/collects/scribblings/framework/text.scrbl
@@ -83,16 +83,24 @@
     get-fixed-style].
   }
 
-  @defmethod*[(((move/copy-to-edit (dest-text (is-a?/c text%)) (start exact-integer?) (end exact-integer?) (dest-pos exact-integer?)) void?))]{
+  @defmethod[(move/copy-to-edit [dest-text (is-a?/c text%)]
+                                [start exact-integer?]
+                                [end exact-integer?]
+                                [dest-pos exact-integer?]
+                                [#:try-to-move? try-to-move? boolean? #t])
+             void?]{
     This moves or copies text and snips to another edit.
 
     Moves or copies from the edit starting at @racket[start] and ending at
     @racket[end]. It puts the copied text and snips in @racket[dest-text]
     starting at location @racket[dest-pos].
 
-    If a snip refused to be moved, it will be copied, otherwise it will be
-    moved. A snip may refuse to be moved by returning @racket[#f] from
-    @method[snip% release-from-owner].
+    If @racket[try-to-move] is @racket[#t], then the snips are removed;
+    and if it is @racket[#f], then they are copied.
+    
+    If a snip refused to be moved, it will be copied and deleted from the editor,
+    otherwise it will be moved. A snip may refuse to be moved by returning
+    @racket[#f] from @method[snip% release-from-owner].
   }
 
   @defmethod*[(((initial-autowrap-bitmap) (or/c #f (is-a?/c bitmap%))))]{
@@ -769,6 +777,11 @@
     @method[text:ports<%> get-insertion-point] (or else it is safe to delete
     them so you don't need this method).
   }
+  
+  @defmethod[(do-submission) void?]{
+    Triggers a submission to the input port with what is currently pending 
+    in the editor.
+  }
 
   @defmethod*[(((get-insertion-point) exact-integer?))]{
     Returns the position where characters put into the output port will appear.