Annotation of gforth/glosgen.fs, revision 1.6

1.1       anton       1: \ Glossary generator.
                      2: \ Written in ANS Forth, requires FILES wordset.
1.2       anton       3: 
                      4: \ This file is part of Gforth.
                      5: 
1.5       anton       6: \ Copyright (C) 1995,1997,2000,2003 Free Software Foundation, Inc.
1.1       anton       7: \ Copyright (c)1993 L.C. Benschop Eindhoven.
1.2       anton       8: 
                      9: \ Gforth is free software; you can redistribute it and/or
                     10: \ modify it under the terms of the GNU General Public License
1.6     ! anton      11: \ as published by the Free Software Foundation, either version 3
1.2       anton      12: \ of the License, or (at your option) any later version.
                     13: 
                     14: \ This program is distributed in the hope that it will be useful,
                     15: \ but WITHOUT ANY WARRANTY; without even the implied warranty of
                     16: \ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
                     17: \ GNU General Public License for more details.
                     18: 
                     19: \ You should have received a copy of the GNU General Public License
1.6     ! anton      20: \ along with this program. If not, see http://www.gnu.org/licenses/.
1.2       anton      21: 
1.1       anton      22: decimal
                     23: 
                     24: : \G postpone \ ; immediate
                     25: \G \G is an alias for \, so it is a comment till end-of-line, but
                     26: \G it has a special meaning for the Glossary Generator.
                     27: 
                     28: \G \G comments should appear immediately above or below the definition of
                     29: \G the word it belongs to. The definition line should contain no more
                     30: \G than the definition, a stack comment and a \ comment after which
                     31: \G the wordset and pronounciation.
                     32: \G An isolated block of \G comments is placed at the beginning of the
                     33: \G glossary file.
                     34: 
                     35: VARIABLE GLOSLIST 
                     36: VARIABLE CURRENT-COMMENT
                     37: VARIABLE FIXLINE
                     38: 
                     39: \ The Glossary entries in memory have the following form.
                     40: \ 1 cell: address of next entry, 1 cell: address of comment field
                     41: \ counted string: name counted string: stack picture 
                     42: \ counted string: extra field counted string: pronunciation.
                     43: 
                     44: 
                     45: \G This command starts a fresh glossary.
                     46: : NEWGLOS 
                     47: \  S" FORGET GSTART CREATE GSTART" EVALUATE
                     48:   0 GLOSLIST ! ;   
                     49: 
                     50: CREATE OLDLINE 256 CHARS ALLOT
                     51: 
                     52: VARIABLE CHARPTR
                     53: 
                     54: 
                     55: \G Insert the header into the list at the alphabetically correct place.
                     56: : INSERT-HEADER ( addr ---) 
                     57:   CHARPTR !
                     58:   GLOSLIST 
                     59:   BEGIN
                     60:    DUP @ 
                     61:    IF
                     62:     DUP @ 2 CELLS + COUNT CHARPTR @ 2 CELLS + COUNT COMPARE 0<=
                     63:    ELSE
                     64:     0
                     65:    THEN
                     66:   WHILE
                     67:    @
                     68:   REPEAT
                     69:   DUP @ CHARPTR @ ! CHARPTR @ SWAP ! 
                     70: ;
                     71: 
                     72: \G Scan a word on oldline through pointer charptr
                     73: : SCAN-WORD ( ---- addr len)
                     74:   BEGIN
                     75:    CHARPTR @ OLDLINE - OLDLINE C@ <= CHARPTR @ C@ BL = AND
                     76:   WHILE
                     77:    1 CHARS CHARPTR +! 
                     78:   REPEAT
                     79:   CHARPTR @ 0
                     80:   BEGIN
                     81:    CHARPTR @ OLDLINE - OLDLINE C@ <= CHARPTR @ C@ BL <> AND
                     82:   WHILE
                     83:    1 CHARS CHARPTR +! 1+
                     84:   REPEAT
                     85: ;
                     86: 
                     87: : SEARCH-NAME 
                     88:   SCAN-WORD 2DROP
                     89:   SCAN-WORD 2DUP BOUNDS ?DO 
                     90:    I C@ [CHAR] a [CHAR] { WITHIN IF I C@ 32 - I C! THEN
                     91:   LOOP \ translate to caps.
                     92:   DUP HERE C! HERE CHAR+ SWAP DUP 1+ CHARS ALLOT CMOVE
                     93: ;
                     94: 
                     95: : SEARCH-STACK
                     96:   0 C,
                     97:   SCAN-WORD S" (" COMPARE 0= IF
                     98:    HERE 1 CHARS -
                     99:    BEGIN
                    100:     CHARPTR @ OLDLINE - OLDLINE C@ <= CHARPTR @ C@ [CHAR] ) <> AND
                    101:    WHILE
                    102:     CHARPTR @ C@ C, 
                    103:     DUP  C@ 1+ OVER C!
                    104:     1 CHARS CHARPTR +!
                    105:    REPEAT
                    106:    DROP
                    107:   THEN
                    108: ;
                    109: 
                    110: : SEARCH-SETS
                    111:   0 C,
                    112: ;
                    113: 
                    114: : SEARCH-PRON
                    115:   0 C,
                    116: ;
                    117: 
                    118: \G Process the header information stored in OLDLINE
                    119: : PROCESS-HEADER
                    120:   HERE 0 , CURRENT-COMMENT @ ,
                    121:   OLDLINE CHARPTR ! 
                    122:   SEARCH-NAME
                    123:   SEARCH-STACK
                    124:   SEARCH-SETS
                    125:   SEARCH-PRON 
                    126:   INSERT-HEADER 
                    127: ;
                    128: 
                    129: \G Determine if line at HERE is glossary comment, if so.
                    130: \G allot it, else store into oldline.
                    131: : GLOS-COMMENT? ( --- flag)
                    132:    HERE C@ 1 > HERE CHAR+ 2 S" \G" COMPARE 0= AND
                    133:    IF
                    134:     HERE C@ 1+ CHARS ALLOT 1 \G incorporate current line.
                    135:    ELSE
                    136:     FIXLINE @ 0=
                    137:     IF
                    138:      HERE OLDLINE HERE C@ 1+ CHARS CMOVE 
                    139:     THEN 0
                    140:    THEN
                    141: ;
                    142: 
                    143: \G Read lines from the file fid until \G line encountered.
                    144: \G Collect all adjacent \G lines and find header line.
                    145: \G then insert entry into list flag=0 if no entry found.
                    146: : MAKE-GLOSENTRY ( fid --- fid flag)
                    147:   >R
                    148:   HERE CURRENT-COMMENT !
                    149:   0 FIXLINE ! 0 OLDLINE C!
                    150:   BEGIN
                    151:    HERE CHAR+ 255 R@ READ-LINE THROW 0= IF
                    152:     DROP R> 0 EXIT \ end of file.
                    153:    THEN
                    154:    HERE C! \ Store length at here.   
                    155:    GLOS-COMMENT?   
                    156:   UNTIL
                    157:   OLDLINE COUNT -TRAILING NIP IF 1 FIXLINE ! THEN
                    158:   BEGIN
                    159:    HERE CHAR+ 255 R@ READ-LINE THROW
                    160:    IF
                    161:     HERE C! 
                    162:     GLOS-COMMENT?
                    163:    ELSE
                    164:     DROP 0
                    165:    THEN
                    166:   0= UNTIL
                    167:   R> 1
                    168:   0 C, ALIGN  \ allocate end flag after included comment lines.
                    169:   PROCESS-HEADER
                    170: ;  
                    171: 
                    172: \G This command reads a source file and builds glossary info
                    173: \G for it in memory.
                    174: : MAKEGLOS ( "name") 
                    175:   BL WORD COUNT R/O OPEN-FILE THROW
                    176:   BEGIN
                    177:    MAKE-GLOSENTRY
                    178:   0= UNTIL
                    179:   CLOSE-FILE THROW 
                    180: ;
                    181: 
                    182: \G Build header line for glossary entry.
                    183: : BUILD-HLINE ( addr ---)
                    184:   79 OLDLINE C! \ Line will be 79 chars long. 
                    185:   OLDLINE CHAR+ 79 BL FILL
                    186:   2 CELLS + 
                    187:   COUNT 2DUP OLDLINE CHAR+ SWAP CMOVE \ place name
                    188:   DUP >R \ save name length.
                    189:   CHARS + 
                    190:   COUNT 2DUP OLDLINE R> 3 + CHARS + SWAP CMOVE \ move stack diagram.
                    191:   CHARS +
                    192:   COUNT 2DUP OLDLINE 45 CHARS + SWAP CMOVE \ move wordsets field.
                    193:   CHARS +
                    194:   COUNT OLDLINE 63 CHARS + SWAP CMOVE \ move pronunciation field.
                    195: ;  
                    196:  
                    197: \G write the glossary entry at address addr to file fid.
                    198: : WRITE-GLOSENTRY ( addr fid --- )
                    199:   >R
                    200:   DUP 2 CELLS + C@ 
                    201:   IF
                    202:    DUP BUILD-HLINE
                    203:    OLDLINE CHAR+ OLDLINE C@ R@ WRITE-LINE THROW \ write header line.
                    204:   THEN
                    205:   CELL+ @
                    206:   BEGIN
                    207:    DUP C@ 1 >
                    208:   WHILE \ write all comment lines without prefixing \G.
                    209:    DUP 4 CHARS + OVER C@ 3 - 0 MAX R@ WRITE-LINE THROW 
                    210:    COUNT CHARS + 
                    211:   REPEAT DROP
                    212:   HERE 0 R> WRITE-LINE THROW \ Write final empty line.
                    213: ;
                    214: 
                    215: 
                    216: \G This command writes the glossary info from memory to a file.
                    217: \G The glossary info may be collected from more source files.
                    218: : WRITEGLOS ( "name")
                    219:   BL WORD COUNT W/O CREATE-FILE THROW
                    220:   GLOSLIST  
                    221:   BEGIN
                    222:    @ DUP
                    223:   WHILE
                    224:    2DUP SWAP WRITE-GLOSENTRY
                    225:   REPEAT DROP
                    226:   CLOSE-FILE THROW
                    227: ;
                    228: 
                    229: \G A typical glossary session may look like:
                    230: \G NEWGLOS MAKEGLOS SOURCE1.FS MAKEGLOS SOURCE2.FS WRITEGLOS GLOS.GLO
                    231: 
                    232: 
                    233: CREATE GSTART

FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>