suzanne.soy/gui
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

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

Browse Source 
related to PR 15049
This commit is contained in:
Robby Findler 2015-05-02 17:48:40 -05:00
parent f9870b0a4f
commit 469add8d57
3 changed files with 104 additions and 50 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

26
gui-lib/framework/main.rkt
View File

@ -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%))

5
gui-lib/framework/private/sig.rkt
View File

@ -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<%>

123
gui-lib/framework/private/text.rkt
View File

@ -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))