From 469add8d57c03f1ed269b48f5453dfad2f60d0c6 Mon Sep 17 00:00:00 2001 From: Robby Findler Date: Sat, 2 May 2015 17:48:40 -0500 Subject: [PATCH] add 'snip-special's to text:ports<%> in the framework related to PR 15049 --- gui-lib/framework/main.rkt | 26 ++++++ gui-lib/framework/private/sig.rkt | 5 +- gui-lib/framework/private/text.rkt | 123 +++++++++++++++++------------ 3 files changed, 104 insertions(+), 50 deletions(-) diff --git a/gui-lib/framework/main.rkt b/gui-lib/framework/main.rkt index 737f4291..36fbe5fe 100644 --- a/gui-lib/framework/main.rkt +++ b/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%)) diff --git a/gui-lib/framework/private/sig.rkt b/gui-lib/framework/private/sig.rkt index 9d2be724..0c2ed285 100644 --- a/gui-lib/framework/private/sig.rkt +++ b/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<%> diff --git a/gui-lib/framework/private/text.rkt b/gui-lib/framework/private/text.rkt index f99e7eb6..c0a07860 100644 --- a/gui-lib/framework/private/text.rkt +++ b/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))