add to the framework's spell checking support

the ability to determine if specific spots in the editor correspond to
misspelled words

original commit: 94230076523d10beb2676898a3b99aa5a426225a

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.

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

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))
+                     (define suggestions (list-ref err 2))
-                     (add-coloring color (+ pos lp) (+ pos err-start))
+                     (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))