[REBOL] Re: Spell
From: d4marcus:dtek:chalmers:se at: 24-Jan-2001 22:39
On Tue, 23 Jan 2001, Marcus Petersson wrote:
> 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,
But now there is one! It is called with the refinement /cons (for console
mode). 'Spell/cons works with Rebol/Core. I've even tested it with a 2MB
elisp.html file and it seems to work fine. Didn't bother to check all of
it though. ;-)
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
Change-word: func [/all] [
either all [replace/case/all WordStart Original Correction] [
WordEnd: change/part WordStart Correction WordEnd]]
Text-UI: function [] [
same s-a s-c cons edit char buffer
] [
s-c: {^(1B)[KIgnore (Tab) Ignore All (^^x) Change (^^g) Change All (^^h)}
same: yes
prin "^(1B)[5A^(1B)[K" ; go up 4 lines and clear
print [Before " |-> " Original " <-| " After]
print s-a: {^(1B)[KIgnore (Tab) Ignore All (^^x) Add (^^a)}
print {Edit (Enter) Cancel (^^d) Quit (^^c)^/^/}
cons: open/binary [scheme: 'console]
while [
wait cons
char: to-char first cons
] [
switch char [
#"^-" [break]
#"^X" [append Ignored Original break]
#"^A" [if same [append Additions Original break]]
#"^G" [if not same [Change-word break]]
#"^H" [if not same [Change-word/all break]]
#"^M" [prin "^(1B)[AChange: ^(1B)[K"
Correction: input
if not empty? Correction [remove system/console/history]
prin "^(1B)[4A" ; go up 4 lines
same: any [empty? Correction (Correction = Original)]
either same [print s-a] [print s-c]
prin "^(1B)[2B" ; go down 2 lines
if same [prin "^(1B)[K"]
prin "^(1B)[B" ; go down 1 line
]
#"^D" [Cancelled: yes break]
#"^C" [quit]
]
]
close cons
]
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" #"^X" [
append Ignored Original
hide-popup
]
return
b-a: button "Add" #"^A" [
append Additions Original
hide-popup
]
b-c: button "Change" #"^G" [
Change-word
hide-popup
]
b-c*: button "Change All" #"^H" [
Change-word/all
hide-popup
]
return
button "Cancel" #"^D" orange [
Cancelled: yes
hide-popup
]
button "Quit" #"^C" red [
quit
]
]
face1/text: "Spell Checker"
show-popup face1
hide [b-c b-c*]
do-events/only face1
]
strip-newlines: func [strings [block!]] [
foreach s strings [replace/all s "^/" " "]]
set 'Spell func [
{Spell checks and corrects (with user interaction) the text supplied.}
Text [string!]
/cons {Use the console UI instead of View GUI.}
/extra {Extra rule to match before matching words.
The rule may of course include actions.}
rule [block!]
][
Cancelled: no
if not extra [rule: " "]
if cons [print "^/^/^/^/^/"]
parse/case/all Text [
some [rule |
WordStart: WordMatch WordEnd: (
Before: copy/part WordStart -25
Original: copy/part WordStart WordEnd
After: copy/part WordEnd +25
Correction: copy Original
if not Cancelled [
if not found? any [
find/case Ignored Original
find/case Additions Original
find/case Dictionary Original
][
either cons [strip-newlines reduce [Before After]
Text-UI] [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!]
/cons {Use the console UI instead of View GUI.}
][
either cons [Spell/cons/extra Text rule] [Spell/extra Text rule]
]
]
Marcus
------------------------------------
If you find that life spits on you
calm down and pretend it's raining