diff --git a/pkgs/gui-pkgs/gui-doc/scribblings/framework/color.scrbl b/pkgs/gui-pkgs/gui-doc/scribblings/framework/color.scrbl index 42a93011..5347b123 100644 --- a/pkgs/gui-pkgs/gui-doc/scribblings/framework/color.scrbl +++ b/pkgs/gui-pkgs/gui-doc/scribblings/framework/color.scrbl @@ -225,6 +225,15 @@ If the result is @racket[#f], then the default dictionary is used. } + @defmethod[(get-spell-suggestions [pos exact-nonnegative-integer?]) + (or/c #f (list/c exact-nonnegative-integer? + exact-nonnegative-integer? + (listof string?)))]{ + Returns suggested spelling corrections (and the span of the entire word) + to replace the word at @racket[pos]. If the word is spelled correctly or + spell checking is disabled, returns @racket[#f]. + } + @defmethod[(get-regions) (listof (list/c exact-nonnegative-integer? (or/c exact-nonnegative-integer? 'end)))]{ This returns the list of regions that are currently being colored in the editor. diff --git a/pkgs/gui-pkgs/gui-lib/framework/private/aspell.rkt b/pkgs/gui-pkgs/gui-lib/framework/private/aspell.rkt index 54eed6b3..3bc94527 100644 --- a/pkgs/gui-pkgs/gui-lib/framework/private/aspell.rkt +++ b/pkgs/gui-pkgs/gui-lib/framework/private/aspell.rkt @@ -8,7 +8,7 @@ (provide/contract [query-aspell (->* ((and/c string? (not/c #rx"[\n]"))) ((or/c #f string?)) - (listof (list/c number? number?)))] + (listof (list/c number? number? (listof string?))))] ;; may return #f when aspell is really ispell or when ;; something goes wrong trying to get the list of dictionaries @@ -174,20 +174,24 @@ (shutdown-aspell "got eof from process")] [(equal? l "") (send-resp (reverse resp))] [(regexp-match #rx"^[*]" l) (loop resp)] - [(regexp-match #rx"^[&] ([^ ]*) [0-9]+ ([0-9]+)" l) + [(regexp-match #rx"^[&] ([^ ]*) [0-9]+ ([0-9]+): (.*)$" l) => (λ (m) (define word-len (string-length (list-ref m 1))) ;; subtract one to correct for the leading ^ (define word-start (- (string->number (list-ref m 2)) 1)) - (loop (cons (list word-start word-len) resp)))] + (define suggestions (list-ref m 3)) + (loop + (cons + (list word-start word-len (regexp-split #rx", " suggestions)) + resp)))] [(regexp-match #rx"^[#] ([^ ]*) ([0-9]+)" l) => (λ (m) (define word-len (string-length (list-ref m 1))) ;; subtract one to correct for the leading ^ (define word-start (- (string->number (list-ref m 2)) 1)) - (loop (cons (list word-start word-len) resp)))] + (loop (cons (list word-start word-len '()) resp)))] [else (send-resp '()) (shutdown-aspell (format "could not parse aspell output line: ~s" l))])] diff --git a/pkgs/gui-pkgs/gui-lib/framework/private/color.rkt b/pkgs/gui-pkgs/gui-lib/framework/private/color.rkt index 0fafe7de..457b6345 100644 --- a/pkgs/gui-pkgs/gui-lib/framework/private/color.rkt +++ b/pkgs/gui-pkgs/gui-lib/framework/private/color.rkt @@ -13,6 +13,7 @@ added get-regions syntax-color/default-lexer syntax-color/lexer-contract string-constants + data/interval-map "../preferences.rkt" "sig.rkt" "aspell.rkt" @@ -69,7 +70,8 @@ added get-regions get-spell-check-strings set-spell-check-text get-spell-check-text - get-spell-current-dict)) + get-spell-current-dict + get-spell-suggestions)) (define text-mixin (mixin (text:basic<%>) (-text<%>) @@ -425,15 +427,36 @@ added get-regions (define err (car spellos)) (define err-start (list-ref err 0)) (define err-len (list-ref err 1)) - (add-coloring misspelled-color (+ pos err-start) (+ pos err-start err-len)) - (add-coloring color (+ pos lp) (+ pos err-start)) + (define suggestions (list-ref err 2)) + (add-coloring/spell suggestions + misspelled-color + (+ pos err-start) + (+ pos err-start err-len)) + (add-coloring/spell #f + color + (+ pos lp) + (+ pos err-start)) (loop (cdr spellos) (+ err-start err-len))])) (loop (cdr strs) (+ pos (string-length str) 1))))] [else - (add-coloring color sp ep)])] + (add-coloring/spell color sp ep)])] [else - (add-coloring color sp ep)])) + (add-coloring/spell #f color sp ep)])) + + (define/private (add-coloring/spell suggestions color start end) + (add-coloring color start end) + (unless misspelled-regions + (when suggestions + (set! misspelled-regions (make-interval-map)))) + (unless (= start end) + (when misspelled-regions + (interval-map-set! misspelled-regions start end + (and suggestions + (list start end suggestions)))))) + (define misspelled-regions #f) + (define/public (get-spell-suggestions position) + (and misspelled-regions (interval-map-ref misspelled-regions position #f))) (define/private (add-coloring color sp ep) (change-style color sp ep #f))