add 'snip-special's to text:ports<%> in the framework

related to PR 15049

Author: rfindler

gui-lib/framework/main.rkt

@@ -157,6 +157,32 @@
   @{Returns the editor instance whose port-name matches the given symbol.
     If no editor can be found, then returns @racket[false].})
 
+ (proc-doc/names
+  text:make-snip-special
+  (-> (is-a?/c snip%) text:snip-special?)
+  (snip)
+  @{Returns a @racket[snip-special] to be used as a
+ @tech[#:doc '(lib "scribblings/reference/reference.scrbl")]{special}
+ with the ports in @racket[text:ports<%>].
+
+ When a snip is sent as a special, if it has a @racket[snip-class%]
+ from a different @tech[#:doc '(lib "scribblings/gui/gui.scrbl")]{eventspace},
+ it may not work properly
+ in the @racket[text%] object connected to the ports in a @racket[text:port<%>]
+ object. This function, when it is called, constructs the bytes
+ corresponding to the result of using the @racket[snip]'s
+ @method[snip% write] method and saves them in it's result. Then,
+ when the result is used as a special, the snip will rebuild from
+ the bytes, but now using the @racket[snip-class%] from the
+ @tech[#:doc '(lib "scribblings/gui/gui.scrbl")]{eventspace}
+ where the @racket[text:ports<%>] operates.})
+
+ (proc-doc/names
+  text:snip-special?
+  (-> any/c boolean?)
+  (v)
+  @{Recognizes the result of @racket[text:make-snip-special].})
+
  (proc-doc/names
   number-snip:make-repeating-decimal-snip
   (real? boolean? . -> . (is-a?/c snip%))

gui-lib/framework/private/sig.rkt

@@ -251,7 +251,10 @@
      range-end
      range-caret-space? 
      range-style 
-     range-color))
+     range-color
+
+     make-snip-special
+     snip-special?))
 
   (define-signature canvas-class^
     (basic<%>

gui-lib/framework/private/text.rkt

@@ -2230,6 +2230,26 @@
 ;;   to do the work
 (define-struct data/chan (data to-insert-chan))
 
+  (struct snip-special (snip name bytes))
+  (define (make-snip-special snip)
+    (define base (new editor-stream-out-bytes-base%))
+    (define stream (make-object editor-stream-out% base))
+    (send snip write stream)
+    (snip-special snip
+                  (send (send snip get-snipclass) get-classname)
+                  (send base get-bytes)))
+  (define (snip-special->snip snip-special)
+    (define snipclass (send (get-the-snip-class-list) find (snip-special-name snip-special)))
+    (cond
+      [snipclass
+       (define base (make-object editor-stream-in-bytes-base%
+                      (snip-special-bytes snip-special)))
+       (define es (make-object editor-stream-in% base))
+       (or (send snipclass read es)
+           (snip-special-snip snip-special))]
+      [else
+       (snip-special-snip snip-special)]))
+  
 (define ports-mixin
   (mixin (wide-snip<%>) (ports<%>)
     (inherit begin-edit-sequence
@@ -2578,55 +2598,59 @@
     ;; do-insertion : (listof (cons (union string snip) style-delta)) boolean -> void
     ;; thread: eventspace main thread
     (define/private (do-insertion txts showing-input?)
-      (let ([locked? (is-locked?)]
-            [sf? (get-styles-fixed)])
-        (begin-edit-sequence)
-        (lock #f)
-        (set-styles-fixed #f)
-        (set! allow-edits? #t)
-        (let loop ([txts txts])
-          (cond
-            [(null? txts) (void)]
-            [else 
-             (let* ([fst (car txts)]
-                    [str/snp (car fst)]
-                    [style (cdr fst)])
-               
-               (let ([inserted-count
-                      (if (is-a? str/snp snip%)
-                          (send str/snp get-count)
-                          (string-length str/snp))]
-                     [old-insertion-point insertion-point])
-                 (set! insertion-point (+ insertion-point inserted-count))
-                 (set! unread-start-point (+ unread-start-point inserted-count))
-                 
-                 (insert (if (is-a? str/snp snip%)
-                             (let ([s (send str/snp copy)])
-                               (if (is-a? s snip%)
-                                   s
-                                   (new snip%)))
-                             str/snp)
-                         old-insertion-point
-                         old-insertion-point
-                         #t)
-                 
-                 ;; the idea here is that if you made a string snip, you
-                 ;; could have made a string and gotten the style, so you
-                 ;; must intend to have your own style.
-                 (unless (is-a? str/snp string-snip%)
-                   (change-style style old-insertion-point insertion-point))))
-             (loop (cdr txts))]))
-        (set-styles-fixed sf?)
-        (set! allow-edits? #f)
-        (lock locked?)
-        (unless showing-input?
-          (when box-input
-            (adjust-box-input-width)
-            (when (eq? box-input (get-focus-snip))
-              (scroll-to-position (last-position)))))
-        (end-edit-sequence)
-        (unless (null? txts)
-          (after-io-insertion))))
+      (define locked? (is-locked?))
+      (define sf? (get-styles-fixed))
+      (begin-edit-sequence)
+      (lock #f)
+      (set-styles-fixed #f)
+      (set! allow-edits? #t)
+      (let loop ([txts txts])
+        (cond
+          [(null? txts) (void)]
+          [else 
+           (define fst (car txts))
+           (define str/snp
+             (cond
+               [(snip-special? (car fst))
+                (snip-special->snip (car fst))]
+               [else (car fst)]))
+           (define style (cdr fst))
+           
+           (define inserted-count
+             (if (is-a? str/snp snip%)
+                 (send str/snp get-count)
+                 (string-length str/snp)))
+           (define old-insertion-point insertion-point)
+           (set! insertion-point (+ insertion-point inserted-count))
+           (set! unread-start-point (+ unread-start-point inserted-count))
+           
+           (insert (if (is-a? str/snp snip%)
+                       (let ([s (send str/snp copy)])
+                         (if (is-a? s snip%)
+                             s
+                             (new snip%)))
+                       str/snp)
+                   old-insertion-point
+                   old-insertion-point
+                   #t)
+           
+           ;; the idea here is that if you made a string snip, you
+           ;; could have made a string and gotten the style, so you
+           ;; must intend to have your own style.
+           (unless (is-a? str/snp string-snip%)
+             (change-style style old-insertion-point insertion-point))
+           (loop (cdr txts))]))
+      (set-styles-fixed sf?)
+      (set! allow-edits? #f)
+      (lock locked?)
+      (unless showing-input?
+        (when box-input
+          (adjust-box-input-width)
+          (when (eq? box-input (get-focus-snip))
+            (scroll-to-position (last-position)))))
+      (end-edit-sequence)
+      (unless (null? txts)
+        (after-io-insertion)))
 
     (define/public (after-io-insertion) (void))
 
@@ -2762,6 +2786,7 @@
         (λ (special can-buffer? enable-breaks?)
           (define str/snp (cond
                             [(string? special) special]
+                            [(snip-special? special) special]
                             [(is-a? special snip%) special]
                             [else (format "~s" special)]))
           (define to-send (cons str/snp style))