color-ed2.f


0 [IF]
  Forth to HTML converter

  Written by Brad Eckert
  Modifications by Dirk Busch and Ed Beroset

  Revision 4. See bottom for revision history.

  This ANS Forth program is public domain. It translates ANS Forth to colorized
  HTML. Hyperlinks to the ANS Forth draft standard are inserted for all ANS
  standard words. Hyperlinks to user definitions are included.

  Usage: HTML FileName       Generates HTML file from Forth source
                             output file is Filename with .HTM extension
         Q [forth code]      Outputs HTML for 1 line to screen

  Q is used for debugging. You can use "linenum ?" to show the line number if an
  ABORT occurs. The HTML is about 10 times as big as the Forth source because of
  all the links, color changes and whitespace.

  INCLUDEd files produce corresponding HTML pages. Most browsers get severely
  bogged down with large files. If you're converting a large Forth program to
  HTML, try to keep the source files under 500 lines each by splitting long
  source into multiple INCLUDE files. HTML pages are best viewed with Internet
  Explorer or Netscape 4.7. Netscape 6 is more sluggish with large files.

  When you INCLUDE this file some redefinition complaints will occur. That's
  okay since you won't be loading an application on top of this.
[THEN]

ONLY FORTH ALSO DEFINITIONS

\ ------------------------------------------------------------------------------
\ Configuration:

\ Hyperlink to the original file, or not.
\ Output at the TOP of the HTML-File

1 VALUE LINK-TO-ORG-FILE

\ path to the ANS-Files
CREATE DPANS-PATH ," http://www.tinyboot.com/ANS/"

\ ------------------------------------------------------------------------------


: [undef] ( <name> -- f ) BL WORD FIND NIP 0= ;
[undef] C+!    [IF] : C+! SWAP OVER C@ + SWAP C! ;                      [THEN]
[undef] BOUNDS [IF] : BOUNDS OVER + SWAP ;                              [THEN]
[undef] SCAN   [IF] : SCAN
  >R
  BEGIN DUP WHILE OVER C@ R@ <> WHILE 1 /STRING REPEAT THEN
  R> DROP ;                                                              [THEN]
[undef] SKIP   [IF] : SKIP  
  >R
  BEGIN DUP WHILE OVER C@ R@ = WHILE 1 /STRING REPEAT THEN
  R> DROP ;                                                              [THEN]
[undef] NOOP   [IF] : NOOP ;                                            [THEN]
[undef] +PLACE [IF] : +PLACE 2DUP 2>R COUNT CHARS + SWAP MOVE 2R> C+! ; [THEN]
[undef] PLACE  [IF] : PLACE  0 OVER C! +PLACE ;                         [THEN]
[undef] FDROP  [IF] : FDROP ;                                           [THEN]
[undef] >FLOAT [IF] : >FLOAT DROP C@ [CHAR] 0 [CHAR] 9 1+ WITHIN ;      [THEN]

0 VALUE outf                                    \ output to file
1 VALUE screen-only                             \ screen is for testing
: werr  ABORT" Error writing file" ;
: out   screen-only IF TYPE    ELSE outf WRITE-FILE werr THEN ;
: outln screen-only IF TYPE CR ELSE outf WRITE-LINE werr THEN ;

: bang PAD C@ 84 > IF 0 0 C! THEN ;

