Return to glosgen.fs CVS log

Up to [gforth] / gforth

Annotation of gforth/glosgen.fs, revision 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