original commit: 3472cdee2748ce2786418b3243e165b952a59b1a
This commit is contained in:
Robby Findler 1999-04-14 22:34:11 +00:00
parent 9a91745201
commit 5a19431d04
2 changed files with 46 additions and 16 deletions

View File

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

View File

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