/**************************************************************************/
/* $VER: ASpell.ann 1.6 (13 Mar 1996)                                     */
/* The AlphaSpell GUI © Copyright Fergus Duniho 1995-6                    */
/**************************************************************************/

OPTIONS RESULTS
OPTIONS FAILAT 20
SIGNAL ON SYNTAX
SIGNAL ON FAILURE

CALL OpenLib("rexxsupport.library")
CALL OpenLib("rexxtricks.library")
CALL OpenLib("rexxreqtools.library")

EditPort = GetEditPort()
IF EditPort ~= "" THEN ADDRESS VALUE EditPort
PSC = GetScreen()

tempfile = "T:Temp" || TIME(s)
GUI = GetENV("ENV:ASpellGUI")
rttags = "rt_pubscrname =" PSC
win.title = "Select a Word:"
win.gadgettext = "_Accept|_Cancel"
win.pubscreen = PSC
win.width = 40
win.sort = "FALSE"
win.multiselect = "FALSE"

CALL Spellcheck()
CALL Cleanup()
EXIT

/**************************************************************************/
/* Spellcheck() -- The MAIN routine                                       */
/**************************************************************************/

Spellcheck:

/**************************************************************************/
/* Launch Varexx                                                          */
/**************************************************************************/

/* Check Varexx is loaded if not load it */

IF SHOW("P","VAREXX") ~= 1 THEN DO
    ADDRESS COMMAND "run >NIL: varexx"
    ADDRESS COMMAND "WaitForPort VAREXX"
END
ADDRESS VAREXX

IF OPENPORT("HOLLY") = 0 THEN DO
    CALL rtezrequest "Could not open a port.", "_Abort", "Varexx Error:", rttags
    RETURN
END
version
IF RESULT < 1.6 THEN DO
    CALL rtezrequest "You need version 1.6+ of Varexx", "_Okay", "Varexx Error:", rttags
    RETURN
END
"load" GUI "HOLLY PS" PSC
vhost = RESULT
ADDRESS
ADDRESS VALUE vhost

/**************************************************************************/
/* Localize gadget text for chosen language                               */
/**************************************************************************/

lang = GetENV("language")
IF lang ~= "" & lang ~= "english" THEN DO
    catalog = "SYS:Catalogs/ASpell." || lang
    CALL READFILE catalog, lines
    DO x = 1 to lines.0
        INTERPRET "setlabel" "'"lines.x"'"
    END
END

/**************************************************************************/
/* Show About screen while AlphaSpell checks document.                    */
/**************************************************************************/

show about
CALL ReadPrefs()
CALL SaveTemp()

/**************************************************************************/
/* Spell check tempfile with AlphaSpell                                   */
/**************************************************************************/

ADDRESS COMMAND "AlphaSpell -Ss" tempfile "-o" tempfile "-d" dict_path dict_list

/**************************************************************************/
/* Set Lists                                                              */
/**************************************************************************/

CALL ReadList "UNFOUND"
IF UNFOUND.0 = 0 THEN DO
    CALL rtezrequest "No misspellings found.", "_Exit", "Spell Checked Finished:", rttags
    RETURN
END
current = 1
LWORDS.0 = 0
MWORDS.0 = 0

hide
show main
window front activate
CALL SetTarget UNFOUND.1

/**************************************************************************/
/* MAIN LOOP -- Check for GUI events                                      */
/**************************************************************************/

DO FOREVER
    CALL WAITPKT("HOLLY")
    packet = GETPKT("HOLLY")
    IF packet ~= '00000000'x THEN DO
        class = GETARG(packet)
        SELECT
            WHEN class = "CLOSEWINDOW" THEN LEAVE
            WHEN class = "LEARN" THEN CALL Learn()
            WHEN class = "FIND" THEN flag = FindWord(flag)
            WHEN class = "REPLACE" THEN CALL ReplaceWord()
            WHEN class = "ANAGRAMS" THEN CALL ASearch("A")
            WHEN class = "GUESS" THEN CALL ASearch("G")
            WHEN class = "NEXT" THEN CALL SetTarget("+1")
            WHEN class = "PREV" THEN CALL SetTarget("-1")
            WHEN class = "FIRST" THEN CALL SetTarget(1)
            WHEN class = "LAST" THEN CALL SetTarget(UNFOUND.0)
            WHEN class = "SELECT" THEN CALL ChooseWord()
            WHEN class = "PREFS" THEN DO
                CALL Preferences()
                CALL SetTarget(current)
            END
            OTHERWISE NOP
        END
        window front activate
    END
