Annotation of gforth/glosgen.fs, revision 1.2

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

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