suzanne.soy/racket
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

improve drracket to offer spelling suggestions and to jump to next misspelled word

Browse Source
This commit is contained in:
Robby Findler 2014-06-17 03:21:53 -05:00
parent 9423007652
commit e658e48b01
2 changed files with 111 additions and 10 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

117
pkgs/drracket-pkgs/drracket/drracket/private/unit.rkt
View File

@ -3852,6 +3852,16 @@
(define/override (edit-menu:between-find-and-preferences edit-menu)
(super edit-menu:between-find-and-preferences edit-menu)
(define (aspell-callback f)
(define problem (aspell-problematic?))
(cond
[problem
(message-box (string-constant drscheme) problem)
(f #t)]
[else
(f #f)]))
(define (mk-menu-item checking-turned-on?
turn-checking-on
pref-sym
@ -3874,16 +3884,15 @@
(send item check (and on? (checking-turned-on? ed))))]
[callback
(λ (item evt)
(define problem (aspell-problematic?))
(cond
[problem
(message-box (string-constant drscheme) problem)
(preferences:set pref-sym #f)]
[else
(define ed (get-edit-target-object))
(define old-val (checking-turned-on? ed))
(preferences:set pref-sym (not old-val))
(turn-checking-on ed (not old-val))]))]))
(aspell-callback
(λ (problem?)
(cond
[problem? (preferences:set pref-sym #f)]
[else
(define ed (get-edit-target-object))
(define old-val (checking-turned-on? ed))
(preferences:set pref-sym (not old-val))
(turn-checking-on ed (not old-val))]))))]))
(mk-menu-item (λ (ed) (send ed get-spell-check-strings))
(λ (ed new-val) (send ed set-spell-check-strings new-val))
'framework:spell-check-strings?
@ -3894,6 +3903,94 @@
'framework:spell-check-text?
#\t
(string-constant spell-check-scribble-text))
(new menu:can-restore-menu-item%
[label (string-constant spell-skip-to-next-misspelled-word)]
[shortcut (if (member 'shift (get-default-shortcut-prefix))
#f
#\m)]
[shortcut-prefix (if (member 'shift (get-default-shortcut-prefix))
(get-default-shortcut-prefix)
(cons 'shift (get-default-shortcut-prefix)))]
[parent edit-menu]
[demand-callback
(λ (item)
(define ed (get-edit-target-object))
(define on? (and ed
(is-a? ed color:text<%>)
(= (send ed get-start-position) (send ed get-end-position))))
(send item enable on?))]
[callback
(λ (item evt)
(aspell-callback
(λ (problem?)
(unless problem?
(define ed (get-edit-target-object))
(define orig-pos (send ed get-start-position))
(define (search start end mispelled?)
(let loop ([p start])
(cond
[(< p end)
(define sp (send ed get-spell-suggestions p))
(define found-something? (if mispelled?
(list? sp)
(not (list? sp))))
(cond
[found-something? p]
[else (loop (+ p 1))])]
[else #f])))
(define first-well-spelled (or (search orig-pos (send ed last-position) #f)
(search 0 orig-pos #f)))
(cond
[first-well-spelled
(define mispelled (or (search first-well-spelled (send ed last-position) #t)
(search 0 first-well-spelled #t)))
(cond
[mispelled (send ed set-position mispelled)]
[else (bell)])]
[else (bell)])))))])
(new menu:can-restore-menu-item%
[label (string-constant spell-suggest-corrections)]
[shortcut (if (member 'shift (get-default-shortcut-prefix))
#f
#\k)]
[shortcut-prefix (if (member 'shift (get-default-shortcut-prefix))
(get-default-shortcut-prefix)
(cons 'shift (get-default-shortcut-prefix)))]
[parent edit-menu]
[demand-callback
(λ (item)
(define ed (get-edit-target-object))
(define on? (and ed
(is-a? ed color:text<%>)
(= (send ed get-start-position) (send ed get-end-position))))
(send item enable on?))]
[callback
(λ (item evt)
(aspell-callback
(λ (problem?)
(unless problem?
(define ed (get-edit-target-object))
(define orig-pos (send ed get-start-position))
(match (send ed get-spell-suggestions orig-pos)
[(list start end (cons first rest))
(define suggestions (cons first rest))
(define choice
(get-choices-from-user (string-constant spell-correction-suggestions)
(string-constant spell-choose-replacement-word)
suggestions
this
'(0)))
(when choice
(send ed begin-edit-sequence)
(send ed delete start end)
(send ed insert (list-ref suggestions (car choice)) start start)
(send ed end-edit-sequence))]
[_ (bell)])))))])
(define dicts (get-aspell-dicts))
(when dicts
(define dicts-menu (new menu:can-restore-underscore-menu%

4
pkgs/string-constants-pkgs/string-constants-lib/string-constants/private/english-string-constants.rkt
View File

@ -1804,6 +1804,10 @@ please adhere to these guidelines:
; puts the path to the spell program in the ~a and then the error message
; is put following this string (with a blank line in between)
(spell-program-wrote-to-stderr-on-startup "The spell program (~a) printed an error message:")
(spell-skip-to-next-misspelled-word "Skip to Next Mispelled Word") ;; menu item
(spell-suggest-corrections "Suggest Spelling Corrections...") ;; menu item
(spell-correction-suggestions "Spelling Correction Suggestions") ;; dialog title
(spell-choose-replacement-word "Select a replacement word") ;; label in dialog
;; GUI for installing a pkg package; available via File|Install Package...
(install-pkg-install-by-source "Do What I Mean") ; tab label