END
IF LWORDS.0 + MWORDS.0 > 0 THEN DO
    hide
    show learn
    CALL QSORT "LWORDS"
    LWORDS.count = LWORDS.0
    setlist lwords clear stem LWORDS select LWORDS.1
    CALL QSORT "MWORDS"
    MWORDS.count = MWORDS.0
    setlist mwords clear stem MWORDS select MWORDS.1
    DO FOREVER
        CALL WAITPKT("HOLLY")
        packet = GETPKT("HOLLY")
        IF packet ~= '00000000'x THEN DO
            class = GETARG(packet)
            SELECT
                WHEN class = "CLOSEWINDOW" THEN LEAVE
                WHEN class = "SAVEWORDS" THEN DO
                    CALL SaveList()
                    LEAVE
                END
                WHEN class = "MOVE" THEN CALL Move()
                WHEN class = "RML" THEN CALL Lose("lwords")
                WHEN class = "RMM" THEN CALL Lose("mwords")
                OTHERWISE NOP
            END
            window front activate
        END
    END
END
ADDRESS
RETURN

/**************************************************************************/
/* VARIOUS SUBROUTINES                                                    */
/**************************************************************************/

/**************************************************************************/
/* SetTarget(word) -- Sets the word in the target string gadget           */
/**************************************************************************/

SetTarget:
IF DATATYPE(arg(1)) = "NUM" THEN DO
    IF VERIFY(arg(1), "+-", "M") = 1 THEN current = current + arg(1)
    ELSE current = arg(1)
    IF current < 1 THEN current = UNFOUND.0
    IF current > UNFOUND.0 THEN current = 1
    settext target UNFOUND.current
    settext replacement UNFOUND.current
END
ELSE DO
    settext target arg(1)
    settext replacement arg(1)
END
flag = 0 /* Word hasn't been searched for since selection */
RETURN

/**************************************************************************/
/* SetReplace() - Sets replacement string gadget                          */
/**************************************************************************/

SetReplace:
settext replacement arg(1)
settext target UNFOUND.current
RETURN

/**************************************************************************/
/* Learn() -- Adds a word to LEARN, the words to learn list               */
/**************************************************************************/

Learn:
read target
wrd = RESULT
/* Tests whether wrd is lowercase */
IF BITOR(wrd,," ") == wrd THEN DO
    IF LSEARCH(wrd, "LWORDS") == -1 THEN DO
        cnt = LWORDS.0 + 1
        LWORDS.0 = cnt
        LWORDS.cnt = wrd
    END
END
ELSE DO
    cur = LSEARCH(wrd, "MWORDS")
    DO WHILE (MWORDS.cur = wrd) & (MWORDS.cur ~== wrd)
        cur = cur + 1
    END
    IF cur == -1 THEN DO
        cnt = MWORDS.0 + 1
        MWORDS.0 = cnt
        MWORDS.cnt = wrd
    END
END
CALL SetTarget("+1")
RETURN

/**************************************************************************/
/* ASearch(mode) has AlphaSpell search for anagrams, matches, or guesses  */
/**************************************************************************/

