File:  [gforth] / gforth / glosgen.fs
Revision 1.7: download - view: text, annotated - select for diffs
Mon Dec 31 19:02:24 2007 UTC (11 years, 7 months ago) by anton
Branches: MAIN
CVS tags: v0-7-0, HEAD
updated copyright year after changing license notice

    1: \ Glossary generator.
    2: \ Written in ANS Forth, requires FILES wordset.
    3: 
    4: \ This file is part of Gforth.
    5: 
    6: \ Copyright (C) 1995,1997,2000,2003,2007 Free Software Foundation, Inc.
    7: \ Copyright (c)1993 L.C. Benschop Eindhoven.
    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 3
   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, see http://www.gnu.org/licenses/.
   21: 
   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>