********************************************************************************************** * 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