ASearch:
ARG mode /* G = Guess, A = Anagrams, P = Pattern Match" */
busy set
read replacement
targ = RESULT
IF VERIFY(target, "[]!^*?\", "M") > 0 THEN mode = "P"
com = "AlphaSpell -" || mode "-d" dict_path "-w" targ "-n" edit_dist "-o" tempfile "-k" keyfile dict_list
ADDRESS COMMAND com
CALL ReadList "GUESS"
busy
IF GUESS.0 > 0 THEN DO
    IF VIEWLIST("GUESS", "win", "dest") = 1 THEN CALL SetReplace(dest.1)
END
ELSE CALL rtezrequest "No match found.", "_Continue", "Search Complete:", rttags
RETURN

/**************************************************************************/
/* ChooseWord() -- Select word from listview of unfound words             */
/**************************************************************************/

ChooseWord:
IF VIEWLIST("UNFOUND", "win", "dest") = 1 THEN CALL SetTarget(dest.1)
IF dest.1 ~= "" THEN DO
    current = LSEARCH(dest.1, "UNFOUND")
    uwrd = UPPER(dest.1)
    DO WHILE (UPPER(UNFOUND.current) = uwrd) & (UNFOUND.current ~= dest.1)
        current = current + 1
    END
END
RETURN

/**************************************************************************/
/* SaveList() -- Saves words in the "LEARN" list to user dictionary       */
/**************************************************************************/

SaveList:
udict.low = MAKEPATH(dict_path, user_dict || ".low")
udict.mix = MAKEPATH(dict_path, user_dict || ".mix")
read lwords LEARN
LEARN.0 = LEARN.count
IF LEARN.0 > 0 THEN DO
    CALL WRITEFILE tempfile, "LEARN"
    com = "AlphaSpell -Lco" udict.low tempfile
    IF Exists(udict.low) THEN com = com udict.low
    ADDRESS COMMAND com
END
read mwords LEARN
LEARN.0 = LEARN.count
IF LEARN.0 > 0 THEN DO
    CALL WRITEFILE tempfile, "LEARN"
    com = "AlphaSpell -Lco" udict.mix tempfile
    IF Exists(udict.mix) THEN com = com udict.mix
    ADDRESS COMMAND com
END
CALL DELETE tempfile
RETURN

/**************************************************************************/
/* Move() -- Moves word from mixed case listview to lowercase listview    */
/**************************************************************************/

Move:
setlist lwords BITOR(Lose("mwords"),," ")
RETURN

/**************************************************************************/
/* ReadList -- Reads words from tempfile to a list and sorts the list     */
/**************************************************************************/

ReadList:
CALL READFILE tempfile, arg(1)
INTERPRET arg(1) || ".count =" arg(1) || ".0"
CALL QSORT arg(1)
RETURN

/**************************************************************************/
/* Lose() -- Deletes a word from a listview                               */
/**************************************************************************/

Lose:
INTERPRET "read" arg(1) boo
wrd = RESULT
INTERPRET "setlist" arg(1) "wrd del"
item = boo.select
IF item = boo.count THEN item = item - 1
INTERPRET "setlist" arg(1) "select s update" item
RETURN wrd

/**************************************************************************/
/* Preferences() -- Preferences GUI                                       */
/**************************************************************************/

Preferences:
hide
show prefs
settext dir dict_path
settext dict dict_list
settext udict user_dict
setnum ed edit_dist
settext key keyfile
IF ~EXISTS(keyfile) THEN setbar ed max 2
DO FOREVER
    CALL WAITPKT("HOLLY")
    packet = GETPKT("HOLLY")
    IF packet ~= '00000000'x THEN DO
        class = GETARG(packet)
        SELECT
            WHEN class = "CLOSEWINDOW" | class = "CANCEL" THEN LEAVE
            WHEN class = "SAVE" | class = "USE" THEN DO
                read dir
                dict_path = RESULT
                read dict
                dict_list = RESULT
                read udict
                user_dict = RESULT
                read ed
                edit_dist = RESULT
                read key
                keyfile = RESULT
                CALL WritePrefs "ENV:ASpell.prefs"
                IF class = "SAVE" THEN CALL WritePrefs "ENVARC:ASpell.prefs"
                LEAVE
            END
            OTHERWISE NOP
        END
    END
END
hide
show main
RETURN

/**************************************************************************/
/* WritePrefs() -- Writes Preferences to a file                           */
/**************************************************************************/

WritePrefs:
IF OPEN(output, arg(1), "W") = 1 THEN DO
    CALL WRITELN output, dict_path
    CALL WRITELN output, dict_list
    CALL WRITELN output, user_dict
    CALL WRITELN output, edit_dist
    CALL WRITELN output, keyfile
    CALL CLOSE output
END
RETURN

/**************************************************************************/
/* ReadPrefs() -- Read Preferences from ENV:ASpell.prefs or use defaults  */
/**************************************************************************/

ReadPrefs:
CALL READFILE "ENV:ASpell.prefs", "PREFS"
fields = 5
IF PREFS.0 >= 1 & PREFS.0 <= fields THEN dict_path = PREFS.1
ELSE dict_path = "Work:AlphaSpell/English/"
IF PREFS.0 >= 2 & PREFS.0 <= fields THEN dict_list = PREFS.2
ELSE dict_list = "*.low *.mix"
IF PREFS.0 >= 3 & PREFS.0 <= fields THEN user_dict = PREFS.3
ELSE user_dict = "User"
IF PREFS.0 >= 4 & PREFS.0 <= fields THEN edit_dist = PREFS.4
ELSE edit_dist = 0
IF PREFS.0 >= 5 & PREFS.0 <= fields THEN keyfile = PREFS.5
ELSE keyfile = "S:Alpha-Key"
IF PREFS.0 ~= fields THEN DO
    CALL Preferences()
    show about
END
RETURN

/**************************************************************************/
/* Cleanup() -- Closes down the GUI                                       */
/**************************************************************************/

Cleanup:
IF SHOWLIST("P", "HOLLY") = 1 THEN CALL CLOSEPORT ("HOLLY")
IF SHOWLIST("P", "VAREXX") = 1 THEN ADDRESS "VAREXX" hide unload
RETURN

/**************************************************************************/
/* OpenLib(library) -- Checks that library exists and opens it if it does */
/**************************************************************************/

OpenLib: PROCEDURE

IF EXISTS("libs:" || arg(1)) THEN DO
    IF ~SHOW("L", arg(1)) THEN
        IF ~ADDLIB(arg(1),0,-30,0) THEN EXIT
END
ELSE EXIT
RETURN

/**************************************************************************/
/* ERROR MESSAGES                                                         */
/**************************************************************************/

failure:
syntax:
SAY "Error" rc  "-- Line" SIGL
SAY errortext(rc)
SAY sourceline(SIGL)
CALL Cleanup()
EXIT

/**************************************************************************/
/* Functions to get around the limits of some text editors. You might or  */
/* might not need some of these.                                          */
/**************************************************************************/

/**************************************************************************/
/* Replace(word, target, replacement)                                     */
/**************************************************************************/

Replace: PROCEDURE
PARSE ARG word, target, repl
start = 1
size = Length(target)
DO WHILE start < Length(word)
    x = Pos(target, word, start)
    IF x == 0 THEN LEAVE
    word = Delstr(word, x, size)
    word = Insert(repl, word, x-1)
    start = x + size + 1
END
RETURN word

/**************************************************************************/
/* WordComp(string, word) -- Checks whether a target word can be parsed   */
/* from a given string. This is useful if your text editor lacks a whole  */
/* word search mode. You can search for a word, read the full text of the */
/* found string, and compare them.                                        */
/**************************************************************************/

WordComp: PROCEDURE
Parse Arg str, wrd, x
s = Index(str, wrd, x)
IF s = 0 THEN RETURN 0
IF s>1 THEN DO
    c = Substr(str, s-1, 1)
    IF Datatype(c, "A") = 1 | c = "'" THEN RETURN 0
END
s = s + Length(wrd)
IF s > Length(str) THEN RETURN 1
c = Substr(str, s, 1)
IF Datatype(c, "M") = 1 THEN RETURN 0
RETURN 1
END

/**************************************************************************/
/* EDITOR SPECIFIC SUBROUTINES                                            */
/**************************************************************************/

/**************************************************************************/
/* FindWord(flag) -- Finds selected word in document                      */
/**************************************************************************/

FindWord: PROCEDURE
read target
wrd = RESULT /* Reads selected word */
ADDRESS
IF arg(1) = 0 THEN MOVE_CURSOR ABS 0 0
SET FIND_TEXT wrd
DOMENU FIND_NEXT
ADDRESS
RETURN 1

/**************************************************************************/
/* ReplaceWord() -- Replaces selected word with word in string gadget     */
/**************************************************************************/

ReplaceWord:
read target
oldword = RESULT
read replacement
newword = RESULT
ADDRESS
DEL Length(oldword)
INSERT STRING newword
ADDRESS
RETURN

/**************************************************************************/
/* SaveTemp() -- Saves the current file as a temporary file               */
/**************************************************************************/

SaveTemp:
ADDRESS
DOMENU SELECT_ALL
DOMENU COPY 0
ADDRESS
ADDRESS COMMAND "ClipSave" tempfile
RETURN

/**************************************************************************/
/* GetEditPort() -- Makes sure the right text editor port is open.        */
/**************************************************************************/

GetEditPort:
IF Abbrev(Address(), "Annotate_Rexx") = 1 THEN RETURN Address()
IF ~SHOWLIST("P", "Annotate_Rexx") THEN DO
    CALL rtezrequest "Annotate_Rexx unavailable", "_Abort", "Missing Port:"
    EXIT
END
RETURN "Annotate_Rexx"

/**************************************************************************/
/* GetScreen() -- Returns the screen name                                 */
/**************************************************************************/

GetScreen: PROCEDURE
RETURN GETDEFAULTPUBSCREEN()