/*------------------------------------------------------------------*/ /* VFYSPL: Spelling verifier -- accepts a word or phrase up to */ /* 256 characters in length and verifies spelling. Optionally, */ /* lists of alternative spellings for misspelled words are */ /* presented. (Alternatives for ALL words in the phrase may also */ /* be requested.) The input phrase may have any form of standard */ /* punctuation. */ /* */ /* The input phrase is passed through the Check Spelling API. If */ /* suggestions for misspellings is requested, the API returns a */ /* list of misspelled words. Otherwise, it returns a list of all */ /* words in the phrase. The returned list is passed a word at a */ /* time through the Spelling Aid API if requested. */ /*------------------------------------------------------------------*/ VFYSPL: PGM PARM(&WORD &WRDLEN &VFYOPT &SUGGESTOPT) DCL VAR(&WORD) TYPE(*CHAR) LEN(258) DCL VAR(&WRDLEN) TYPE(*DEC) LEN(3 0) DCL VAR(&VFYOPT) TYPE(*LGL) DCL VAR(&SUGGESTOPT) TYPE(*LGL) /*------ ------*/ /* */ /* Parameter area for the Check Spelling API... */ /* */ DCL VAR(&ODATA) TYPE(*CHAR) LEN(1024) DCL VAR(&ODATALEN) TYPE(*CHAR) LEN(4) + VALUE(X'00000400') /* Length is 1024... */ DCL VAR(&OFORMAT) TYPE(*CHAR) LEN(8) DCL VAR(&IDATA) TYPE(*CHAR) LEN(256) DCL VAR(&IDATALEN) TYPE(*CHAR) LEN(4) + VALUE(X'00000100') /* Length is 256... */ DCL VAR(&IDICT) TYPE(*CHAR) LEN(172) DCL VAR(&IDICTLEN) TYPE(*CHAR) LEN(4) + VALUE(X'000000AC') /* Length is 172... + Note: Documentation for QTWCHKSP states + that 172 is the only valid value... */ DCL VAR(&ODICT) TYPE(*CHAR) LEN(8) /* Minimum + length... we don't care to get any back... */ DCL VAR(&ODICTLEN) TYPE(*CHAR) LEN(4) + VALUE(X'00000000') /* Length is 0... */ DCL VAR(&ERRCODE) TYPE(*CHAR) LEN(4) + VALUE(X'00000000') /* Get all errors + returned as exception messages... */ /* Used to build input dictionary list for Check Spelling API... */ DCL VAR(&IDOFFSET) TYPE(*CHAR) LEN(4) + VALUE(X'0000000C') /* Offset is 12... */ DCL VAR(&IDENTRIES) TYPE(*CHAR) LEN(4) + VALUE(X'00000004') /* Count is 4... */ DCL VAR(&IDRESERVED) TYPE(*CHAR) LEN(4) + VALUE(X'00000000') DCL VAR(&IDLIST) TYPE(*CHAR) LEN(160) + VALUE('US QDCT UK + QDCT LEGAL QDCT MEDICAL + QDCT') /* Start with the basic four... + add a user *SPADCT later if one exists... */ /*------ ------*/ /* */ /* Various work areas and fields... */ /* */ DCL VAR(&MISSPELLED) TYPE(*DEC) LEN(8) VALUE(0) DCL VAR(&USER) TYPE(*CHAR) LEN(10) DCL VAR(&@NO) TYPE(*LGL) LEN(1) VALUE('0') DCL VAR(&SPADCT) TYPE(*LGL) LEN(1) VALUE('1') DCL VAR(&RESULT) TYPE(*CHAR) LEN(9) + VALUE('incorrect') DCL VAR(&DEC) TYPE(*DEC) LEN(5 0) /*------ ------*/ /* The word to check for alternates against... */ DCL VAR(&CWORD) TYPE(*CHAR) LEN(32) /* The word list word counter... */ DCL VAR(&WD_WC) TYPE(*DEC) LEN(3) /* A single Word-Information-Entry and some WIE attributes... */ DCL VAR(&WIE) TYPE(*CHAR) LEN(16) DCL VAR(&WIE_LEN) TYPE(*DEC) LEN(5) DCL VAR(&WIE_ADDR) TYPE(*DEC) LEN(5) DCL VAR(&WIE_OS) TYPE(*DEC) LEN(5) /* A counter while processing WIEs... */ DCL VAR(&WORD_CTR) TYPE(*DEC) LEN(5) VALUE(0) /* Pointers to the current word in the returned-word list... */ DCL VAR(&CW_ADDR) TYPE(*DEC) LEN(5) /* The length of the current word in the returned-word list... */ DCL VAR(&CW_LEN) TYPE(*DEC) LEN(3) /*------------------------------------------------------------------*/ /* */ /* Check this user to see if a personal *spadct exists... */ /* */ RTVUSRPRF RTNUSRPRF(&USER) CHKOBJ OBJ(*LIBL/&USER) OBJTYPE(*SPADCT) MONMSG MSGID(CPF9801) EXEC(CHGVAR VAR(&SPADCT) + VALUE(&@NO)) /* Apparently not... */ /* Add any personal *spadct to the end of the list... */ IF COND(&SPADCT) THEN(DO) CHGVAR VAR(&IDENTRIES) VALUE(X'00000005') /* New + count is 5... */ CHGVAR VAR(%SST(&IDLIST 81 20)) VALUE(&USER *CAT + '*LIBL') ENDDO /* Build the full input-list-of-dictionaries parm... */ CHGVAR VAR(&IDICT) VALUE(&IDOFFSET *CAT &IDENTRIES + *CAT &IDRESERVED *CAT &IDLIST) /* Get the actual length of the input word parm... */ CHGVAR VAR(&DEC) VALUE(%BIN(&WORD 1 2)) IF COND(&WRDLEN < 1 *OR &WRDLEN > &DEC) THEN(DO) CHGVAR VAR(&WRDLEN) VALUE(&DEC) ENDDO /* ...and put it in place for the spell checker... */ CHGVAR VAR(&IDATA) VALUE(%SST(&WORD 3 &WRDLEN)) CHGVAR VAR(%BIN(&IDATALEN)) VALUE(&WRDLEN) /* Decide if we'll suggest all or only misspellings... */ IF COND(&SUGGESTOPT) THEN(CHGVAR VAR(&OFORMAT) + VALUE(CHKW0200)) ELSE CMD(CHGVAR VAR(&OFORMAT) VALUE(CHKW0100)) /*------ ------*/ /* */ /* This is the spell-check API... */ /* */ CALL PGM(QTWCHKSP) PARM(&ODATA &ODATALEN &OFORMAT + &IDATA &IDATALEN &IDICT &IDICTLEN &ODICT + &ODICTLEN &ERRCODE) /*------ ------*/ /* See if misspellings were found... */ CHGVAR VAR(&MISSPELLED) VALUE(%BIN(&ODATA 9 4)) /* If all correct and suggest-all wasn't requested, get out... */ IF COND(&MISSPELLED = 0) THEN(DO) IF COND(*NOT &SUGGESTOPT) THEN(DO) SNDPGMMSG MSGID(CPF9898) MSGF(QCPFMSG) MSGDTA('No + misspelled words available') MSGTYPE(*COMP) RETURN ENDDO CHGVAR VAR(&RESULT) VALUE('correct') ENDDO /*------------------------------------------------------------------*/ /* */ /* Process through 'Alternative Spelling' if requested... */ /* */ IF COND(&VFYOPT) THEN(DO) /* Initialize word position pointer for this segment... */ CHGVAR VAR(&WORD_CTR) VALUE(0) /* */ /* Gets word count from the returned word list... */ /* */ CHGVAR VAR(&WD_WC) VALUE(%BIN(&ODATA 9 4)) /* */ /* Gets to the length of the WIEs... */ /* */ CHGVAR VAR(&WIE_LEN) VALUE(%BIN(&ODATA 21 4)) CHGVAR VAR(&WIE_OS) VALUE(%BIN(&ODATA 17 4)) CHGVAR VAR(&WIE_ADDR) VALUE(1 + &WIE_OS) /*------ ------*/ /* */ /* Word Information Entries are fixed-length/fixed-format. Each */ /* has a pointer to one word in the list of returned words and a */ /* length for that word. By combining pointer and length, a */ /* single returned word can be extracted. The WIEs are looped */ /* through and each returned word is sent to the List Alternative */ /* Spellings command. */ /* */ /* Get the next Word Information Entry... */ /* */ WD_LOOP: CHGVAR VAR(&WIE) VALUE(%SST(&ODATA &WIE_ADDR + &WIE_LEN)) /* */ /* Get the position info for the next word... */ /* */ CHGVAR VAR(&CW_ADDR) VALUE(%BIN(&WIE 1 4) + 1) CHGVAR VAR(&CW_LEN) VALUE(%BIN(&WIE 5 4)) /* */ /* Extract the current word from the word list... */ /* */ CHGVAR VAR(&CWORD) VALUE(%SST(&ODATA &CW_ADDR + &CW_LEN)) /*------ ------*/ /* */ /* Now we can actually show a list of alternatives for THIS word...*/ /* */ LSTALTSPL WORD(&CWORD) MONMSG MSGID(CPF0000 CPF9999) MONMSG MSGID(SYU8010) EXEC(GOTO CMDLBL(END_ALTSPL)) + /* was pressed... */ /*------ ------*/ /* */ /* Set our word pointer up to the next word... */ /* */ CHGVAR VAR(&WORD_CTR) VALUE(&WORD_CTR + 1) /* */ /* Point to next WIE... */ /* */ CHGVAR VAR(&WIE_ADDR) VALUE(&WIE_ADDR + &WIE_LEN) /* */ /* As long as the word pointer is less than the word count for */ /* this dictionary, keep looping back... */ /* */ IF COND(&WORD_CTR *LT &WD_WC) THEN(GOTO + CMDLBL(WD_LOOP)) /*------ ------*/ ENDDO /*------------------------------------------------------------------*/ /* Send a *comp message back containing result... */ END_ALTSPL: SNDPGMMSG MSGID(CPF9898) MSGF(QCPFMSG) + MSGDTA('Spelling is:' *BCAT &RESULT) + MSGTYPE(*COMP) RETURN ENDPGM