Annotation of gforth/glosgen.fs, revision 1.1.1.1

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

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