WORDLIST CONSTANT hyperlinks
VARIABLE attrib
: /a      ( -- )         attrib @ IF S" </a>" out THEN 0 attrib ! ;
: (,$)      ( a len -- )   DUP C, BOUNDS ?DO I C@ C, LOOP ; \ text to dictionary
: text    ( <text> -- )  -1 WORD COUNT -TRAILING (,$) ;
: line    ( a line# -- ) 0 ?DO COUNT + LOOP COUNT out ;   \ output one string
: boiler  ( addr -- )    BEGIN COUNT DUP WHILE 2DUP + >R outln R> REPEAT 2DROP ;

CREATE misctext                                 \ various attribute strings
  text <a href="
  text <a name="x
  text ">
  text <a href="#x
  text ">
  text <span style="color:#
  text <hr /><h1>
  text </h1><hr /><pre>
  text </span>
  text "
  text </a>
  0 C,

VARIABLE color                                  \ current color
VARIABLE active-color                           \ active color
VARIABLE infont                                 \ within <font> tag

: fontcolor ( color -- )                        \ change font color
  DUP active-color @ <> IF
     DUP active-color !
     1 infont !
     BASE @ >R
     misctext 5 line 0 HEX <# # # # # # # #> out
     misctext 2 line       
     R> BASE !
  ELSE DROP
  THEN ;

: fcol ( color <name> -- )                       \ define a font color
  CREATE , DOES> @ color ! ;

HEX
808080 fcol unknown
008000 fcol commentary
CC0000 fcol numeric
990080 fcol values
000000 fcol userwords
009999 fcol userdefiner
CC00CC fcol variables
0000FF fcol core_ws
0000FF fcol core_ext_ws
0000FF fcol block_ws
0000FF fcol double_ws
0000FF fcol exception_ws
0000FF fcol facilities_ws
0000FF fcol file_ws
0000FF fcol fp_ws
0000FF fcol local_ws
0000FF fcol malloc_ws
0000FF fcol progtools_ws
0000FF fcol searchord_ws
0000FF fcol string_ws
DECIMAL

CREATE begin_header                             \ begin of HTML file part 1
  text <?xml version="1.0"?>
  text <!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Strict//EN"
  text     "http://www.w3.org/TR/xhtml1/DTD/xhtml1-strict.dtd">
  text <html xmlns="http://www.w3.org/1999/xhtml" xml:lang="en" lang="en">
  text <head>
  text <meta http-equiv="Content-Type" content="text/xml; charset=iso-8859-1" />
  text <meta name="GENERATOR" content="Forth2HTML 0.4" />
  text <style type="text/css">
  text body {background: #FFFFEE; }
  text h1 {color: #000000;}
  text p {font-family: monospace;}
  text a {text-decoration:none;}
  text </style>
  text <title>
  0 C,

\ body defaults: the most common link color (blue) is made the default color
\ the most common plain text color (green) is made default.

CREATE mid_header                               \ begin of HTML file part 2
  text </title></head>
  text <body>
  0 C,

CREATE end_header                               \ end of HTML file
  text </pre></body>
  text </html>
  0 C,

HEX
: setcolor ( -- )                               \ select next color
  attrib @ 1 = color @ 0000FF = AND 0=         \ blue link: don't color
  IF color @ fontcolor THEN ;
DECIMAL

: closefont ( -- )
  /a
  infont @ IF
  misctext 8 line 0 infont ! THEN ;
   

: outh    ( a n -- )                            \ HTMLized text output
  BOUNDS ?DO I C@ CASE
     [CHAR] & OF S" &amp;"  out ENDOF
     [CHAR] < OF S" &lt;"   out ENDOF
     [CHAR] > OF S" &gt;"   out ENDOF
     [CHAR] " OF S" &quot;" out ENDOF
     I 1 out   
  ENDCASE LOOP ;

: outhattr  ( a n -- )                            \ HTMLized text output
  BOUNDS ?DO I C@ CASE
     [CHAR] & OF S" amp"  out ENDOF
     [CHAR] < OF S" lt"   out ENDOF
     [CHAR] > OF S" gt"   out ENDOF
     [CHAR] " OF S" quot" out ENDOF
     [CHAR] + OF S" plus" out ENDOF
     [CHAR] ! OF S" bang" out ENDOF
     [CHAR] / OF S" slash" out ENDOF
     [CHAR] \ OF S" backslash" out ENDOF
     [CHAR] ' OF S" apos" out ENDOF
     [CHAR] = OF S" equal" out ENDOF
     [CHAR] - OF S" dash" out ENDOF
     [CHAR] @ OF S" at" out ENDOF
     [CHAR] ; OF S" semi" out ENDOF
     [CHAR] * OF S" star" out ENDOF
     [CHAR] ? OF S" question" out ENDOF
     [CHAR] ~ OF S" tilde" out ENDOF
     [CHAR] # OF S" pound" out ENDOF
     [CHAR] , OF S" comma" out ENDOF
     [CHAR] $ OF S" dollar" out ENDOF
     [CHAR] | OF S" bar" out ENDOF
     [CHAR] [ OF S" leftbracket" out ENDOF
     [CHAR] ( OF S" leftparen" out ENDOF
     [CHAR] { OF S" leftbrace" out ENDOF
     [CHAR] ] OF S" rightbracket" out ENDOF
     [CHAR] ) OF S" rightparen" out ENDOF
     [CHAR] } OF S" rightbrace" out ENDOF
     BL       OF S" _"    out ENDOF
     I 1 out   
  ENDCASE LOOP ;

: label ( addr len -- ) /a                      \ associate a label with a word
  misctext 1 line outhattr
  misctext 2 line 1 attrib ! ;

: "out   ( -- )                                 \ output a "
  misctext 9 line ;

: new-line ( -- )                               \ start a new line
   S" " outln ;

: std    ( word color <string> -- )
  CREATE ' , ' , BL WORD COUNT (,$)
  DOES> /a DUP >R  2 CELLS +
  misctext 0 line                              \ begin hyperlink
  BASE @ >R DECIMAL
  COUNT 0 0 2OVER >NUMBER 2DROP D>S
  R> BASE !
  DPANS-PATH COUNT out                         \ write path to ANS files
  CASE                                         \ choose file name
      6 OF S" dpans6.htm#"  out ENDOF
      7 OF S" dpans7.htm#"  out ENDOF
      8 OF S" dpans8.htm#"  out ENDOF
      9 OF S" dpans9.htm#"  out ENDOF
     10 OF S" dpans10.htm#" out ENDOF
     11 OF S" dpans11.htm#" out ENDOF
     12 OF S" dpans12.htm#" out ENDOF
     13 OF S" dpans13.htm#" out ENDOF
     14 OF S" dpans14.htm#" out ENDOF
     15 OF S" dpans15.htm#" out ENDOF
     16 OF S" dpans16.htm#" out ENDOF
     17 OF S" dpans17.htm#" out ENDOF
     ABORT" Undefined source file"
  ENDCASE  out misctext 2 line
  1 attrib !
  R> 2@ SWAP EXECUTE EXECUTE ;                 \ extra attributes

: genHTML ( -- )                                \ generate pending HTML
  PAD COUNT DUP IF setcolor THEN outh closefont 0 PAD ! ;

: genHTML2 ( -- )                                \ generate pending HTML
  PAD COUNT DUP IF setcolor THEN outh closefont 0 PAD ! ;

: isnumber? ( addr len -- f )                   \ string converts to number?
  0 0 2SWAP >NUMBER NIP NIP NIP 0= ;

: hparse ( a len char -- a' len' )
  >R 2DUP R@ SKIP R> SCAN BL SCAN
  2SWAP 2 PICK - PAD +PLACE ;

CREATE XPAD 1024 CHARS ALLOT                    \ temporary pad for word storage
CREATE EPAD 1024 CHARS ALLOT                    \ temporary pad for evaluation

: >XPAD ( -- ) PAD COUNT BL SKIP XPAD PLACE ;   \ move to temporary pad

: hint  ( addr len -- )                         \ interpret one line...
  BEGIN
     0 PAD !  BL hparse PAD C@
  WHILE unknown                                \ default color
     >XPAD XPAD COUNT hyperlinks SEARCH-WORDLIST \ got a hyperlink for this?
     IF DEPTH >R EXECUTE
        R> DEPTH <> ABORT" stack depth change in HTML generator"
     ELSE
        XPAD COUNT BASE @ 10 = IF
           >FLOAT IF FDROP numeric THEN        \ valid float or integer
        ELSE
           isnumber? IF numeric THEN
        THEN
     THEN genHTML
  REPEAT 2DROP
  new-line ;

CREATE inbuf 260 CHARS ALLOT
CREATE fn    128 CHARS ALLOT                    \ file name
CREATE fn1   128 CHARS ALLOT                    \ file name backup
CREATE pstr  128 CHARS ALLOT                    \ parsed string storage
CREATE uname  64 CHARS ALLOT                    \ : definition name
0 VALUE inf
VARIABLE nufile                                 \ T if nesting a file
VARIABLE utype                                  \ type of defined word
VARIABLE hstate
VARIABLE linenum
VARIABLE special                                \ special action, 0=none

: ofn   ( -- addr len )                         \ output file name
  fn COUNT 2DUP [CHAR] . SCAN NIP - EPAD PLACE
  S" .htm" EPAD +PLACE   EPAD COUNT ;

( TODO: fix the pad overrun in defx! )
: hcreate ( addr len -- )
  S" CREATE " EPAD PLACE  EPAD +PLACE
  GET-CURRENT >R hyperlinks SET-CURRENT
  EPAD COUNT EVALUATE R> SET-CURRENT ;      \ create a hyperlink generator

\ The user defined words use the following data structure:
\ CELL   xt of coloring word
\ STRING name of reference word
\ STRING name of file

: deflink ( addr -- )                           \ make hyperlink from data structure
  DUP @ EXECUTE CELL+                          \ set color
  DUP COUNT + COUNT ofn COMPARE                \ in an external file?
  IF   misctext 0 line DUP COUNT + COUNT out   \ yes, put file name
       S" #" out COUNT outh S" >" out
  ELSE misctext 3 line COUNT outhattr          \ no, just use the name
       misctext 4 line
  THEN 1 attrib ! ;

: defx  ( a len xt -- a' len' )
  >R genHTML BL hparse >XPAD                   \ output defining word
  XPAD COUNT 2DUP hcreate R> , (,$) ofn (,$)
  DOES> deflink ;

: labelnow   genHTML2 XPAD COUNT 2DUP label S"  " outh outh ;
: defdat ['] numeric   defx numeric   labelnow ;
: defvar ['] variables defx variables labelnow ;
: defusr ['] userwords defx userwords labelnow ;
: defval ['] values    defx values    labelnow ;
: defdef ['] userdefiner defx userdefiner labelnow ;

: hstate=0 ( -- )             0 hstate ! ;
: hstate=1 ( -- )             1 hstate ! ;
: spec=zero ( -- )            1 special ! ;
: skip)  ( a len -- a' len' ) [CHAR] ) hparse ;
: skip}  ( a len -- a' len' ) [CHAR] } hparse ;
: skipw  ( a len -- a' len' ) BL hparse ;
: skipc  ( a len -- a len )   hstate @ 0= IF numeric skipw THEN ;
: skip"  ( a len -- a' len' )                   \ copy string to pstr
  genHTML [CHAR] " hparse PAD COUNT 1- pstr PLACE ;

\ ------------------------------------------------------------------------------
\ ":" definitions might be defining words, so they can't be assumed to be defusr
\ types. ":" makes a label and saves the name for later use by ";" which makes
\ a hyperlink or a hyperlink defining word.

:NONAME                                         \ normal : definition
  uname COUNT ['] userwords defx 2DROP  0 PAD !
; CONSTANT normal_def

:NONAME
  uname COUNT 2DUP hcreate ['] userwords , (,$) ofn (,$)
  DOES> deflink defdef
; CONSTANT defining_def

: defunk ( a len -- a' len' )                   \ starting unknown definition
  hstate=1  normal_def utype !                 \ save name of : definition
  genHTML skipw userwords PAD COUNT BL SKIP 2DUP uname PLACE label ;

: resunk ( -- )                                 \ resolve unknown defined word
  genHTML utype @ EXECUTE hstate=0 ;

: created ( -- ) hstate @
  IF   defining_def utype !                    \ make ; create a defining word
  ELSE defdat                                  \ not compiling
  THEN ;

\ ------------------------------------------------------------------------------

: header  ( addr len -- )                       \ output big header text
  misctext 6 line
  LINK-TO-ORG-FILE IF
     misctext 0 line 2dup out misctext 2 line
     outln  misctext 10 line
  ELSE out
  THEN misctext 7 line ;

: _incfil ( addr -- )                           \ trigger file nesting
  fn COUNT fn1 PLACE COUNT BL SKIP fn PLACE 1 nufile ! ;

: incfile ( a len -- a' len' )                  \ include a file
  genHTML skipw PAD _incfil ;

: "incfil ( a len -- a' len' )                  \ include file from S" filename"
  skipw pstr _incfil ;

: hfill  ( -- len )                             \ read next line of file
  inbuf 256 inf READ-LINE ABORT" Error reading file"
  1 linenum +! ;

: open  ( -- ) cr ." Reading " fn COUNT TYPE ."  at line " linenum @ .
  1 linenum !
  fn COUNT R/O OPEN-FILE ABORT" Error opening source file" TO inf ;

: close  ( -- ) cr ." closing " fn COUNT TYPE
  inf CLOSE-FILE ABORT" Error closing file" ;

: oopen  ( -- )
  ofn W/O CREATE-FILE ABORT" Error creating file" TO outf
  begin_header boiler                          \ begin boilerplate
  fn COUNT outln  mid_header boiler            \ title and end boilerplate
  fn COUNT header ;

: HTML  ( <infile> -- )
  0 TO screen-only  0 nufile !                 \ force usage of file
  1 linenum ! -1 active-color !
  BL WORD COUNT fn PLACE open oopen            \ open input and output files
  -1 DUP >R outf >R                            \ file nest uses stacks
  hstate=0
  BEGIN
     BEGIN 0 special !                         \ process line
        nufile @                               \ nest a file?
        IF   inf outf
             open oopen  outf >R               \ open new files
             0 nufile !
        THEN hfill
     WHILE inbuf SWAP hint
     REPEAT DROP
     close fn1 COUNT fn PLACE                  \ restore file name
     DUP -1 <>
     IF   TO outf TO inf FALSE                 \ unnest files
     ELSE TRUE
     THEN
  UNTIL DROP
  BEGIN R> DUP -1 <>                           \ close all output files
  WHILE end_header boiler                      \ finish up HTML
     CLOSE-FILE ABORT" Error closing file"
  REPEAT DROP ;

: q  ( -- ) 1 TO screen-only                    \ single line test
  -1 WORD COUNT inbuf PLACE inbuf COUNT hint ;

\ 0 [IF] is often used as a comment. If it is used as a comment, scan the file
\ for a [THEN]. [THEN] must be on the next line or beyond.

: upp ( an--) BOUNDS ?DO I C@ [CHAR] a > IF I C@ 32 - I C! THEN LOOP \ uppercase
;

: bigif  ( a len -- a len )  special @ 1 =
  IF    genHTML commentary setcolor outh \ closefont  \ finish up this line
     BEGIN hfill      new-line
     WHILE >R inbuf EPAD R@ MOVE
        EPAD R@ upp                            \ uppercase for search
        EPAD R@ S" [THEN]" SEARCH
        IF   DROP EPAD - inbuf OVER PAD PLACE  \ before [THEN] is comment
             genHTML
             inbuf R> ROT /STRING EXIT
        ELSE 2DROP inbuf R> outh               \ whole line is comment
        THEN
     REPEAT DROP -1 ABORT" Missing [THEN]"
  THEN ;

: _local  ( a len -- a len )                    \ define locals to |
  genHTML
  S" MARKER L#O#C#A#L" EVALUATE                \ start a list of locals
  BEGIN
     BEGIN 2DUP BL hparse 2DROP
           PAD COUNT BL SKIP  DUP              \ inputstring wordstring .
     WHILE S" |" COMPARE  0 PAD !
        IF   defval
        ELSE local_ws EXIT
        THEN
     REPEAT 2DROP 2DROP
     hfill 0= ABORT" Missing | in locals list"
     inbuf SWAP  S"  " outln
  AGAIN ;

\ handle multi-line comments
\ (( )) and comment: comment; are often used as multi-line comments in win32forth.
\ )) or comment; must be on the next line or beyond.
variable mlc-stop

: (mlc) ( a -- )
     mlc-stop !
     commentary setcolor genHTML outh       \ finish up this line
     BEGIN hfill    new-line
     WHILE >R inbuf EPAD R@ MOVE
        EPAD R@ upp                            \ uppercase for search
        EPAD R@ mlc-stop @ count SEARCH
        IF   DROP mlc-stop @ count nip + EPAD - inbuf OVER PAD PLACE  \ before )) and )) is comment
             genHTML
             inbuf R> ROT /STRING EXIT
        ELSE 2DROP inbuf R> outh               \ whole line is comment
        THEN
     REPEAT DROP ." Missing " mlc-stop @ count type ABORT
