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
This commit is contained in:
parent
f07760bd02
commit
2ec720176a
|
@ -500,7 +500,7 @@
|
||||||
(set! edition (+ edition 1))
|
(set! edition (+ edition 1))
|
||||||
(inner (void) after-delete start len))
|
(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 start)
|
||||||
(split-snip end)
|
(split-snip end)
|
||||||
(let loop ([snip (find-snip end 'before)])
|
(let loop ([snip (find-snip end 'before)])
|
||||||
|
@ -509,13 +509,16 @@
|
||||||
(void)]
|
(void)]
|
||||||
[else
|
[else
|
||||||
(let ([prev (send snip previous)]
|
(let ([prev (send snip previous)]
|
||||||
[released/copied (if (send snip release-from-owner)
|
[released/copied
|
||||||
snip
|
(if try-to-move?
|
||||||
(let* ([copy (send snip copy)]
|
(if (send snip release-from-owner)
|
||||||
[snip-start (get-snip-position snip)]
|
snip
|
||||||
[snip-end (+ snip-start (send snip get-count))])
|
(let* ([copy (send snip copy)]
|
||||||
(delete snip-start snip-end)
|
[snip-start (get-snip-position snip)]
|
||||||
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)
|
(send dest-edit insert released/copied dest-position dest-position)
|
||||||
(loop prev))])))
|
(loop prev))])))
|
||||||
|
|
||||||
|
@ -2108,23 +2111,26 @@
|
||||||
(= start end)
|
(= start end)
|
||||||
(submit-to-port? key))
|
(submit-to-port? key))
|
||||||
(insert "\n" (last-position) (last-position))
|
(insert "\n" (last-position) (last-position))
|
||||||
(set-position (last-position) (last-position))
|
(do-submission)]
|
||||||
(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)]
|
|
||||||
[else
|
[else
|
||||||
(super on-local-char key)])))
|
(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
|
;; box input port management
|
||||||
|
|
|
@ -83,16 +83,24 @@
|
||||||
get-fixed-style].
|
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.
|
This moves or copies text and snips to another edit.
|
||||||
|
|
||||||
Moves or copies from the edit starting at @racket[start] and ending at
|
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]
|
@racket[end]. It puts the copied text and snips in @racket[dest-text]
|
||||||
starting at location @racket[dest-pos].
|
starting at location @racket[dest-pos].
|
||||||
|
|
||||||
If a snip refused to be moved, it will be copied, otherwise it will be
|
If @racket[try-to-move] is @racket[#t], then the snips are removed;
|
||||||
moved. A snip may refuse to be moved by returning @racket[#f] from
|
and if it is @racket[#f], then they are copied.
|
||||||
@method[snip% release-from-owner].
|
|
||||||
|
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%))))]{
|
@defmethod*[(((initial-autowrap-bitmap) (or/c #f (is-a?/c bitmap%))))]{
|
||||||
|
@ -770,6 +778,11 @@
|
||||||
them so you don't need this method).
|
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?))]{
|
@defmethod*[(((get-insertion-point) exact-integer?))]{
|
||||||
Returns the position where characters put into the output port will appear.
|
Returns the position where characters put into the output port will appear.
|
||||||
}
|
}
|
||||||
|
|
Loading…
Reference in New Issue
Block a user