...
original commit: 3472cdee2748ce2786418b3243e165b952a59b1a
This commit is contained in:
parent
9a91745201
commit
5a19431d04
|
@ -130,6 +130,7 @@
|
|||
get-canvas%
|
||||
get-editor%
|
||||
get-editor<%>
|
||||
|
||||
make-editor
|
||||
save-as
|
||||
get-canvas
|
||||
|
@ -271,7 +272,6 @@
|
|||
(is-a? edit editor<%>))
|
||||
(send edit do-edit-operation const)))
|
||||
#t))])
|
||||
|
||||
(override
|
||||
[edit-menu:undo (edit-menu:do 'undo)]
|
||||
[edit-menu:redo (edit-menu:do 'redo)]
|
||||
|
@ -286,8 +286,8 @@
|
|||
(make-object separator-menu-item% edit-menu)
|
||||
(make-object (get-menu-item%) "Insert Text Box" edit-menu
|
||||
(edit-menu:do 'insert-text-box))
|
||||
(make-object (get-menu-item%) "Insert Graphic Box" edit-menu
|
||||
(edit-menu:do 'insert-graphic-box))
|
||||
(make-object (get-menu-item%) "Insert Pasteboard Box" edit-menu
|
||||
(edit-menu:do 'insert-pasteboard-box))
|
||||
(make-object (get-menu-item%) "Insert Image..." edit-menu
|
||||
(edit-menu:do 'insert-image))
|
||||
(make-object (get-menu-item%) "Toggle Wrap Text" edit-menu
|
||||
|
@ -361,7 +361,6 @@
|
|||
(eq? x 'backward))
|
||||
(error 'set-searching-direction "expected ~e or ~e, got ~e" 'forward 'backward x))
|
||||
(set! searching-direction x))
|
||||
(define old-search-highlight void)
|
||||
(define get-active-embedded-edit
|
||||
(lambda (edit)
|
||||
(let loop ([edit edit])
|
||||
|
@ -369,7 +368,9 @@
|
|||
(if (or (not snip)
|
||||
(not (is-a? snip original:editor-snip%)))
|
||||
edit
|
||||
(loop (send snip get-this-media)))))))
|
||||
(loop (send snip get-editor)))))))
|
||||
|
||||
(define old-search-highlight void)
|
||||
(define clear-search-highlight
|
||||
(lambda ()
|
||||
(begin (old-search-highlight)
|
||||
|
@ -383,7 +384,9 @@
|
|||
(send edit get-end-position)
|
||||
(send edit get-start-position))])
|
||||
(set! search-anchor position)
|
||||
(set! old-search-highlight
|
||||
|
||||
;; don't draw the anchor
|
||||
'(set! old-search-highlight
|
||||
(send edit highlight-range position position color #f))))))
|
||||
|
||||
(define find-text%
|
||||
|
|
|
@ -303,6 +303,20 @@
|
|||
(apply super-init args)
|
||||
(set-autowrap-bitmap (initial-autowrap-bitmap)))))
|
||||
|
||||
(define copy-editor-snip%
|
||||
(class editor-snip% (copy% text)
|
||||
(override
|
||||
[copy
|
||||
(lambda ()
|
||||
(let ([text (make-object copy%)])
|
||||
(send text insert "AA")
|
||||
(let loop ([snip (send text find-first-snip)])
|
||||
(when snip
|
||||
(send text insert (send snip copy))
|
||||
(loop (send snip next))))
|
||||
(make-object copy-editor-snip% copy% text)))])
|
||||
(sequence (super-init text))))
|
||||
|
||||
(define searching<%>
|
||||
(interface ()
|
||||
find-string-embedded))
|
||||
|
@ -310,11 +324,18 @@
|
|||
(mixin (editor:keymap<%> basic<%>) (searching<%>) args
|
||||
(inherit get-end-position get-start-position last-position
|
||||
find-string get-snip-position get-admin find-snip)
|
||||
(rename [super-on-new-box on-new-box])
|
||||
(override
|
||||
[on-new-box
|
||||
(lambda (type)
|
||||
(if (eq? type 'text)
|
||||
(make-object copy-editor-snip% searching% (make-object searching%))
|
||||
(super-on-new-box)))])
|
||||
(public
|
||||
[find-string-embedded
|
||||
(opt-lambda (str [direction 'forward] [start 'start]
|
||||
[end 'eof] [get-start #t]
|
||||
[case-sensitive? #t] [pop-out? #f])
|
||||
[case-sensitive? #t] [pop-out? #t])
|
||||
(unless (member direction '(forward backward))
|
||||
(error 'find-string-embedded
|
||||
"expected ~e or ~e as first argument, got: ~e" 'forward 'backward direction))
|
||||
|
@ -335,7 +356,7 @@
|
|||
(let ([admin (get-admin)])
|
||||
(if (is-a? admin editor-snip-editor-admin%)
|
||||
(let* ([snip (send admin get-snip)]
|
||||
[edit-above (send (send snip get-admin) get-media)]
|
||||
[edit-above (send (send snip get-admin) get-editor)]
|
||||
[pos (send edit-above get-snip-position snip)])
|
||||
(send edit-above
|
||||
find-string-embedded
|
||||
|
@ -368,16 +389,22 @@
|
|||
(pop-out)
|
||||
(values this flat))]
|
||||
[(is-a? current-snip original:editor-snip%)
|
||||
(printf "found embedded editor~n")
|
||||
(let-values ([(embedded embedded-pos)
|
||||
(let ([media (send current-snip get-editor)])
|
||||
(and (not (null? media))
|
||||
(send media find-string-embedded str
|
||||
direction
|
||||
(if (eq? 'forward direction)
|
||||
0
|
||||
(send media last-position))
|
||||
'eof
|
||||
get-start case-sensitive?)))])
|
||||
(if (and media
|
||||
(is-a? media searching<%>))
|
||||
(begin
|
||||
(printf "searching in embedded editor~n")
|
||||
(send media find-string-embedded str
|
||||
direction
|
||||
(if (eq? 'forward direction)
|
||||
0
|
||||
(send media last-position))
|
||||
'eof
|
||||
get-start case-sensitive?))
|
||||
(values #f #f)))])
|
||||
(printf "embedded: ~a embedded-pos ~a~n" embedded embedded-pos)
|
||||
(if (not embedded-pos)
|
||||
(next-loop)
|
||||
(values embedded embedded-pos)))]
|
||||
|
|
Loading…
Reference in New Issue
Block a user