improved searching (docs not yet quite done, but I want to test on other platforms ... another commit to follow)
svn: r10921 original commit: a3c0e933249d3b46ad78c25d509f91955c08fe5b
This commit is contained in:
Robby Findler
parent
d32e5e5255
commit
27ca9d153d
|
|
@ -537,9 +537,6 @@ added get-regions
|
|||
(if (is-a? color color%)
|
||||
color
|
||||
(if color mismatch-color (get-match-color)))
|
||||
(and (send (icon:get-paren-highlight-bitmap)
|
||||
ok?)
|
||||
(icon:get-paren-highlight-bitmap))
|
||||
(= caret-pos (+ start-pos start)))])
|
||||
(set! clear-old-locations
|
||||
(let ([old clear-old-locations])
|
||||
|
|
|
|||
File diff suppressed because it is too large
Load Diff
|
|
@ -1,6 +1,6 @@
|
|||
#reader scribble/reader
|
||||
#lang scheme
|
||||
|
||||
(provide main)
|
||||
(require scheme/pretty
|
||||
scheme/runtime-path)
|
||||
(require "standard-menus-items.ss")
|
||||
|
|
@ -66,7 +66,9 @@
|
|||
(parent ,(menu-item-menu-name item))
|
||||
(help-string (,(an-item->help-string-name item)))
|
||||
(demand-callback (λ (menu-item) (,(an-item->on-demand-name item) menu-item))))
|
||||
`(new (get-menu-item%)
|
||||
`(new ,(if (a-checkable-item? item)
|
||||
'(get-checkable-menu-item%)
|
||||
'(get-menu-item%))
|
||||
(label (,(an-item->string-name item)))
|
||||
(parent ,(menu-item-menu-name item))
|
||||
(callback (let ([,callback-name (λ (item evt) (,callback-name item evt))])
|
||||
|
|
|
|||
|
|
@ -956,6 +956,31 @@
|
|||
(send text insert "\n")
|
||||
#t)]
|
||||
|
||||
[shift-focus
|
||||
(λ (adjust)
|
||||
(λ (text event)
|
||||
(when (is-a? text editor:basic<%>)
|
||||
(let ([frame (send text get-top-level-window)])
|
||||
(let ([found-one? #f])
|
||||
(let/ec k
|
||||
(let ([go
|
||||
(λ ()
|
||||
(let loop ([obj frame])
|
||||
(cond
|
||||
[(and found-one? (is-a? obj editor-canvas%))
|
||||
(send obj focus)
|
||||
(k (void))]
|
||||
[(and (is-a? obj window<%>) (send obj has-focus?))
|
||||
(set! found-one? #t)]
|
||||
[(is-a? obj area-container<%>)
|
||||
(for-each loop (adjust (send obj get-children)))])))])
|
||||
(go)
|
||||
;;; when we get here, we either didn't find the focus anywhere,
|
||||
;;; or the last editor-canvas had the focus. either way,
|
||||
;;; the next thing should get the focus
|
||||
(set! found-one? #t)
|
||||
(go))))))))]
|
||||
|
||||
[TeX-compress
|
||||
(let* ([biggest (apply max (map (λ (x) (string-length (car x))) tex-shortcut-table))])
|
||||
(λ (text event)
|
||||
|
|
@ -992,6 +1017,9 @@
|
|||
(λ (txt evt) (send txt insert c)))))
|
||||
(string->list (string-append greek-letters Greek-letters)))
|
||||
|
||||
(add "shift-focus" (shift-focus values))
|
||||
(add "shift-focus-backwards" (shift-focus reverse))
|
||||
|
||||
(add "TeX compress" TeX-compress)
|
||||
(add "newline" newline)
|
||||
(add "down-into-embedded-editor" down-into-embedded-editor)
|
||||
|
|
@ -1262,6 +1290,12 @@
|
|||
(map ":rightbuttonseq" "mouse-popup-menu")
|
||||
|
||||
(map "c:c;c:r" "make-read-only")
|
||||
|
||||
(map "c:x;o" "shift-focus")
|
||||
(map "c:x;p" "shift-focus-backwards")
|
||||
(map "c:f6" "shift-focus")
|
||||
(map "a:tab" "shift-focus")
|
||||
(map "a:s:tab" "shift-focus-backwards")
|
||||
))))
|
||||
|
||||
(define setup-search
|
||||
|
|
@ -1292,9 +1326,7 @@
|
|||
(send kmap add-function name func))])
|
||||
|
||||
(add "move-to-search-or-search"
|
||||
(send-frame (λ (f) (send f move-to-search-or-search)))) ;; key 1
|
||||
(add "move-to-search-or-reverse-search"
|
||||
(send-frame (λ (f) (send f move-to-search-or-reverse-search)))) ;; key 1b, backwards
|
||||
(send-frame (λ (f) (send f move-to-search-or-back)))) ;; key 1
|
||||
(add "find-string-again"
|
||||
(send-frame (λ (f) (send f search-again)))) ;; key 2
|
||||
(add "toggle-search-focus"
|
||||
|
|
|
|||
|
|
@ -20,6 +20,29 @@
|
|||
|
||||
(application-preferences-handler (λ () (preferences:show-dialog)))
|
||||
|
||||
(let ([search/replace-string-predicate
|
||||
(λ (l)
|
||||
(and (list? l)
|
||||
(andmap
|
||||
(λ (x) (or (string? x) (is-a? x snip%)))
|
||||
l)))])
|
||||
(preferences:set-default 'framework:search-string
|
||||
'()
|
||||
search/replace-string-predicate)
|
||||
(preferences:set-default 'framework:replace-string
|
||||
'()
|
||||
search/replace-string-predicate))
|
||||
|
||||
;; marshalling for this one will just lose information. Too bad.
|
||||
(preferences:set-un/marshall 'framework:search-string
|
||||
(λ (l)
|
||||
(map (λ (x)
|
||||
(if (is-a? x snip%)
|
||||
(send x get-text 0 (send x get-count))
|
||||
x))
|
||||
l))
|
||||
values)
|
||||
|
||||
(preferences:set-default 'framework:paren-color-scheme 'basic-grey symbol?)
|
||||
|
||||
(preferences:set-default 'framework:square-bracket:cond/offset
|
||||
|
|
|
|||
99
collects/framework/private/search.ss
Normal file
99
collects/framework/private/search.ss
Normal file
|
|
@ -0,0 +1,99 @@
|
|||
#lang scheme/base
|
||||
(require scheme/contract
|
||||
scheme/class
|
||||
scheme/gui/base)
|
||||
|
||||
(provide/contract
|
||||
[find-string-embedded
|
||||
(->* ((is-a?/c text%)
|
||||
string?)
|
||||
((symbols 'forward 'backward)
|
||||
(or/c (symbols 'start) number?)
|
||||
(or/c (symbols 'eof) number?)
|
||||
boolean?
|
||||
boolean?
|
||||
boolean?)
|
||||
(values (is-a?/c editor<%>)
|
||||
(or/c false/c number?)))])
|
||||
|
||||
(define find-string-embedded
|
||||
(lambda (edit
|
||||
str
|
||||
[direction 'forward]
|
||||
[start 'start]
|
||||
[end 'eof]
|
||||
[get-start #t]
|
||||
[case-sensitive? #t]
|
||||
[pop-out? #f])
|
||||
(let/ec k
|
||||
(let* ([start (if (eq? start 'start)
|
||||
(send edit get-start-position)
|
||||
start)]
|
||||
[end (if (eq? 'eof end)
|
||||
(if (eq? direction 'forward)
|
||||
(send edit last-position)
|
||||
0)
|
||||
end)]
|
||||
[flat (send edit find-string str direction
|
||||
start end get-start
|
||||
case-sensitive?)]
|
||||
[pop-out
|
||||
(λ ()
|
||||
(let ([admin (send edit get-admin)])
|
||||
(if (is-a? admin editor-snip-editor-admin<%>)
|
||||
(let* ([snip (send admin get-snip)]
|
||||
[edit-above (send (send snip get-admin) get-editor)]
|
||||
[pos (send edit-above get-snip-position snip)]
|
||||
[pop-out-pos (if (eq? direction 'forward) (add1 pos) pos)])
|
||||
(find-string-embedded
|
||||
edit-above
|
||||
str
|
||||
direction
|
||||
pop-out-pos
|
||||
(if (eq? direction 'forward) 'eof 0)
|
||||
get-start
|
||||
case-sensitive?
|
||||
pop-out?))
|
||||
(values edit #f))))])
|
||||
(let loop ([current-snip (send edit find-snip start
|
||||
(if (eq? direction 'forward)
|
||||
'after-or-none
|
||||
'before-or-none))])
|
||||
(let ([next-loop
|
||||
(λ ()
|
||||
(if (eq? direction 'forward)
|
||||
(loop (send current-snip next))
|
||||
(loop (send current-snip previous))))])
|
||||
(cond
|
||||
[(or (not current-snip)
|
||||
(and flat
|
||||
(let* ([start (send edit get-snip-position current-snip)]
|
||||
[end (+ start (send current-snip get-count))])
|
||||
(if (eq? direction 'forward)
|
||||
(and (<= start flat)
|
||||
(< flat end))
|
||||
(and (< start flat)
|
||||
(<= flat end))))))
|
||||
(if (and (not flat) pop-out?)
|
||||
(pop-out)
|
||||
(values edit flat))]
|
||||
[(is-a? current-snip editor-snip%)
|
||||
(let-values ([(embedded embedded-pos)
|
||||
(let ([media (send current-snip get-editor)])
|
||||
(if (and media
|
||||
(is-a? media text%))
|
||||
(begin
|
||||
(find-string-embedded
|
||||
media
|
||||
str
|
||||
direction
|
||||
(if (eq? 'forward direction)
|
||||
0
|
||||
(send media last-position))
|
||||
'eof
|
||||
get-start case-sensitive?))
|
||||
(values #f #f)))])
|
||||
(if (not embedded-pos)
|
||||
(next-loop)
|
||||
(values embedded embedded-pos)))]
|
||||
[else (next-loop)])))))))
|
||||
|
|
@ -21,6 +21,7 @@
|
|||
(struct-out between)
|
||||
|
||||
(struct-out an-item)
|
||||
(struct-out a-checkable-item)
|
||||
(struct-out a-submenu-item)
|
||||
|
||||
;; an-item -> symbol
|
||||
|
|
@ -78,6 +79,7 @@
|
|||
on-demand
|
||||
create))
|
||||
(define-struct (a-submenu-item an-item) ())
|
||||
(define-struct (a-checkable-item an-item) ())
|
||||
|
||||
(define (an-item->callback-name item)
|
||||
(string->symbol
|
||||
|
|
@ -357,22 +359,46 @@
|
|||
'(string-constant find-menu-item)
|
||||
edit-menu:edit-target-on-demand
|
||||
#f)
|
||||
(make-an-item 'edit-menu 'find-again
|
||||
'(string-constant find-again-info)
|
||||
(make-an-item 'edit-menu 'find-backwards
|
||||
'(string-constant find-backwards-info)
|
||||
'(λ (item control) (void))
|
||||
#\f
|
||||
'(cons 'shift (get-default-shortcut-prefix))
|
||||
'(string-constant find-backwards-menu-item)
|
||||
edit-menu:edit-target-on-demand
|
||||
#f)
|
||||
(make-an-item 'edit-menu 'replace-and-find
|
||||
'(string-constant replace-and-find-info)
|
||||
'(λ (item control) (void))
|
||||
#\g
|
||||
'(get-default-shortcut-prefix)
|
||||
'(string-constant find-again-menu-item)
|
||||
'(string-constant replace-and-find-menu-item)
|
||||
edit-menu:edit-target-on-demand
|
||||
#f)
|
||||
(make-an-item 'edit-menu 'replace-and-find-again
|
||||
'(string-constant replace-and-find-again-info)
|
||||
(make-an-item 'edit-menu 'replace-and-find-backwards
|
||||
'(string-constant replace-and-find-backwards-info)
|
||||
'(λ (item control) (void))
|
||||
'(if (eq? (system-type) 'macosx) #f #\h)
|
||||
'(get-default-shortcut-prefix)
|
||||
'(string-constant replace-and-find-again-menu-item)
|
||||
#\g
|
||||
'(cons 'shift (get-default-shortcut-prefix))
|
||||
'(string-constant replace-and-find-backwards-menu-item)
|
||||
edit-menu:edit-target-on-demand
|
||||
#f)
|
||||
(make-an-item 'edit-menu 'replace-all
|
||||
'(string-constant replace-all-info)
|
||||
'(λ (item control) (void))
|
||||
#f
|
||||
'(get-default-shortcut-prefix)
|
||||
'(string-constant replace-all-menu-item)
|
||||
edit-menu:edit-target-on-demand
|
||||
#f)
|
||||
(make-a-checkable-item 'edit-menu 'find-case-sensitive
|
||||
'(string-constant find-case-sensitive-info)
|
||||
'(λ (item control) (void))
|
||||
#f
|
||||
'(get-default-shortcut-prefix)
|
||||
'(string-constant find-case-sensitive-menu-item)
|
||||
edit-menu:edit-target-on-demand
|
||||
#f)
|
||||
|
||||
(make-between 'edit-menu 'find 'preferences 'nothing-with-standard-menus)
|
||||
(make-an-item 'edit-menu 'preferences
|
||||
|
|
|
|||
|
|
@ -16,7 +16,6 @@ WARNING: printf is rebound in the body of the unit to always
|
|||
mred/mred-sig
|
||||
mrlib/interactive-value-port
|
||||
mzlib/list
|
||||
mzlib/etc
|
||||
setup/dirs
|
||||
mzlib/string
|
||||
(prefix-in srfi1: srfi/1))
|
||||
|
|
@ -46,8 +45,8 @@ WARNING: printf is rebound in the body of the unit to always
|
|||
(apply fprintf original-output-port args)
|
||||
(void))
|
||||
|
||||
(define-struct range (start end b/w-bitmap color caret-space?) #:inspector #f)
|
||||
(define-struct rectangle (left top right bottom b/w-bitmap color) #:inspector #f)
|
||||
(define-struct range (start end caret-space? style color) #:inspector #f)
|
||||
(define-struct rectangle (left top right bottom style color) #:inspector #f)
|
||||
|
||||
(define-values (register-port-name! lookup-port-name)
|
||||
;; port-name->editor-ht: (hashof symbol (weakboxof editor:basic<%>))
|
||||
|
|
@ -92,12 +91,13 @@ WARNING: printf is rebound in the body of the unit to always
|
|||
(mixin (editor:basic<%> (class->interface text%)) (basic<%>)
|
||||
(inherit get-canvas get-canvases get-admin split-snip get-snip-position
|
||||
begin-edit-sequence end-edit-sequence
|
||||
set-autowrap-bitmap
|
||||
set-autowrap-bitmap last-position
|
||||
delete find-snip invalidate-bitmap-cache
|
||||
set-file-format get-file-format
|
||||
get-style-list is-modified? change-style set-modified
|
||||
position-location position-locations
|
||||
get-extent get-filename)
|
||||
position-line line-start-position line-end-position
|
||||
get-extent get-filename run-after-edit-sequence)
|
||||
|
||||
(define port-name-identifier #f)
|
||||
(define/public (get-port-name)
|
||||
|
|
@ -120,8 +120,6 @@ WARNING: printf is rebound in the body of the unit to always
|
|||
(symbol? id)
|
||||
(equal? port-name-identifier id)))))
|
||||
|
||||
(define highlight-pen #f)
|
||||
(define highlight-brush #f)
|
||||
(define highlight-tmp-color #f)
|
||||
|
||||
(define range-rectangles null)
|
||||
|
|
@ -132,7 +130,17 @@ WARNING: printf is rebound in the body of the unit to always
|
|||
|
||||
(define/public-final (get-highlighted-ranges)
|
||||
(unless ranges-list
|
||||
(set! ranges-list (hash-map ranges (λ (x y) x))))
|
||||
(set! ranges-list
|
||||
(map car (sort (hash-map ranges cons) (λ (x y) (> (cdr x) (cdr y))))))
|
||||
(let loop ([ranges-list ranges-list]
|
||||
[i 0])
|
||||
(cond
|
||||
[(null? ranges-list)
|
||||
(set! ranges-low i)
|
||||
(set! ranges-high 1)]
|
||||
[else
|
||||
(hash-set! ranges (car ranges-list) i)
|
||||
(loop (cdr ranges-list) (- i 1))])))
|
||||
ranges-list)
|
||||
(define/public (get-fixed-style)
|
||||
(send (get-style-list) find-named-style "Standard"))
|
||||
|
|
@ -197,19 +205,18 @@ WARNING: printf is rebound in the body of the unit to always
|
|||
(invalidate-bitmap-cache left top width height))))]
|
||||
[else (let* ([r (car rectangles)]
|
||||
|
||||
[rleft (rectangle-left r)]
|
||||
[rright (rectangle-right r)]
|
||||
[rtop (rectangle-top r)]
|
||||
[rbottom (rectangle-bottom r)]
|
||||
|
||||
[this-left (if (number? rleft)
|
||||
rleft
|
||||
[adjust (λ (w f)
|
||||
(+ w (f (case (rectangle-style r)
|
||||
[(ellipse) 8]
|
||||
[else 0]))))]
|
||||
[this-left (if (number? (rectangle-left r))
|
||||
(adjust (rectangle-left r) -)
|
||||
min-left)]
|
||||
[this-right (if (number? rright)
|
||||
rright
|
||||
[this-right (if (number? (rectangle-right r))
|
||||
(adjust (rectangle-right r) +)
|
||||
max-right)]
|
||||
[this-bottom rbottom]
|
||||
[this-top rtop])
|
||||
[this-top (adjust (rectangle-top r) -)]
|
||||
[this-bottom (adjust (rectangle-bottom r) +)])
|
||||
(if (and left top right bottom)
|
||||
(loop (min this-left left)
|
||||
(min this-top top)
|
||||
|
|
@ -230,30 +237,31 @@ WARNING: printf is rebound in the body of the unit to always
|
|||
(λ (range rst)
|
||||
(let* ([start (range-start range)]
|
||||
[end (range-end range)]
|
||||
[b/w-bitmap (range-b/w-bitmap range)]
|
||||
[color (range-color range)]
|
||||
[caret-space? (range-caret-space? range)]
|
||||
[start-eol? #f]
|
||||
[end-eol? (if (= start end)
|
||||
start-eol?
|
||||
#t)])
|
||||
(let-values ([(start-x top-start-y bottom-start-y)
|
||||
(begin
|
||||
(send this position-locations start b1 b2 #f b3 start-eol? #t)
|
||||
(values (if caret-space?
|
||||
(+ 1 (unbox b1))
|
||||
(unbox b1))
|
||||
(unbox b2)
|
||||
(unbox b3)))]
|
||||
|
||||
|
||||
[(end-x top-end-y bottom-end-y)
|
||||
(begin (send this position-locations end b1 b2 #f b3 end-eol? #t)
|
||||
(values (unbox b1)
|
||||
(unbox b2)
|
||||
(unbox b3)))])
|
||||
|
||||
[style (range-style range)]
|
||||
[color (range-color range)]
|
||||
[lp (last-position)])
|
||||
(let*-values ([(start-eol? end-eol?)
|
||||
(if (= start end)
|
||||
(values #f #f)
|
||||
(values #f #t))]
|
||||
[(start-x top-start-y bottom-start-y)
|
||||
(begin
|
||||
(position-locations start b1 b2 #f b3 start-eol? #t)
|
||||
(values (if caret-space?
|
||||
(+ 1 (unbox b1))
|
||||
(unbox b1))
|
||||
(unbox b2)
|
||||
(unbox b3)))]
|
||||
[(end-x top-end-y bottom-end-y)
|
||||
(begin (position-locations end b1 b2 #f b3 end-eol? #t)
|
||||
(values (unbox b1)
|
||||
(unbox b2)
|
||||
(unbox b3)))])
|
||||
(cond
|
||||
;; the position-location values can be strange when
|
||||
;; this condition is true, so we just bail out.
|
||||
[(or (> start lp) (> end lp)) '()]
|
||||
[(= top-start-y top-end-y)
|
||||
(cons
|
||||
(make-rectangle start-x
|
||||
|
|
@ -262,37 +270,73 @@ WARNING: printf is rebound in the body of the unit to always
|
|||
(+ end-x 1)
|
||||
end-x)
|
||||
bottom-start-y
|
||||
b/w-bitmap
|
||||
style
|
||||
color)
|
||||
rst)]
|
||||
[(eq? style 'ellipse)
|
||||
(let ([end-line (position-line end end-eol?)])
|
||||
;; for this loop,
|
||||
;; we don't need to consider the first or the last line,
|
||||
;; since they are already covered
|
||||
;; by `start-x' and `end-x'
|
||||
(let loop ([l start-x]
|
||||
[r end-x]
|
||||
[line (+ (position-line start start-eol?) 1)])
|
||||
|
||||
(cond
|
||||
[(>= line end-line)
|
||||
;; techincally, the > should not be needed, but we
|
||||
;; would rather have bad drawing than an infinite loop
|
||||
;; in the case that there is a bug ...
|
||||
(cons
|
||||
(make-rectangle l
|
||||
top-start-y
|
||||
r
|
||||
bottom-end-y
|
||||
style
|
||||
color)
|
||||
rst)]
|
||||
[else
|
||||
(let ([line-start (line-start-position line)]
|
||||
[line-end (line-end-position line)])
|
||||
(position-location line-start b1 #f #t)
|
||||
(position-location line-end b2 #f #t)
|
||||
(loop (min (unbox b1) l)
|
||||
(max (unbox b2) r)
|
||||
(+ line 1)))])))]
|
||||
[else
|
||||
(list*
|
||||
(make-rectangle start-x
|
||||
top-start-y
|
||||
'right-edge
|
||||
bottom-start-y
|
||||
b/w-bitmap
|
||||
style
|
||||
color)
|
||||
(make-rectangle 'left-edge
|
||||
bottom-start-y
|
||||
'max-width
|
||||
'right-edge
|
||||
top-end-y
|
||||
b/w-bitmap
|
||||
style
|
||||
color)
|
||||
(make-rectangle 'left-edge
|
||||
top-end-y
|
||||
end-x
|
||||
bottom-end-y
|
||||
b/w-bitmap
|
||||
style
|
||||
color)
|
||||
rst)]))))]
|
||||
[old-rectangles range-rectangles])
|
||||
rst)]))))])
|
||||
|
||||
(set! range-rectangles
|
||||
(foldl new-rectangles
|
||||
null
|
||||
(get-highlighted-ranges)))))
|
||||
|
||||
(define/augment (on-reflow)
|
||||
(run-after-edit-sequence
|
||||
(λ () (recompute-range-rectangles))
|
||||
'framework:recompute-range-rectangles)
|
||||
(inner void on-reflow))
|
||||
|
||||
(define delayed-highlights? #f)
|
||||
(define todo void)
|
||||
|
||||
|
|
@ -308,145 +352,144 @@ WARNING: printf is rebound in the body of the unit to always
|
|||
(set! todo void))
|
||||
(inner (void) after-edit-sequence))
|
||||
|
||||
(define/public highlight-range
|
||||
(opt-lambda (start end color [bitmap #f] [caret-space? #f] [priority 'low])
|
||||
(unless (let ([exact-pos-int?
|
||||
(λ (x) (and (integer? x) (exact? x) (x . >= . 0)))])
|
||||
(and (exact-pos-int? start)
|
||||
(exact-pos-int? end)))
|
||||
(error 'highlight-range "expected first two arguments to be non-negative exact integers, got: ~e ~e"
|
||||
start end))
|
||||
(unless (or (eq? priority 'high) (eq? priority 'low))
|
||||
(error 'highlight-range "expected last argument to be either 'high or 'low, got: ~e"
|
||||
priority))
|
||||
(unless (is-a? color color%)
|
||||
(error 'highlight-range "expected a color for the third argument, got ~s" color))
|
||||
|
||||
(let* ([l (make-range start end bitmap color caret-space?)]
|
||||
[update-one
|
||||
(λ ()
|
||||
(set! ranges-list #f)
|
||||
(hash-set! ranges l (if (eq? priority 'high) (+ ranges-high 1) (- ranges-low 1)))
|
||||
(if (eq? priority 'high)
|
||||
(set! ranges-high (+ ranges-high 1))
|
||||
(set! ranges-low (- ranges-low 1))))])
|
||||
(cond
|
||||
[delayed-highlights?
|
||||
(set! todo
|
||||
(let ([old-todo todo])
|
||||
(λ ()
|
||||
(old-todo)
|
||||
(update-one))))]
|
||||
[else
|
||||
(redraw-highlights update-one)])
|
||||
(λ () (unhighlight-range start end color bitmap caret-space?)))))
|
||||
(define/public (highlight-range start end color [caret-space? #f] [priority 'low] [style 'rectangle])
|
||||
(unless (let ([exact-pos-int?
|
||||
(λ (x) (and (integer? x) (exact? x) (x . >= . 0)))])
|
||||
(and (exact-pos-int? start)
|
||||
(exact-pos-int? end)))
|
||||
(error 'highlight-range "expected first two arguments to be non-negative exact integers, got: ~e ~e"
|
||||
start end))
|
||||
(unless (<= start end)
|
||||
(error 'highlight-range "expected start to be less than end, got ~e ~e" start end))
|
||||
(unless (or (eq? priority 'high) (eq? priority 'low))
|
||||
(error 'highlight-range "expected last argument to be either 'high or 'low, got: ~e"
|
||||
priority))
|
||||
(unless (or (is-a? color color%)
|
||||
(and (string? color)
|
||||
(send the-color-database find-color color)))
|
||||
(error 'highlight-range "expected a color or a string in the the-color-database for the third argument, got ~s" color))
|
||||
|
||||
(let* ([color (if (is-a? color color%)
|
||||
color
|
||||
(send the-color-database find-color color))]
|
||||
[l (make-range start end caret-space? style color)]
|
||||
[update-one
|
||||
(λ ()
|
||||
(set! ranges-list #f)
|
||||
(hash-set! ranges l (if (eq? priority 'high) (+ ranges-high 1) (- ranges-low 1)))
|
||||
(if (eq? priority 'high)
|
||||
(set! ranges-high (+ ranges-high 1))
|
||||
(set! ranges-low (- ranges-low 1))))])
|
||||
(cond
|
||||
[delayed-highlights?
|
||||
(set! todo
|
||||
(let ([old-todo todo])
|
||||
(λ ()
|
||||
(old-todo)
|
||||
(update-one))))]
|
||||
[else
|
||||
(redraw-highlights update-one)])
|
||||
(λ () (unhighlight-range start end color caret-space? style))))
|
||||
|
||||
(define/private (redraw-highlights todo)
|
||||
(let ([old-rectangles range-rectangles])
|
||||
(todo)
|
||||
(recompute-range-rectangles)
|
||||
(invalidate-rectangles (append old-rectangles range-rectangles))))
|
||||
|
||||
(define/public (unhighlight-range start end color [caret-space? #f] [style 'rectangle])
|
||||
(let ([new-todo
|
||||
(λ ()
|
||||
(hash-remove! ranges (make-range start end caret-space? style color))
|
||||
(set! ranges-list #f))])
|
||||
(cond
|
||||
[(> (hash-count ranges) 20)
|
||||
(invalidate-bitmap-cache)]
|
||||
[delayed-highlights?
|
||||
(set! todo
|
||||
(let ([old-todo todo])
|
||||
(λ ()
|
||||
(old-todo)
|
||||
(new-todo))))]
|
||||
[else
|
||||
(recompute-range-rectangles)
|
||||
(invalidate-rectangles (append old-rectangles range-rectangles))])))
|
||||
|
||||
(define/public unhighlight-range
|
||||
(opt-lambda (start end color [bitmap #f] [caret-space? #f])
|
||||
(let ([new-todo
|
||||
(λ ()
|
||||
(hash-remove! ranges (make-range start end bitmap color caret-space?))
|
||||
(set! ranges-list #f))])
|
||||
(cond
|
||||
[delayed-highlights?
|
||||
(set! todo
|
||||
(let ([old-todo todo])
|
||||
(λ ()
|
||||
(old-todo)
|
||||
(new-todo))))]
|
||||
[else
|
||||
(redraw-highlights new-todo)]))))
|
||||
|
||||
(define/private (matching-rectangle? r start end color bitmap caret-space?)
|
||||
(and (equal? start (range-start r))
|
||||
(equal? end (range-end r))
|
||||
(eq? bitmap (range-b/w-bitmap r))
|
||||
(equal? color (range-color r))
|
||||
(equal? caret-space? (range-caret-space? r))))
|
||||
(redraw-highlights new-todo)])))
|
||||
|
||||
(define/override (on-paint before dc left-margin top-margin right-margin bottom-margin dx dy draw-caret)
|
||||
(super on-paint before dc left-margin top-margin right-margin bottom-margin dx dy draw-caret)
|
||||
(when before (recompute-range-rectangles)) ;; assume this result cannot change between before & after
|
||||
(let-values ([(view-x view-y view-width view-height)
|
||||
(let ([b1 (box 0)]
|
||||
[b2 (box 0)]
|
||||
[b3 (box 0)]
|
||||
[b4 (box 0)])
|
||||
(send (get-admin) get-view b1 b2 b3 b4)
|
||||
(values (unbox b1)
|
||||
(unbox b2)
|
||||
(unbox b3)
|
||||
(unbox b4)))])
|
||||
|
||||
(let ([old-pen (send dc get-pen)]
|
||||
[old-brush (send dc get-brush)]
|
||||
[last-color #f])
|
||||
(for-each
|
||||
(λ (rectangle)
|
||||
(let* ([b/w-bitmap (rectangle-b/w-bitmap rectangle)]
|
||||
[color (let ([rc (rectangle-color rectangle)])
|
||||
(cond
|
||||
[(and last-color (eq? last-color rc))
|
||||
rc]
|
||||
[rc
|
||||
(set! last-color #f)
|
||||
(unless highlight-tmp-color
|
||||
(set! highlight-tmp-color (make-object color% 0 0 0)))
|
||||
(send dc try-color rc highlight-tmp-color)
|
||||
(if (<= (color-model:rgb-color-distance
|
||||
(send rc red)
|
||||
(send rc green)
|
||||
(send rc blue)
|
||||
(send highlight-tmp-color red)
|
||||
(send highlight-tmp-color green)
|
||||
(send highlight-tmp-color blue))
|
||||
18)
|
||||
(begin (set! last-color rc)
|
||||
rc)
|
||||
#f)]
|
||||
[else
|
||||
(set! last-color #f)
|
||||
rc]))]
|
||||
[first-number (λ (x y) (if (number? x) x y))]
|
||||
[left (max left-margin (first-number (rectangle-left rectangle) view-x))]
|
||||
[top (max top-margin (rectangle-top rectangle))]
|
||||
[right (min right-margin
|
||||
(first-number
|
||||
(rectangle-right rectangle)
|
||||
(+ view-x view-width)))]
|
||||
[bottom (min bottom-margin (rectangle-bottom rectangle))]
|
||||
[width (max 0 (- right left))]
|
||||
[height (max 0 (- bottom top))])
|
||||
(let ([skip-it? #f])
|
||||
(cond
|
||||
[(and before color)
|
||||
(send dc set-pen (send the-pen-list find-or-create-pen color 0 'solid))
|
||||
(send dc set-brush (send the-brush-list find-or-create-brush color 'solid))]
|
||||
[(and (not before) (not color) b/w-bitmap)
|
||||
(unless highlight-pen
|
||||
(set! highlight-pen (make-object pen% "BLACK" 0 'solid)))
|
||||
(unless highlight-brush
|
||||
(set! highlight-brush (make-object brush% "black" 'solid)))
|
||||
(send highlight-pen set-stipple b/w-bitmap)
|
||||
(send highlight-brush set-stipple b/w-bitmap)
|
||||
(send dc set-pen highlight-pen)
|
||||
(send dc set-brush highlight-brush)]
|
||||
[else (set! skip-it? #t)])
|
||||
(unless skip-it?
|
||||
(send dc draw-rectangle (+ left dx) (+ top dy) width height)))))
|
||||
range-rectangles)
|
||||
(send dc set-pen old-pen)
|
||||
(send dc set-brush old-brush))))
|
||||
(when before
|
||||
(let-values ([(view-x view-y view-width view-height)
|
||||
(let ([b1 (box 0)]
|
||||
[b2 (box 0)]
|
||||
[b3 (box 0)]
|
||||
[b4 (box 0)])
|
||||
(send (get-admin) get-view b1 b2 b3 b4)
|
||||
(values (unbox b1)
|
||||
(unbox b2)
|
||||
(unbox b3)
|
||||
(unbox b4)))])
|
||||
(let* ([old-pen (send dc get-pen)]
|
||||
[old-brush (send dc get-brush)]
|
||||
[old-smoothing (send dc get-smoothing)]
|
||||
[last-color #f]
|
||||
[color-rectangle
|
||||
(λ (rectangle)
|
||||
(let* ([left (if (number? (rectangle-left rectangle))
|
||||
(rectangle-left rectangle)
|
||||
view-x)]
|
||||
[top (rectangle-top rectangle)]
|
||||
[right (if (number? (rectangle-right rectangle))
|
||||
(rectangle-right rectangle)
|
||||
(+ view-x view-width))]
|
||||
[bottom (rectangle-bottom rectangle)]
|
||||
[width (max 0 (- right left))]
|
||||
[height (max 0 (- bottom top))])
|
||||
(when (and (or (<= left-margin left right-margin)
|
||||
(<= left-margin (+ left width) right-margin)
|
||||
(<= left left-margin right-margin (+ left width)))
|
||||
(or (<= top-margin top bottom-margin)
|
||||
(<= top-margin (+ top height) bottom-margin)
|
||||
(<= top top-margin bottom-margin (+ top height))))
|
||||
|
||||
(let ([color (let ([rc (rectangle-color rectangle)])
|
||||
(cond
|
||||
[(and last-color (eq? last-color rc))
|
||||
rc]
|
||||
[rc
|
||||
(set! last-color #f)
|
||||
(unless highlight-tmp-color
|
||||
(set! highlight-tmp-color (make-object color% 0 0 0)))
|
||||
(send dc try-color rc highlight-tmp-color)
|
||||
(if (<= (color-model:rgb-color-distance
|
||||
(send rc red)
|
||||
(send rc green)
|
||||
(send rc blue)
|
||||
(send highlight-tmp-color red)
|
||||
(send highlight-tmp-color green)
|
||||
(send highlight-tmp-color blue))
|
||||
18)
|
||||
(begin (set! last-color rc)
|
||||
rc)
|
||||
#f)]
|
||||
[else
|
||||
(set! last-color #f)
|
||||
rc]))])
|
||||
(when color
|
||||
(case (rectangle-style rectangle)
|
||||
[(ellipse)
|
||||
(send dc set-pen color 3 'solid)
|
||||
(send dc set-brush "black" 'transparent)
|
||||
(send dc draw-ellipse
|
||||
(+ dx left -4)
|
||||
(+ dy top -4)
|
||||
(+ width 8)
|
||||
(+ height 8))]
|
||||
[(rectangle)
|
||||
(send dc set-pen color 1 'transparent)
|
||||
(send dc set-brush color 'solid)
|
||||
(send dc draw-rectangle (+ left dx) (+ top dy) width height)]))))))])
|
||||
(send dc set-smoothing 'aligned)
|
||||
(for-each color-rectangle range-rectangles)
|
||||
(send dc set-smoothing old-smoothing)
|
||||
(send dc set-pen old-pen)
|
||||
(send dc set-brush old-brush)))))
|
||||
|
||||
(define styles-fixed? #f)
|
||||
(public get-styles-fixed set-styles-fixed)
|
||||
|
|
@ -462,8 +505,7 @@ WARNING: printf is rebound in the body of the unit to always
|
|||
(inner (void) after-insert start len)
|
||||
(end-edit-sequence))
|
||||
|
||||
(public move/copy-to-edit)
|
||||
(define (move/copy-to-edit dest-edit start end dest-position)
|
||||
(define/public (move/copy-to-edit dest-edit start end dest-position)
|
||||
(split-snip start)
|
||||
(split-snip end)
|
||||
(let loop ([snip (find-snip end 'before)])
|
||||
|
|
@ -553,9 +595,13 @@ WARNING: printf is rebound in the body of the unit to always
|
|||
|
||||
(define searching<%>
|
||||
(interface (editor:keymap<%> basic<%>)
|
||||
set-searching-str))
|
||||
set-searching-str
|
||||
get-search-hits))
|
||||
|
||||
(define searching-mixin
|
||||
(mixin (editor:keymap<%> basic<%>) (searching<%>)
|
||||
(inherit run-after-edit-sequence invalidate-bitmap-cache)
|
||||
|
||||
(define/override (get-keymaps)
|
||||
(cons (keymap:get-search) (super get-keymaps)))
|
||||
|
||||
|
|
@ -564,7 +610,6 @@ WARNING: printf is rebound in the body of the unit to always
|
|||
(define search-hits 0)
|
||||
(define/public (get-search-hits) search-hits)
|
||||
|
||||
(inherit invalidate-bitmap-cache)
|
||||
(define/public (set-searching-str s [cs? #t])
|
||||
(unless (and (equal? searching-str s)
|
||||
(equal? case-sensitive? cs?))
|
||||
|
|
@ -572,12 +617,29 @@ WARNING: printf is rebound in the body of the unit to always
|
|||
(set! case-sensitive? cs?)
|
||||
(redo-search)))
|
||||
(define/augment (after-insert start len)
|
||||
(redo-search)
|
||||
(unless updating-search?
|
||||
(content-changed))
|
||||
(inner (void) after-insert start len))
|
||||
(define/augment (after-delete start len)
|
||||
(redo-search)
|
||||
(unless updating-search?
|
||||
(content-changed))
|
||||
(inner (void) after-delete start len))
|
||||
|
||||
(define updating-search? #f)
|
||||
|
||||
(define/private (content-changed)
|
||||
(when searching-str
|
||||
(run-after-edit-sequence
|
||||
(λ ()
|
||||
(set! updating-search? #t)
|
||||
(redo-search)
|
||||
(let ([tlw (get-top-level-window)])
|
||||
(when (and tlw
|
||||
(is-a? tlw frame:searchable<%>))
|
||||
(send tlw search-results-changed)))
|
||||
(set! updating-search? #f))
|
||||
'framework:search-results-changed)))
|
||||
|
||||
(inherit get-top-level-window)
|
||||
(define/override (on-focus on?)
|
||||
(let ([f (get-top-level-window)])
|
||||
|
|
@ -585,7 +647,7 @@ WARNING: printf is rebound in the body of the unit to always
|
|||
(when on?
|
||||
(send f set-text-to-search this))))
|
||||
(super on-focus on?))
|
||||
|
||||
|
||||
(inherit highlight-range begin-edit-sequence end-edit-sequence find-string)
|
||||
|
||||
(define clear-regions void)
|
||||
|
|
@ -603,10 +665,11 @@ WARNING: printf is rebound in the body of the unit to always
|
|||
searching-str)])
|
||||
(set! search-hits (+ search-hits counts))
|
||||
(let ([old clear-regions]
|
||||
[new (highlight-range next end (send the-color-database find-color "yellow"))])
|
||||
[new (highlight-range next end "plum" #f 'low 'ellipse)])
|
||||
(set! clear-regions (λ () (old) (new))))
|
||||
(loop end (+ n 1))))))]
|
||||
[else
|
||||
(set! clear-regions void)
|
||||
(invalidate-bitmap-cache)])
|
||||
(end-edit-sequence))
|
||||
|
||||
|
|
@ -855,14 +918,15 @@ WARNING: printf is rebound in the body of the unit to always
|
|||
(send delegate last-position)
|
||||
(send delegate last-position))
|
||||
(loop (send snip next)))))
|
||||
|
||||
(for-each
|
||||
(λ (range)
|
||||
(send delegate unhighlight-range
|
||||
(range-start range)
|
||||
(range-end range)
|
||||
(range-color range)
|
||||
(range-b/w-bitmap range)
|
||||
(range-caret-space? range)))
|
||||
(range-caret-space? range)
|
||||
(range-style range)))
|
||||
(send delegate get-highlighted-ranges))
|
||||
(for-each
|
||||
(λ (range)
|
||||
|
|
@ -870,25 +934,22 @@ WARNING: printf is rebound in the body of the unit to always
|
|||
(range-start range)
|
||||
(range-end range)
|
||||
(range-color range)
|
||||
(range-b/w-bitmap range)
|
||||
(range-caret-space? range)
|
||||
'high))
|
||||
'high
|
||||
(range-style range)))
|
||||
(reverse (get-highlighted-ranges)))
|
||||
(send delegate lock #t)
|
||||
(send delegate end-edit-sequence)))
|
||||
|
||||
(define/override highlight-range
|
||||
(opt-lambda (start end color [bitmap #f] [caret-space? #f] [priority 'low])
|
||||
(when delegate
|
||||
(send delegate highlight-range
|
||||
start end color bitmap caret-space? priority))
|
||||
(super highlight-range start end color bitmap caret-space? priority)))
|
||||
(define/override (highlight-range start end color [caret-space? #f] [priority 'low] [style 'rectangle])
|
||||
(when delegate
|
||||
(send delegate highlight-range start end color caret-space? priority style))
|
||||
(super highlight-range start end color caret-space? priority style))
|
||||
|
||||
(define/override unhighlight-range
|
||||
(opt-lambda (start end color [bitmap #f] [caret-space? #f])
|
||||
(when delegate
|
||||
(send delegate unhighlight-range start end color bitmap caret-space?))
|
||||
(super unhighlight-range start end color bitmap caret-space?)))
|
||||
(define/override (unhighlight-range start end color [caret-space? #f] [style 'rectangle])
|
||||
(when delegate
|
||||
(send delegate unhighlight-range start end color caret-space? style))
|
||||
(super unhighlight-range start end color caret-space? style))
|
||||
|
||||
(inherit get-canvases get-active-canvas has-focus?)
|
||||
(define/override (on-paint before? dc left top right bottom dx dy draw-caret?)
|
||||
|
|
@ -976,9 +1037,10 @@ WARNING: printf is rebound in the body of the unit to always
|
|||
run-after-edit-sequence)
|
||||
(define/private (enqueue-for-frame call-method tag)
|
||||
(run-after-edit-sequence
|
||||
(rec from-enqueue-for-frame
|
||||
(λ ()
|
||||
(call-with-frame call-method)))
|
||||
(let ([from-enqueue-for-frame
|
||||
(λ ()
|
||||
(call-with-frame call-method))])
|
||||
from-enqueue-for-frame)
|
||||
tag))
|
||||
|
||||
;; call-with-frame : ((is-a?/c frame:text-info<%>) -> void) -> void
|
||||
|
|
|
|||
|
|
@ -886,6 +886,33 @@
|
|||
}
|
||||
@definterface[frame:searchable<%> (frame:basic<%>)]{
|
||||
Frames that implement this interface support searching.
|
||||
@defmethod[(search (direction (symbols 'forward 'backward))) void?]{
|
||||
Searches for the text in the search edit in the result of
|
||||
@method[frame:searchable<%> get-text-to-search].
|
||||
|
||||
If the text is found and it sets the selection to the
|
||||
found text.
|
||||
}
|
||||
@defmethod*[(((replace&search) boolean?))]{
|
||||
If the selection is currently active and set to a
|
||||
region that matches the search string, this method
|
||||
replaces the selected region with the contents of
|
||||
the replace editor and then does another search.
|
||||
}
|
||||
@defmethod*[(((replace-all) void?))]{
|
||||
Loops through the text from the beginning to the end, replacing
|
||||
all occurrences of the search string with the contents of the replace
|
||||
edit.
|
||||
}
|
||||
@defmethod*[(((can-replace?) boolean?))]{
|
||||
Returns @scheme[#t] if a replace command would succeed
|
||||
in replacing the current selection with the replace string.
|
||||
|
||||
Specifically, returns @scheme[#t] when the selected text
|
||||
in the result of @method[frame:searchable<%>
|
||||
get-text-to-search] is the same as the text in the find
|
||||
text and the replace editor is visible.
|
||||
}
|
||||
@defmethod*[(((get-text-to-search) (is-a?/c (subclass?/c text%))))]{
|
||||
Returns the last value passed to
|
||||
@method[frame:searchable<%> set-text-to-search].
|
||||
|
|
@ -893,6 +920,9 @@
|
|||
@defmethod[(set-text-to-search [txt (or/c false/c (is-a?/c (subclass?/c text%)))]) void?]{
|
||||
Sets the current text to be searched.
|
||||
}
|
||||
@defmethod[(search-hidden?) boolean?]{
|
||||
Returns @scheme[#t] if the search subwindow is visiable and @scheme[#f] otherwise.
|
||||
}
|
||||
@defmethod*[(((hide-search) void))]{
|
||||
This method hides the searching information on the bottom of the
|
||||
frame.
|
||||
|
|
@ -902,79 +932,19 @@
|
|||
When the searching sub window is hidden, makes it visible.
|
||||
|
||||
}
|
||||
@defmethod*[(((set-search-direction (dir (union -1 1))) void))]{
|
||||
Sets the direction that future searches will be performed.
|
||||
|
||||
|
||||
If @scheme[dir] is @scheme[1] searches will be performed forwards and if
|
||||
@scheme[dir] is @scheme[-1] searches will be performed backwards.
|
||||
@defmethod[(get-case-sensitive-search?) boolean?]{
|
||||
Returns @scheme[#t] if the search is currently case-sensitive.
|
||||
}
|
||||
@defmethod*[(((replace&search) boolean))]{
|
||||
Calls
|
||||
@method[frame:searchable<%> replace]
|
||||
and if it returns @scheme[#t], calls
|
||||
@method[frame:searchable<%> search-again].
|
||||
|
||||
@defmethod[(search-results-changed) void?]{
|
||||
This method is called to notify the frame when
|
||||
}
|
||||
@defmethod*[(((replace-all) void))]{
|
||||
Loops through the text from the current position to the end, replacing
|
||||
all occurrences of the search string with the contents of the replace
|
||||
edit. Only searches forward, does not loop around to the beginning of
|
||||
the text.
|
||||
|
||||
}
|
||||
@defmethod*[(((replace) boolean))]{
|
||||
If the selected text matches the search string, this method replaces
|
||||
the text with the contents of the replace text. If the replace was
|
||||
successful, @scheme[#t] is returned. Otherwise, @scheme[#f] is returned.
|
||||
|
||||
}
|
||||
@defmethod*[(((can-replace?) boolean))]{
|
||||
Returns @scheme[#t] if a replace command would succeed.
|
||||
|
||||
|
||||
Defaultly is @scheme[#t] when the selected text in the result of
|
||||
@method[frame:searchable<%> get-text-to-search]
|
||||
is the same as the text in the find text.
|
||||
}
|
||||
@defmethod*[(((toggle-search-focus) void))]{
|
||||
Toggles the keyboard focus between the searching edit, the replacing edit and the result of
|
||||
@method[frame:searchable<%> get-text-to-search].
|
||||
|
||||
}
|
||||
@defmethod*[(((move-to-search-or-search) (union boolean void)))]{
|
||||
This method moves the focus to the text that contains the search
|
||||
string, or if the focus is there already, performs a forward search.
|
||||
|
||||
It returns void if the focus was not to the search text, otherwise it
|
||||
returns a boolean indicating the success of the search.
|
||||
|
||||
|
||||
}
|
||||
@defmethod*[(((move-to-search-or-reverse-search) (union boolean void)))]{
|
||||
This method moves the focus to the text that contains the search
|
||||
string, or if the focus is there already, performs a reverse search.
|
||||
|
||||
It returns void if the focus was not to the search text, otherwise it
|
||||
returns a boolean indicating the success of the search.
|
||||
|
||||
}
|
||||
@defmethod*[(((search-again (direction Symbol (rm previous searching direction)) (beep? bool |#t|)) boolean))]{
|
||||
Searches for the text in the search edit in the result of
|
||||
@method[frame:searchable<%> get-text-to-search].
|
||||
|
||||
|
||||
Returns @scheme[#t] if the text is found and sets the selection to the
|
||||
found text. If the text is not found it returns @scheme[#f].
|
||||
}
|
||||
}
|
||||
@defmixin[frame:searchable-mixin (frame:standard-menus<%>) (frame:searchable<%>)]{
|
||||
This mixin adds support for searching in the
|
||||
@scheme[editor<%>]
|
||||
in this frame.
|
||||
|
||||
The result of this mixin uses the same initialization arguments as the
|
||||
mixin's argument.
|
||||
@defmethod*[#:mode override (((edit-menu:find-callback (item (is-a?/c menu-item%)) (evt (is-a?/c control-event%))) void))]{
|
||||
|
||||
Calls
|
||||
|
|
@ -1016,10 +986,6 @@
|
|||
|
||||
Builds a panel for the searching information.
|
||||
}
|
||||
@defmethod*[#:mode override (((on-activate) void))]{
|
||||
|
||||
When the frame is activated, searches will take place in this frame.
|
||||
}
|
||||
@defmethod*[#:mode augment (((on-close) void))]{
|
||||
|
||||
Cleans up after the searching frame.
|
||||
|
|
@ -1043,7 +1009,7 @@
|
|||
@defmethod*[#:mode override (((get-editor%) (is-a?/c editor<%>)))]{
|
||||
|
||||
Returns
|
||||
@scheme[text:searching%].
|
||||
@scheme[(text:searching-mixin (super get-editor%))].
|
||||
}
|
||||
}
|
||||
@defclass[frame:basic% (frame:register-group-mixin (frame:basic-mixin frame%)) ()]{}
|
||||
|
|
|
|||
|
|
@ -7,28 +7,36 @@
|
|||
@definterface[text:basic<%> (editor:basic<%> text%)]{
|
||||
Classes matching this interface are expected to implement the basic
|
||||
functionality needed by the framework.
|
||||
@defmethod*[(((highlight-range (start exact-integer) (end exact-integer) (color (instance color%)) (bitmap (union |#f| (instance bitmap%)) |#f|) (caret-space boolean |#f|) (priority (union (quote high) (quote low)) (quote low))) (-> void)))]{
|
||||
@defmethod*[(((highlight-range (start exact-nonnegative-integer?)
|
||||
(end exact-nonnegative-integer?)
|
||||
(color (or/c string? (is-a?/c color%)))
|
||||
(caret-space boolean? #f)
|
||||
(priority (symbols 'high 'low) 'low)
|
||||
(style (symbols 'rectangle 'ellipse) 'rectangle))
|
||||
(-> void)))]{
|
||||
This function highlights a region of text in the buffer.
|
||||
|
||||
The range between @scheme[start] and @scheme[end] will
|
||||
be highlighted with the color in color, if the style is
|
||||
@scheme['rectangle] (the default). If the style is
|
||||
@scheme['ellipse], then the outline of an ellipse is
|
||||
drawn around the range in the editor, using the color.
|
||||
|
||||
The range between @scheme[start] and @scheme[end] will be highlighted with the
|
||||
color in color, and @scheme[bitmap] will be painted over the range of text in
|
||||
black and white. If @scheme[bitmap] is @scheme[#f], the range will be inverted,
|
||||
using the platform specific xor. This method is not recommended, because the
|
||||
selection is also displayed using xor.
|
||||
|
||||
If @scheme[caret-space?] is not @scheme[#f], the left edge of the range
|
||||
will be one pixel short, to leave space for the caret. The caret does
|
||||
not interfere with the right hand side of the range. Note that under X
|
||||
windows the caret is drawn with XOR, which means almost anything can
|
||||
happen. So if the caret is in the middle of the range it may be hard
|
||||
to see, or if it is on the left of the range and @scheme[caret-space?] is
|
||||
If @scheme[caret-space?] is not @scheme[#f], the left
|
||||
edge of the range will be one pixel short, to leave
|
||||
space for the caret. The caret does not interfere with
|
||||
the right hand side of the range. Note that under some
|
||||
platforms, the caret is drawn with XOR, which means
|
||||
almost anything can happen. So if the caret is in the
|
||||
middle of the range it may be hard to see, or if it is
|
||||
on the left of the range and @scheme[caret-space?] is
|
||||
@scheme[#f] it may also be hard to see.
|
||||
|
||||
The @scheme[priority] argument indicates the relative priority for
|
||||
drawing overlapping regions. If two regions overlap and have different
|
||||
priorities, the region with @scheme['high] priority will be drawn second
|
||||
and only it will be visible in the overlapping region.
|
||||
The @scheme[priority] argument indicates the relative
|
||||
priority for drawing overlapping regions. If two regions
|
||||
overlap and have different priorities, the region with
|
||||
@scheme['high] priority will be drawn second and only it
|
||||
will be visible in the overlapping region.
|
||||
|
||||
This method returns a thunk, which, when invoked, will turn off
|
||||
the highlighting from this range.
|
||||
|
|
@ -36,15 +44,19 @@
|
|||
See also
|
||||
@method[text:basic<%> unhighlight-range].
|
||||
}
|
||||
@defmethod*[(((unhighlight-range (start exact-integer) (end exact-integer) (color (instance color%)) (bitmap (union |#f| (instance bitmap%)) |#f|) (caret-space boolean |#f|)) void))]{
|
||||
@defmethod*[(((unhighlight-range
|
||||
(start exact-nonnegative-integer?)
|
||||
(end exact-nonnegative-integer?)
|
||||
(color (or/c string? (is-a?/c color%)))
|
||||
(caret-space boolean? #f)
|
||||
(style (symbols 'rectangle 'ellipse) 'rectangle))
|
||||
void))]{
|
||||
This method removes the highlight from a region of text in
|
||||
the buffer.
|
||||
|
||||
|
||||
The region must match up to a region specified
|
||||
from an earlier call to
|
||||
@method[text:basic<%> highlight-range].
|
||||
|
||||
}
|
||||
@defmethod*[(((get-highlighted-ranges) (listof range)))]{
|
||||
|
||||
|
|
@ -216,6 +228,10 @@
|
|||
If @scheme[cs?] is @scheme[#f], the search is case-insensitive, and
|
||||
otherwise it is case-sensitive.
|
||||
}
|
||||
@defmethod[(get-search-hits) number?] {
|
||||
Returns the number of hits for the search in the buffer, based on the
|
||||
count found last time that a search happened.
|
||||
}
|
||||
}
|
||||
@defmixin[text:searching-mixin (editor:keymap<%> text:basic<%>) (text:searching<%>)]{
|
||||
This
|
||||
|
|
@ -230,6 +246,18 @@
|
|||
result of
|
||||
@scheme[keymap:get-search]
|
||||
}
|
||||
|
||||
@defmethod[#:mode augment (after-insert [start nonnegative-exact-integer?][len nonnegative-exact-integer?]) void?]{
|
||||
Re-does any search now that the contents of the window have changed.
|
||||
}
|
||||
@defmethod[#:mode augment (after-delete [start nonnegative-exact-integer?][len nonnegative-exact-integer?]) void?]{
|
||||
Re-does any search now that the contents of the window have changed.
|
||||
}
|
||||
|
||||
@defmethod[#:mode override (on-focus [on? boolean?]) void?]{
|
||||
Tells the frame containing the editor to search based on this editor via
|
||||
the @method[frame:searchable<%> set-text-to-search] method.
|
||||
}
|
||||
}
|
||||
@definterface[text:return<%> (text%)]{
|
||||
Objects supporting this interface were created by
|
||||
|
|
|
|||
Loading…
Reference in New Issue
Block a user