;

: mlc ( <string> -- ) \ handle a multi line comment
  CREATE BL WORD COUNT (,$)
  DOES>  (mlc) ;

\ =============================================================================

: _DEFINITIONS DEFINITIONS ;

hyperlinks SET-CURRENT
\ The following words are not in the ANS standard but are very common.
: VOCABULARY    defusr ;
: DEFER         defusr ;
: INCLUDE       hstate @ 0= IF incfile THEN ;
: FLOAD         hstate @ 0= IF incfile THEN ;
: BINARY        2 BASE ! ;
: OCTAL         8 BASE ! ;
: 0             numeric spec=zero ;
: 1             numeric  ;
: -1            numeric  ;

\ The following words are not in the ANS standard but are used in Win32Forth
: ANEW          skipw ;
: {             commentary genHTML skip} ;
: CallBack:     defunk ;
: :M            defunk ;
: ;M            resunk ;
mlc ((          ))
mlc COMMENT:    COMMENT;
: L#O#C#A#L ;

\ The rest is ANS Forth standard

: \             commentary genHTML PAD PLACE  PAD 0 ;

(   NAME                ACTION  COLOR           REFERENCE   )
(   ------------------  ------  --------------  ----------- )
std !                   NOOP    core_ws         6.1.0010
std #                   NOOP    core_ws         6.1.0030
std #>                  NOOP    core_ws         6.1.0040
std #S                  NOOP    core_ws         6.1.0050
std '                   NOOP    core_ws         6.1.0070
std (                   skip)   commentary      6.1.0080
std *                   NOOP    core_ws         6.1.0090
std */                  NOOP    core_ws         6.1.0100
std */MOD               NOOP    core_ws         6.1.0110
std +                   NOOP    core_ws         6.1.0120
std +!                  NOOP    core_ws         6.1.0130
std +LOOP               NOOP    core_ws         6.1.0140
std ,                   NOOP    core_ws         6.1.0150
std -                   NOOP    core_ws         6.1.0160
std .                   NOOP    core_ws         6.1.0180
std ."                  skip"   numeric         6.1.0190
std /                   NOOP    core_ws         6.1.0230
std /MOD                NOOP    core_ws         6.1.0240
std 0<                  NOOP    core_ws         6.1.0250
std 0=                  NOOP    core_ws         6.1.0270
std 1+                  NOOP    core_ws         6.1.0290
std 1-                  NOOP    core_ws         6.1.0300
std 2!                  NOOP    core_ws         6.1.0310
std 2*                  NOOP    core_ws         6.1.0320
std 2/                  NOOP    core_ws         6.1.0330
std 2@                  NOOP    core_ws         6.1.0350
std 2DROP               NOOP    core_ws         6.1.0370
std 2DUP                NOOP    core_ws         6.1.0380
std 2OVER               NOOP    core_ws         6.1.0400
std 2SWAP               NOOP    core_ws         6.1.0430
std :                   defunk  core_ws         6.1.0450
std ;                   resunk  core_ws         6.1.0460
std <                   NOOP    core_ws         6.1.0480
std <#                  NOOP    core_ws         6.1.0490
std =                   NOOP    core_ws         6.1.0530
std >                   NOOP    core_ws         6.1.0540
std >BODY               NOOP    core_ws         6.1.0550
std >IN                 NOOP    core_ws         6.1.0560
std >NUMBER             NOOP    core_ws         6.1.0570
std >R                  NOOP    core_ws         6.1.0580
std ?DUP                NOOP    core_ws         6.1.0630
std @                   NOOP    core_ws         6.1.0650
std ABORT               NOOP    core_ws         6.1.0670
std ABORT"              skip"   numeric         6.1.0680
std ABS                 NOOP    core_ws         6.1.0690
std ACCEPT              NOOP    core_ws         6.1.0695
std ALIGN               NOOP    core_ws         6.1.0705
std ALIGNED             NOOP    core_ws         6.1.0706
std ALLOT               NOOP    core_ws         6.1.0710
std AND                 NOOP    core_ws         6.1.0720
std BASE                NOOP    core_ws         6.1.0750
std BEGIN               NOOP    core_ws         6.1.0760
std BL                  NOOP    numeric         6.1.0770
std C!                  NOOP    core_ws         6.1.0850
std C,                  NOOP    core_ws         6.1.0860
std C@                  NOOP    core_ws         6.1.0870
std CELL+               NOOP    core_ws         6.1.0880
std CELLS               NOOP    core_ws         6.1.0890
std CHAR                skipc   core_ws         6.1.0895
std CHAR+               NOOP    core_ws         6.1.0897
std CHARS               NOOP    core_ws         6.1.0898
std CONSTANT            defdat  core_ws         6.1.0950
std COUNT               NOOP    core_ws         6.1.0980
std CR                  NOOP    core_ws         6.1.0990
std CREATE              created core_ws         6.1.1000
std DECIMAL             DECIMAL core_ws         6.1.1170
std DEPTH               NOOP    core_ws         6.1.1200
std DO                  NOOP    core_ws         6.1.1240
std DOES>               NOOP    core_ws         6.1.1250
std DROP                NOOP    core_ws         6.1.1260
std DUP                 NOOP    core_ws         6.1.1290
std ELSE                NOOP    core_ws         6.1.1310
std EMIT                NOOP    core_ws         6.1.1320
std ENVIRONMENT?        NOOP    core_ws         6.1.1345
std EVALUATE            NOOP    core_ws         6.1.1360
std EXECUTE             NOOP    core_ws         6.1.1370
std EXIT                NOOP    core_ws         6.1.1380
std FILL                NOOP    core_ws         6.1.1540
std FIND                NOOP    core_ws         6.1.1550
std FM/MOD              NOOP    core_ws         6.1.1561
std HERE                NOOP    core_ws         6.1.1650
std HOLD                NOOP    core_ws         6.1.1670
std I                   NOOP    core_ws         6.1.1680
std IF                  NOOP    core_ws         6.1.1700
std IMMEDIATE           NOOP    core_ws         6.1.1710
std INVERT              NOOP    core_ws         6.1.1720
std J                   NOOP    core_ws         6.1.1730
std KEY                 NOOP    core_ws         6.1.1750
std LEAVE               NOOP    core_ws         6.1.1760
std LITERAL             NOOP    core_ws         6.1.1780
std LOOP                NOOP    core_ws         6.1.1800
std LSHIFT              NOOP    core_ws         6.1.1805
std M*                  NOOP    core_ws         6.1.1810
std MAX                 NOOP    core_ws         6.1.1870
std MIN                 NOOP    core_ws         6.1.1880
std MOD                 NOOP    core_ws         6.1.1890
std MOVE                NOOP    core_ws         6.1.1900
std NEGATE              NOOP    core_ws         6.1.1910
std OR                  NOOP    core_ws         6.1.1980
std OVER                NOOP    core_ws         6.1.1990
std POSTPONE            NOOP    core_ws         6.1.2033
std QUIT                NOOP    core_ws         6.1.2050
std R>                  NOOP    core_ws         6.1.2060
std R@                  NOOP    core_ws         6.1.2070
std RECURSE             NOOP    core_ws         6.1.2120
std REPEAT              NOOP    core_ws         6.1.2140
std ROT                 NOOP    core_ws         6.1.2160
std RSHIFT              NOOP    core_ws         6.1.2162
std S"                  skip"   numeric         6.1.2165
std S>D                 NOOP    core_ws         6.1.2170
std SIGN                NOOP    core_ws         6.1.2210
std SM/REM              NOOP    core_ws         6.1.2214
std SOURCE              NOOP    core_ws         6.1.2216
std SPACE               NOOP    core_ws         6.1.2220
std SPACES              NOOP    core_ws         6.1.2230
std STATE               NOOP    core_ws         6.1.2250
std SWAP                NOOP    core_ws         6.1.2260
std THEN                NOOP    core_ws         6.1.2270
std TYPE                NOOP    core_ws         6.1.2310
std U.                  NOOP    core_ws         6.1.2320
std U<                  NOOP    core_ws         6.1.2340
std UM*                 NOOP    core_ws         6.1.2360
std UM/MOD              NOOP    core_ws         6.1.2370
std UNLOOP              NOOP    core_ws         6.1.2380
std UNTIL               NOOP    core_ws         6.1.2390
std VARIABLE            defvar  core_ws         6.1.2410
std WHILE               NOOP    core_ws         6.1.2430
std WORD                NOOP    core_ws         6.1.2450
std XOR                 NOOP    core_ws         6.1.2490
std [                  hstate=0 core_ws         6.1.2500
std [']                 skipw   numeric         6.1.2510
std [CHAR]              skipw   numeric         6.1.2520
std ]                  hstate=1 core_ws         6.1.2540
std #TIB                NOOP    core_ext_ws     6.2.0060
std .(                  skip)   commentary      6.2.0200
std .R                  NOOP    core_ext_ws     6.2.0210
std 0<>                 NOOP    core_ext_ws     6.2.0260
std 0>                  NOOP    core_ext_ws     6.2.0280
std 2>R                 NOOP    core_ext_ws     6.2.0340
std 2R>                 NOOP    core_ext_ws     6.2.0410
std 2R@                 NOOP    core_ext_ws     6.2.0415
std :NONAME             NOOP    core_ext_ws     6.2.0455
std <>                  NOOP    core_ext_ws     6.2.0500
std ?DO                 NOOP    core_ext_ws     6.2.0620
std AGAIN               NOOP    core_ext_ws     6.2.0700
std C"                  skip"   numeric         6.2.0855
std CASE                NOOP    core_ext_ws     6.2.0873
std COMPILE,            NOOP    core_ext_ws     6.2.0945
std CONVERT             NOOP    core_ext_ws     6.2.0970
std ENDCASE             NOOP    core_ext_ws     6.2.1342
std ENDOF               NOOP    core_ext_ws     6.2.1343
std ERASE               NOOP    core_ext_ws     6.2.1350
std EXPECT              NOOP    core_ext_ws     6.2.1390
std FALSE             spec=zero numeric         6.2.1485
std HEX                 HEX     core_ext_ws     6.2.1660
std MARKER              defusr  core_ext_ws     6.2.1850
std NIP                 NOOP    core_ext_ws     6.2.1930
std OF                  NOOP    core_ext_ws     6.2.1950
std PAD                 NOOP    core_ext_ws     6.2.2000
std PARSE               NOOP    core_ext_ws     6.2.2008
std PICK                NOOP    core_ext_ws     6.2.2030
std QUERY               NOOP    core_ext_ws     6.2.2040
std REFILL              NOOP    core_ext_ws     6.2.2125
std RESTORE-INPUT       NOOP    core_ext_ws     6.2.2148
std ROLL                NOOP    core_ext_ws     6.2.2150
std SAVE-INPUT          NOOP    core_ext_ws     6.2.2182
std SOURCE-ID           NOOP    core_ext_ws     6.2.2218
std SPAN                NOOP    core_ext_ws     6.2.2240
std TIB                 NOOP    core_ext_ws     6.2.2290
std TO                  NOOP    core_ext_ws     6.2.2295
std TRUE                NOOP    numeric         6.2.2298
std TUCK                NOOP    core_ext_ws     6.2.2300
std U.R                 NOOP    core_ext_ws     6.2.2330
std U>                  NOOP    core_ext_ws     6.2.2350
std UNUSED              NOOP    core_ext_ws     6.2.2395
std VALUE               defval  core_ext_ws     6.2.2405
std WITHIN              NOOP    core_ext_ws     6.2.2440
std [COMPILE]           NOOP    core_ext_ws     6.2.2530
std BLK                 NOOP    block_ws        7.6.1.0790
std BLOCK               NOOP    block_ws        7.6.1.0800
std BUFFER              NOOP    block_ws        7.6.1.0820
std FLUSH               NOOP    block_ws        7.6.1.1559
std LOAD                NOOP    block_ws        7.6.1.1790
std SAVE-BUFFERS        NOOP    block_ws        7.6.1.2180
std UPDATE              NOOP    block_ws        7.6.1.2400
std EMPTY-BUFFERS       NOOP    block_ws        7.6.2.1330
std LIST                NOOP    block_ws        7.6.2.1770
std SCR                 NOOP    block_ws        7.6.2.2190
std THRU                NOOP    block_ws        7.6.2.2280
std 2CONSTANT           defdat  double_ws       8.6.1.0360
std 2LITERAL            NOOP    double_ws       8.6.1.0390
std 2VARIABLE           defvar  double_ws       8.6.1.0440
std D+                  NOOP    double_ws       8.6.1.1040
std D-                  NOOP    double_ws       8.6.1.1050
std D.                  NOOP    double_ws       8.6.1.1060
std D.R                 NOOP    double_ws       8.6.1.1070
std D0<                 NOOP    double_ws       8.6.1.1075
std D0=                 NOOP    double_ws       8.6.1.1080
std D2*                 NOOP    double_ws       8.6.1.1090
std D2/                 NOOP    double_ws       8.6.1.1100
std D<                  NOOP    double_ws       8.6.1.1110
std D=                  NOOP    double_ws       8.6.1.1120
std D>S                 NOOP    double_ws       8.6.1.1140
std DABS                NOOP    double_ws       8.6.1.1160
std DMAX                NOOP    double_ws       8.6.1.1210
std DMIN                NOOP    double_ws       8.6.1.1220
std DNEGATE             NOOP    double_ws       8.6.1.1230
std M*/                 NOOP    double_ws       8.6.1.1820
std M+                  NOOP    double_ws       8.6.1.1830
std 2ROT                NOOP    double_ws       8.6.2.0420
std DU<                 NOOP    double_ws       8.6.2.1270
std CATCH               NOOP    exception_ws    9.6.1.0875
std THROW               NOOP    exception_ws    9.6.1.2275
std AT-XY               NOOP    facilities_ws   10.6.1.0742
std KEY?                NOOP    facilities_ws   10.6.1.1755
std PAGE                NOOP    facilities_ws   10.6.1.2005
std EKEY                NOOP    facilities_ws   10.6.2.1305
std EKEY<CHAR           NOOP    facilities_ws   10.6.2.1306
std EKEY?               NOOP    facilities_ws   10.6.2.1307
std EMIT?               NOOP    facilities_ws   10.6.2.1325
std MS                  NOOP    facilities_ws   10.6.2.1905
std TIME&DATE           NOOP    facilities_ws   10.6.2.2292
std BIN                 NOOP    file_ws         11.6.1.0765
std CLOSE-FILE          NOOP    file_ws         11.6.1.0900
std CREATE-FILE         NOOP    file_ws         11.6.1.1010
std DELETE-FILE         NOOP    file_ws         11.6.1.1190
std FILE-POSITION       NOOP    file_ws         11.6.1.1520
std FILE-SIZE           NOOP    file_ws         11.6.1.1522
std INCLUDE-FILE        NOOP    file_ws         11.6.1.1717
std INCLUDED            "incfil file_ws         11.6.1.1718
std OPEN-FILE           NOOP    file_ws         11.6.1.1970
std R/O                 NOOP    file_ws         11.6.1.2054
std R/W                 NOOP    file_ws         11.6.1.2056
std READ-FILE           NOOP    file_ws         11.6.1.2080
std READ-LINE           NOOP    file_ws         11.6.1.2090
std REPOSITION-FILE     NOOP    file_ws         11.6.1.2142
std RESIZE-FILE         NOOP    file_ws         11.6.1.2147
std W/O                 NOOP    file_ws         11.6.1.2425
std WRITE-FILE          NOOP    file_ws         11.6.1.2480
std WRITE-LINE          NOOP    file_ws         11.6.1.2485
std FILE-STATUS         NOOP    file_ws         11.6.2.1524
std FLUSH-FILE          NOOP    file_ws         11.6.2.1560
std RENAME-FILE         NOOP    file_ws         11.6.2.2130
std >FLOAT              NOOP    fp_ws           12.6.1.0558
std D>F                 NOOP    fp_ws           12.6.1.1130
std F!                  NOOP    fp_ws           12.6.1.1400
std F*                  NOOP    fp_ws           12.6.1.1410
std F+                  NOOP    fp_ws           12.6.1.1420
std F-                  NOOP    fp_ws           12.6.1.1425
std F/                  NOOP    fp_ws           12.6.1.1430
std F0<                 NOOP    fp_ws           12.6.1.1440
std F0=                 NOOP    fp_ws           12.6.1.1450
std F<                  NOOP    fp_ws           12.6.1.1460
std F>D                 NOOP    fp_ws           12.6.1.1460
std F@                  NOOP    fp_ws           12.6.1.1472
std FALIGN              NOOP    fp_ws           12.6.1.1479
std FALIGNED            NOOP    fp_ws           12.6.1.1483
std FCONSTANT           defdat  fp_ws           12.6.1.1492
std FDEPTH              NOOP    fp_ws           12.6.1.1497
std FDROP               NOOP    fp_ws           12.6.1.1500
std FDUP                NOOP    fp_ws           12.6.1.1510
std FLITERAL            NOOP    fp_ws           12.6.1.1552
std FLOAT+              NOOP    fp_ws           12.6.1.1555
std FLOATS              NOOP    fp_ws           12.6.1.1556
std FLOOR               NOOP    fp_ws           12.6.1.1558
std FMAX                NOOP    fp_ws           12.6.1.1562
std FMIN                NOOP    fp_ws           12.6.1.1565
std FNEGATE             NOOP    fp_ws           12.6.1.1567
std FOVER               NOOP    fp_ws           12.6.1.1600
std FROT                NOOP    fp_ws           12.6.1.1610
std FROUND              NOOP    fp_ws           12.6.1.1612
std FSWAP               NOOP    fp_ws           12.6.1.1620
std FVARIABLE           defvar  fp_ws           12.6.1.1630
std REPRESENT           NOOP    fp_ws           12.6.1.2143
std DF!                 NOOP    fp_ws           12.6.2.1203
std DF@                 NOOP    fp_ws           12.6.2.1204
std DFALIGN             NOOP    fp_ws           12.6.2.1205
std DFALIGNED           NOOP    fp_ws           12.6.2.1207
std DFLOAT+             NOOP    fp_ws           12.6.2.1208
std DFLOATS             NOOP    fp_ws           12.6.2.1209
std F**                 NOOP    fp_ws           12.6.2.1415
std F.                  NOOP    fp_ws           12.6.2.1427
std FABS                NOOP    fp_ws           12.6.2.1474
std FACOS               NOOP    fp_ws           12.6.2.1476
std FACOSH              NOOP    fp_ws           12.6.2.1477
std FALOG               NOOP    fp_ws           12.6.2.1484
std FASIN               NOOP    fp_ws           12.6.2.1486
std FASINH              NOOP    fp_ws           12.6.2.1487
std FATAN               NOOP    fp_ws           12.6.2.1488
std FATAN2              NOOP    fp_ws           12.6.2.1489
std FATANH              NOOP    fp_ws           12.6.2.1491
std FCOS                NOOP    fp_ws           12.6.2.1493
std FCOSH               NOOP    fp_ws           12.6.2.1494
std FE.                 NOOP    fp_ws           12.6.2.1513
std FEXP                NOOP    fp_ws           12.6.2.1515
std FEXPM1              NOOP    fp_ws           12.6.2.1516
std FLN                 NOOP    fp_ws           12.6.2.1553
std FLNP1               NOOP    fp_ws           12.6.2.1554
std FLOG                NOOP    fp_ws           12.6.2.1557
std FS.                 NOOP    fp_ws           12.6.2.1613
std FSIN                NOOP    fp_ws           12.6.2.1614
std FSINCOS             NOOP    fp_ws           12.6.2.1616
std FSINH               NOOP    fp_ws           12.6.2.1617
std FSQRT               NOOP    fp_ws           12.6.2.1618
std FTAN                NOOP    fp_ws           12.6.2.1625
std FTANH               NOOP    fp_ws           12.6.2.1626
std F~                  NOOP    fp_ws           12.6.2.1640
std PRECISION           NOOP    fp_ws           12.6.2.2035
std SET-PRECISION       NOOP    fp_ws           12.6.2.2200
std SF!                 NOOP    fp_ws           12.6.2.2202
std SF@                 NOOP    fp_ws           12.6.2.2203
std SFALIGN             NOOP    fp_ws           12.6.2.2204
std SFALIGNED           NOOP    fp_ws           12.6.2.2206
std SFLOAT+             NOOP    fp_ws           12.6.2.2207
std SFLOATS             NOOP    fp_ws           12.6.2.2208
std (LOCAL)             NOOP    local_ws        13.6.1.0086
std LOCALS|             _local  local_ws        13.6.2.1795
std ALLOCATE            NOOP    malloc_ws       14.6.1.0707
std FREE                NOOP    malloc_ws       14.6.1.1605
std RESIZE              NOOP    malloc_ws       14.6.1.2145
std .S                  NOOP    progtools_ws    15.6.1.0220
std ?                   NOOP    progtools_ws    15.6.1.0600
std DUMP                NOOP    progtools_ws    15.6.1.1280
std SEE                 NOOP    progtools_ws    15.6.1.2194
std WORDS               NOOP    progtools_ws    15.6.1.2465
std ;CODE               resunk  progtools_ws    15.6.2.0470
std AHEAD               NOOP    progtools_ws    15.6.2.0702
std ASSEMBLER           NOOP    progtools_ws    15.6.2.0740
std BYE                 NOOP    progtools_ws    15.6.2.0830
std CODE                defusr  progtools_ws    15.6.2.0930
std CS-PICK             NOOP    progtools_ws    15.6.2.1015
std CS-ROLL             NOOP    progtools_ws    15.6.2.1020
std EDITOR              NOOP    progtools_ws    15.6.2.1300
std FORGET              NOOP    progtools_ws    15.6.2.1580
std [ELSE]              NOOP    progtools_ws    15.6.2.2531
std [IF]                bigif   progtools_ws    15.6.2.2532
std [THEN]              NOOP    progtools_ws    15.6.2.2533
std DEFINITIONS         NOOP    searchord_ws    16.6.1.1180
std FORTH-WORDLIST      NOOP    searchord_ws    16.6.1.1595
std GET-CURRENT         NOOP    searchord_ws    16.6.1.1643
std GET-ORDER           NOOP    searchord_ws    16.6.1.1647
std SEARCH-WORDLIST     NOOP    searchord_ws    16.6.1.2192
std SET-CURRENT         NOOP    searchord_ws    16.6.1.2195
std SET-ORDER           NOOP    searchord_ws    16.6.1.2197
std WORDLIST            NOOP    searchord_ws    16.6.1.2460
std ALSO                NOOP    searchord_ws    16.6.2.0715
std FORTH               NOOP    searchord_ws    16.6.2.1590
std ONLY                NOOP    searchord_ws    16.6.2.1965
std ORDER               NOOP    searchord_ws    16.6.2.1985
std PREVIOUS            NOOP    searchord_ws    16.6.2.2037
std -TRAILING           NOOP    string_ws       17.6.1.0170
std /STRING             NOOP    string_ws       17.6.1.0245
std BLANK               NOOP    string_ws       17.6.1.0780
std CMOVE               NOOP    string_ws       17.6.1.0910
std CMOVE>              NOOP    string_ws       17.6.1.0920
std COMPARE             NOOP    string_ws       17.6.1.0935
std SEARCH              NOOP    string_ws       17.6.1.2191
std SLITERAL            NOOP    string_ws       17.6.1.2212

_DEFINITIONS

\ Revision history
\ 0. 1st release to guinea pigs via comp.lang.forth
\ 1. Added multi-line comment 0 [IF]. Colored CHAR outside definitions.
\ 2. (EJB) Added missing definitions for common but nonstandard words
\    and cleaned up to account for case sensitivity.
\ 3. (EJB) Fixed up to create conforming XHTML 1.0 Strict
\ 2a. Added support for LOCALS|. Changed to use blanks for whitespace.
\ 3b. December 30th to January 1st, 2004 - Dirk Busch (dbu)
\    - Added DPANS-PATH to configure the path to the dpans-files
\    - Added multi-line comments (( )) and comment: comment; as used in Win32Forth
\    - HTML crashed on files with long lines (more than 80 char's) - fixed
\    - Added some more words for better Win32Forth support
\    - renamed COL to FCOL since COL is used in Win32Forth
\    - renamed ,$ to (,$)  since ,$ is used in Win32Forth
\    - renamed HEADER to HEADER_OUT since HEADER is used in Win32Forth
\    - changed FONTCOLOR to set the new color only if it's not the actual color
\    - Added LINK-TO-ORG-FILE to configure the output of a hyperlink to the original File