[REBOL] Re: Spell
From: d4marcus:dtek:chalmers:se at: 23-Jan-2001 22:43
On Mon, 22 Jan 2001, Andrew Martin wrote:
> My Spell checker and correcter software (and sample dictionary) is attached.
I think it's wonderful! There's a lot of potential there.
But there is at least one bug in there which I'm not able to fix. For
example, after doing Spell "Python" and replacing Python with Rebol it
asks you about "ebol". This only happens when the new word is shorter than
the original word, and only for the last word. Someone here should be able
to fix it.
> Suggestions for improvements all gratefully accepted.
Well, I took the freedom to make some modifications. I thought it would be
nice to make the graphical UI optional, so I seperated it from the 'Spell
function. Now someone just need to make an UI for the console. Sorry,
didn't have time myself. ;-)
Also made some style changes in the GUI. For the better hopefully.
The I thought it would be nice to be able to enhance 'Spell with extra
rules. So I've added the /extra refinement which takes a block to use as
the first parsed rule. Check 'Spell-HTML for an example how it works. This
function matches tags, urls and emails. Simply ignoring them ATM, but of
course actions can be added to the rule if you need.
Anyway, here's the new code:
Rebol [
Name: 'Spell
Title: "Spell Checker and Corrector"
File: %Spell.r
]
wd: %./ ;insert your Spell directory path here
Spell!: make object! [
Directory: join wd %Spell/
if not exists? Directory [make-dir Directory]
File: %Dictionary.txt
Dictionary: make block! 0
Ignored: make block! 0
Additions: make block! 0
error? try [Dictionary: make hash! sort/case load Directory/:File]
Lower: charset [#"a" - #"z"]
Upper: charset [#"A" - #"Z"]
Alpha: union Upper Lower
WordMatch: [some Alpha opt [[{'} | {-}] some Alpha]]
WordStart: WordEnd: Original: Correction: Before: After: Cancelled: None
Show-GUI: function [] [
face1 orig cfield b-a b-c b-c*
] [
face1: layout [
across
label "Not in Dictionary:" return
text Before
orig: text Original yellow 'bold
text After return
text "Change: "
cfield: field Correction [
either any [empty? Correction (Correction = Original)] [
orig/font/color: yellow
show [orig b-a] hide [b-c b-c*]
] [
orig/font/color: red
show [orig b-c b-c*] hide b-a]
]
return
button "Ignore" #"^i" [
hide-popup
]
button "Ignore All" [
append Ignored Original
hide-popup
]
return
b-a: button "Add" #"^a" [
append Additions Original
hide-popup
]
b-c: button "Change" #"^c" [
WordEnd: change/part WordStart Correction WordEnd
hide-popup
]
b-c*: button "Change All" [
replace/case/all WordStart Original Correction
hide-popup
]
return
button "Cancel" #"^[" orange [
Cancelled: yes
hide-popup
]
button "Quit" #"^Q" red [
quit
]
]
face1/text: "Spell Checker"
show-popup face1
hide [b-c b-c*]
do-events/only face1
]
set 'Spell func [
{Spell checks and corrects (with user interaction) the text supplied.}
Text [string!]
/extra {Extra rule to match before matching words.
The rule may of course include actions.}
rule [block!]
][
Cancelled: no
if not extra [rule: " "]
parse/case/all Text [
some [rule |
WordStart: WordMatch WordEnd: (
Before: copy/part WordStart -29
Original: copy/part WordStart WordEnd
After: copy/part WordEnd +29
Correction: copy Original
if not Cancelled [
if not found? any [
find/case Ignored Original
find/case Additions Original
find/case Dictionary Original
][
Show-GUI
]
]
) :WordEnd
| skip
]
]
if not any [
Cancelled
empty? Additions
][
append Dictionary Additions
clear Additions
save Directory/:File make block! sort/case Dictionary
]
Text
]
]
Spell-HTML!: make object! [
alpha: copy Spell!/Alpha
non-space: complement charset " ^-^/"
to-space: [some non-space | end]
tag: ["<" thru ">"]
url: [some alpha ":/" to-space]
email: [some [alpha | integer! | "."] "@" to-space]
rule: [tag | url | email]
set 'Spell-HTML func [
{Spell checks and corrects (with user interaction) the HTML supplied.}
Text [string!]
][
Spell/extra Text rule
]
]
Marcus
------------------------------------
If you find that life spits on you
calm down and pretend it's raining
