**********************************************************************************************
* DBG006R4 Rebuild keyword index for selected document
* Copyright (C) 2000 Martin Rowe <martin@dbg400.net>
*
* This program is free software; you can redistribute it and/or modify
* it under the terms of the GNU General Public License as published by
* the Free Software Foundation; either version 2 of the License, or
* (at your option) any later version.
*
* This program is distributed in the hope that it will be useful,
* but WITHOUT ANY WARRANTY; without even the implied warranty of
* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
* GNU General Public License for more details.
*
* You should have received a copy of the GNU General Public License
* along with this program; if not, write to the Free Software
* Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
**********************************************************************************************
H DATEDIT(*YMD) DEBUG(*YES) OPTION(*NODEBUGIO : *SRCSTMT)
**********************************************************************************************
FDBGDFTD1 IF E K DISK
FDBGDFTH1 IF E K DISK
FDBGDFTK1 UF A E K DISK
**********************************************************************************************
* Output text 50 lines of upto 132 characters
D P#Out S 132 DIM(50)
D Ignore S 10 DIM(50) CTDATA PERRCD(10)
**********************************************************************************************
* DATA STRUCTURES
**********************************************************************************************
D #wordno S 3 0
*
D Attrib C CONST(X'202122232425262728292A2B2C2D-
D 2E2F303132333435363738393A3B3C3D3E')
D Blank C CONST(' ')
D DoneTitle S 1
D Lower C CONST('abcdefghijklmnopqrstuvwxyz')
D Normal C CONST(X'4040404040404040404040404040-
D 4040404040404040404040404040404040')
D Other C CONST('!"£%&*()-_=+@''?;:.,#|<>/{}[]-
D ')
* Input data in chunks of entry length
D P#In S 132
D P#RtnEnt S 3 0
D String S 79
D String2 S 79
D Upper C CONST('ABCDEFGHIJKLMNOPQRSTUVWXYZ')
**********************************************************************************************
* ENTRY PARAMETERS
**********************************************************************************************
C *ENTRY PLIST
C PARM DFDOCD
**********************************************************************************************
C IDXKEY KLIST
C KFLD DFDOCD
C KFLD DFWORD
**********************************************************************************************
* MAINLINE PROGRAM
**********************************************************************************************
* Delete records for this document
B001 C DOU *IN80
C DFDOCD DELETE DB1DFTK1 80
E001 C ENDDO
* Read all text entries for this document
C DFDOCD CHAIN DBGDFTD1 80
B001 C DOW *IN80 = *off
* Convert to uppercase
C Lower:Upper XLATE DFTEXT String
* Strip out display attributes
C Attrib:Normal XLATE String String2
* and punctuation, etc.
C Other:Blank XLATE String2 P#In
* Parse the sentence into separate words
C CALL 'DBG041R4'
C PARM P#In
C PARM 0 P#RtnEnt
C PARM P#Out
* Process each of the returned words
B002 C 1 DO P#RtnEnt #wordno
C EVAL DFWORD = P#Out(#wordno)
* Ignore words in the ignore list (see compile time data at end of code)
C DFWORD LOOKUP Ignore 70
* If not to be ignored
B003 C IF *IN70 = *off
* Check if this document/word pair exists already
C IDXKEY CHAIN DBGDFTK1 81
* and write it if it doesn't
B004 C IF *IN81 = *on
C WRITE DB1DFTK1
E004 C ENDIF
E003 C ENDIF
E002 C ENDDO
* Next text record
C DFDOCD READE DBGDFTD1 80
* If no more text records, index the title
B002 C IF *IN80 AND DoneTitle = *off
C EVAL DoneTitle = *on
C DFDOCD CHAIN DBGDFTH1 80
B003 C IF *IN80 = *off
C EVAL DFTEXT = DFDOCH
E003 C ENDIF
E002 C ENDIF
E001 C ENDDO
C EVAL *INLR = *on
C RETURN
**********************************************************************************************
** Five lines of 'words' to be ignored
A AND AS ARE I IF THE OR B
C D E TO ON NOT IS IN THIS FOR
OF HAS P BE FROM BUT HAVE WHEN WITH WILL
THAT WAS NO S AT SO AN NOW THERE ON