PR 9814
svn: r12001
This commit is contained in:
parent
b9cbd0a5c8
commit
86671cf6dc
|
@ -359,6 +359,13 @@ WARNING: printf is rebound in the body of the unit to always
|
|||
(set! todo void))
|
||||
(inner (void) after-edit-sequence))
|
||||
|
||||
(define/augment (after-load-file success?)
|
||||
(inner (void) after-load-file success?)
|
||||
(set! ranges (make-hash))
|
||||
(set! ranges-low 0)
|
||||
(set! ranges-high 0)
|
||||
(set! ranges-list #f))
|
||||
|
||||
(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)))])
|
||||
|
@ -426,25 +433,14 @@ WARNING: printf is rebound in the body of the unit to always
|
|||
(let ([new-todo
|
||||
(λ ()
|
||||
(let ([old-val (hash-ref ranges candidate #f)])
|
||||
(unless old-val
|
||||
(error 'unhighlight-range
|
||||
"range not found; start: ~e end: ~e color: ~a caret-space?: ~e style: ~e"
|
||||
start end
|
||||
(if (string? color)
|
||||
(format "~s" color)
|
||||
(format "(red: ~a green: ~a blue: ~a)"
|
||||
(send color red)
|
||||
(send color green)
|
||||
(send color blue)))
|
||||
caret-space?
|
||||
style))
|
||||
(let ([new-val (cdr old-val)])
|
||||
(cond
|
||||
[(null? new-val)
|
||||
(hash-remove! ranges candidate)]
|
||||
[else
|
||||
(hash-set! ranges candidate new-val)]))
|
||||
(set! ranges-list #f)))])
|
||||
(when old-val ;; may have been cleared by an earlier call to unhighlight-range
|
||||
(let ([new-val (cdr old-val)])
|
||||
(cond
|
||||
[(null? new-val)
|
||||
(hash-remove! ranges candidate)]
|
||||
[else
|
||||
(hash-set! ranges candidate new-val)]))
|
||||
(set! ranges-list #f))))])
|
||||
(cond
|
||||
[delayed-highlights?
|
||||
(set! todo
|
||||
|
|
|
@ -143,3 +143,21 @@
|
|||
(send t unhighlight-range 1 2 "red")
|
||||
(send t unhighlight-range 1 2 "red")
|
||||
(length (send t get-highlighted-ranges))))))
|
||||
|
||||
(let ([tmp-file (path->string (make-temporary-file "fwtesttmp~a"))])
|
||||
(test
|
||||
'highlight-range/revert
|
||||
(lambda (x)
|
||||
(delete-file tmp-file)
|
||||
(equal? x 0))
|
||||
(λ ()
|
||||
(send-sexp-to-mred
|
||||
`(let ([t (new text:basic%)])
|
||||
(send t insert "abc")
|
||||
(send t save-file ,tmp-file)
|
||||
(send t highlight-range 0 3 "red")
|
||||
(call-with-output-file ,tmp-file
|
||||
(lambda (port) (display "x\n" port))
|
||||
#:exists 'truncate)
|
||||
(send t load-file)
|
||||
(length (send t get-highlighted-ranges)))))))
|
||||
|
|
Loading…
Reference in New Issue
Block a user