Menu
▾
▴
[Win32forth-cvs] win32forth/doc/OldDexh DexH-CreateDocs.f, NONE, 1.1 DexH-Glossary.f, NONE, 1.1 DexH.f, NONE, 1.1 W32fdexh.f, NONE, 1.1
|
From: CamilleForth <cam...@us...> - 2008-12-22 22:58:47
|
Update of /cvsroot/win32forth/win32forth/doc/OldDexh In directory 23jxhf1.ch3.sourceforge.com:/tmp/cvs-serv10481 Added Files: DexH-CreateDocs.f DexH-Glossary.f DexH.f W32fdexh.f Log Message: re-added old dexh in doc directory cdo 23 dec 2008 --- NEW FILE: DexH-Glossary.f --- \ DexH-Glossary.f \ Creating a glossary for Win32Forth. create OutputFile$ ," doc\w32f-glossary.csv" \ **************************************************************************** \ write output file \ **************************************************************************** [UNDEFINED] OutputFileHandle [if] 0 value OutputFileHandle \ *G The handle of the output file for the glossary. [then] : output-close ( -- ) \ *G Close the output file for the glossary. OutputFileHandle ?dup if close-file drop 0 to OutputFileHandle then ; : OutputFile ( -- addr len ) \ *G Get name of output file for the glossary (including path). OutputFile$ count Prepend<home>\ ; : output-open ( -- f ) \ *G Open the output file for the glossary. \ ** If the file already exist the append mode for the file is set. output-close OutputFile r/w open-file swap to OutputFileHandle 0= if OutputFileHandle file-append 0= else OutputFile r/w create-file swap to OutputFileHandle 0= then ; : output-delete ( -- ) \ *G Delete the output file for the glossary. OutputFile delete-file drop ; : output-write ( addr len -- ) \ *G Write a string to the output-file. OutputFileHandle write-file drop ; : output-char ( char -- ) \ *G Write a char to the output-file. here c! here 1 output-write ; : (output-string) ( addr count -- ) \ *G Write a string to the output-file. \ ** A " char will be written as "" into the file. bounds ?do i c@ dup [char] " = if dup output-char then output-char loop ; : output-string ( addr count -- ) \ *G Write a string to the output-file. \ ** The string will be quoated with " . [char] " output-char (output-string) [char] " output-char ; : output-sep ( -- ) \ *G Write seperator to the output-file. [char] , output-char ; : output-cr ( -- ) \ *G Write CR to the output-file. 13 output-char 10 output-char ; : output-header ( -- ) \ *G Write the header line to the output-file. s" Name" output-string output-sep s" Stack" output-string output-sep s" Comment" output-string output-sep s" Type" output-string output-sep s" Class" output-string output-sep s" File" output-string output-cr ; : output-new ( -- ) \ *G Create a new empty glossary file. output-delete output-open if output-header output-close then ; \ **************************************************************************** \ parse input file \ **************************************************************************** -1 constant #invalid-definition-type #invalid-definition-type value definition-type : allot-erase ( n -- ) here over allot swap erase ; create $definition-name 1024 allot-erase create $definition-type 1024 allot-erase create $stack-comment 1024 allot-erase create $comment 1024 allot-erase create $class-name 1024 allot-erase false value InClass? : IsClass? ( -- f ) definition-type 8 = \ :class ? definition-type 9 = \ :object ? definition-type 14 = \ |class ? or or ; : IsCloseingClass? ( -- f ) definition-type 10 = \ ;class ? definition-type 11 = \ ;object ? or ; : set-class-name ( -- ) IsClass? if $definition-name lcount $class-name lplace else IsCloseingClass? if 0 $class-name ! then then ; : +word ( a1 n1 -- a2 n2 a3 n3 ) bl skip 2dup bl scan 2dup 2>r nip - 2r> 2swap ; : set-definition-type ( addr len n -- ) to definition-type 2drop ; : is-definition-type ( a1 n1 -- ) 2dup s" :" COMPARE 0= if 0 set-definition-type exit then 2dup s" CODE" COMPARE 0= if 1 set-definition-type exit then 2dup s" CONSTANT" COMPARE 0= if 2 set-definition-type exit then 2dup s" DEFER" COMPARE 0= if 3 set-definition-type exit then 2dup s" CREATE" COMPARE 0= if 4 set-definition-type exit then 2dup s" VARIABLE" COMPARE 0= if 5 set-definition-type exit then 2dup s" VALUE" COMPARE 0= if 6 set-definition-type exit then 2dup s" :M" COMPARE 0= if 7 set-definition-type exit then 2dup s" :CLASS" COMPARE 0= if 8 set-definition-type true to InClass? exit then 2dup s" :OBJECT" COMPARE 0= if 9 set-definition-type true to InClass? exit then 2dup s" ;CLASS" COMPARE 0= if 10 set-definition-type false to InClass? exit then 2dup s" ;OBJECT" COMPARE 0= if 11 set-definition-type false to InClass? exit then 2dup s" FVARIABLE" COMPARE 0= if 12 set-definition-type exit then 2dup s" 2VARIABLE" COMPARE 0= if 13 set-definition-type exit then 2dup s" |CLASS" COMPARE 0= if 14 set-definition-type true to InClass? exit then 2dup s" :NONAME" COMPARE 0= if 15 set-definition-type exit then 2dup s" |:" COMPARE 0= if 16 set-definition-type exit then 2dup s" FCONSTANT" COMPARE 0= if 17 set-definition-type exit then 2dup s" 2CONSTANT" COMPARE 0= if 18 set-definition-type exit then 2dup s" BYTES" COMPARE 0= if 19 set-definition-type exit then 2dup s" BYTE" COMPARE 0= if 20 set-definition-type exit then 2dup s" BITS" COMPARE 0= if 21 set-definition-type exit then 2dup s" SHORT" COMPARE 0= if 22 set-definition-type exit then 2dup s" INT" COMPARE 0= if 23 set-definition-type exit then 2dup s" DINT" COMPARE 0= if 24 set-definition-type exit then 2dup s" USER" COMPARE 0= if 25 set-definition-type exit then 2dup s" NEWUSER" COMPARE 0= if 26 set-definition-type exit then 2dup s" CFA-CODE" COMPARE 0= if 27 set-definition-type exit then 2dup s" CFA-FUNC" COMPARE 0= if 28 set-definition-type exit then 2dup s" HEADER" COMPARE 0= if 29 set-definition-type exit then 2dup s" ALIAS" COMPARE 0= if 30 set-definition-type exit then 2dup s" SYNONYM" COMPARE 0= if 31 set-definition-type exit then 2dup s" EQU" COMPARE 0= if 32 set-definition-type exit then \ 2dup s" AS" COMPARE 0= if 33 set-definition-type exit then 2dup s" MACRO" COMPARE 0= if 34 set-definition-type exit then 2dup s" #DEFINE" COMPARE 0= if 35 set-definition-type exit then 2dup s" RECORD:" COMPARE 0= if 36 set-definition-type exit then 2dup s" ;RECORDSIZE:" COMPARE 0= if 37 set-definition-type exit then 2dup s" MACRO:" COMPARE 0= if 38 set-definition-type exit then 2dup s" SUBR:" COMPARE 0= if 39 set-definition-type exit then \ 2dup s" PROC" COMPARE 0= if 40 set-definition-type exit then 2dup s" EXTERN" COMPARE 0= if 41 set-definition-type exit then 2dup s" WINLIBRARY" COMPARE 0= if 42 set-definition-type exit then 2drop ; : get-definition-type ( addr len -- ) \ Get the type of the definition. \ Note: The string will be in uppercase letters after this. #invalid-definition-type to definition-type \ default: unkonwen 2dup upper +word -trailing is-definition-type definition-type #invalid-definition-type = if +word -trailing is-definition-type 2drop else 2drop then ; create buf1$ 1024 allot create buf2$ 1024 allot : parse-stack-comment ( a1 n1 c1 c2 -- a2 n2 f ) { c1 c2 -- } 0 $stack-comment ! 2dup c1 scan ?dup \ a1 n1 a2 n2 f if \ stack comment found 2nip 2dup c2 scan 2dup 2>r nip - ?dup \ a2 n2 a3 n3 if c1 skip bl skip -trailing $stack-comment lplace else drop then 2r> 1 /string else drop then $stack-comment lcount nip ; : parse-line ( addr len -- f ) \ Parse one line of the input file, and write \ the name the stack comment, and to comment into the output file. \ the name and definition type +word buf1$ lplace +word buf2$ lplace buf1$ lcount $definition-type lplace $definition-type lcount get-definition-type definition-type #invalid-definition-type = if buf2$ lcount $definition-type lplace $definition-type lcount get-definition-type definition-type #invalid-definition-type = if 2drop false exit \ exit on error else \ the name comes after the definition type (e.g. FCONSTANT) +word $definition-name lplace then else buf2$ lcount $definition-name lplace then \ stack comment [char] ( [char] ) parse-stack-comment 0= if [char] { [char] } parse-stack-comment drop then \ comment [char] \ scan ?dup if [char] \ skip bl skip -trailing $comment lplace else drop 0 $comment ! then \ write the strings into the output file $definition-name lcount output-string output-sep $stack-comment lcount output-string output-sep $comment lcount output-string output-sep true ; : print-class-name ( -- ) \ Write the name of the current class into the output file. InClass? IsClass? 0= and if $class-name lcount else s" " then output-string ; : print-definition-type ( -- ) \ Write the definition type into the output file. definition-type case 0 of s" COLON" endof 15 of s" COLON hidden" endof \ :noname 16 of s" COLON hidden" endof \ |: 1 of s" CODE" endof 2 of s" CONSTANT" endof 17 of s" FCONSTANT" endof 18 of s" 2CONSTANT" endof 3 of s" DEFER" endof 4 of s" CREATE" endof 5 of s" VARIABLE" endof 12 of s" FVARIABLE" endof 13 of s" 2VARIABLE" endof 6 of s" VALUE" endof 14 of s" |CLASS" endof 8 of s" CLASS" endof 9 of s" OBJECT" endof 10 of s" ;CLASS" endof 11 of s" ;OBJECT" endof 7 of s" METHOD" endof \ :m 19 of s" BYTES ivar" endof 20 of s" BYTE ivar" endof 21 of s" BITS ivar" endof 22 of s" SHORT ivar" endof 23 of s" INT ivar" endof 24 of s" DINT ivar" endof 25 of s" USER" endof 26 of s" NEWUSER" endof 27 of s" CFA-CODE" endof 28 of s" CFA-FUNC" endof 29 of s" HEADER" endof 30 of s" ALIAS" endof 31 of s" SYNONYM" endof 32 of s" EQU" endof 33 of s" AS" endof 34 of s" MACRO" endof 35 of s" #DEFINE" endof 36 of s" RECORD:" endof 37 of s" ;RECORDSIZE:" endof 38 of s" MACRO:" endof 39 of s" SUBR:" endof 40 of s" PROC" endof 41 of s" EXTERN" endof 42 of s" WINLIBRARY" endof endcase output-string ; : print-file-name ( #anchor -- ) \ Write the name of input file with the anchor into the output file. [char] " output-char $infile lcount (output-string) [char] # output-char s>d (D.) (output-string) [char] " output-char ; : process-word ( #anchor addr len -- ) \ *G Process on line of the input file. ?dup if parse-line if set-class-name print-definition-type output-sep ( #anchor ) print-class-name output-sep ( #anchor ) print-file-name output-cr ( -- ) else drop then else 2drop then ; --- NEW FILE: DexH-CreateDocs.f --- \ $Id: DexH-CreateDocs.f,v 1.1 2008/12/22 22:56:14 camilleforth Exp $ anew -DexH-CreateDocs.f needs tools/w32fdexh.f \ *D doc \ *! p-dexh-createdocs Docs W32F ) \ *T Documenting Win32Forth internal external : create-docs ( -- ) \ W32F tool \ *G Create the documentation for Win32Forth from \ ** the source files. \ *P Not all files have been marked up yet. If you feel like doing some \ ** then drop us a line at \ *W <a href="http://groups.yahoo.com/group/win32forth">win32forth at Yahoo</a> \ *P VOLUNTEERS are always welcome. \ create a new gloassary file if needed 1 to create-glossary-file? output-new \ classes W32FClassDocs \ \ Windows, dialogs and controls s" src\generic.f" create-doc s" src\window.f" create-doc s" src\lib\TrayWindow.f" create-doc s" src\lib\TimerWindow.f" create-doc s" src\childwnd.f" create-doc s" src\dialog.f" create-doc s" src\control.f" create-doc -tr s" src\controls.f" create-doc s" src\lib\StatusBar.f" create-doc s" src\lib\Textbox.f" create-doc s" src\lib\Listbox.f" create-doc s" src\lib\UpDownControl.f" create-doc s" src\lib\Buttons.f" create-doc s" src\lib\Label.f" create-doc s" src\lib\ProgressBar.f" create-doc s" src\lib\TrackBar.f" create-doc s" src\lib\ScrollBar.f" create-doc s" src\lib\Calendar.f" create-doc s" src\lib\TabControl.f" create-doc +tr s" src\lib\ButtonBar.f" create-doc \ s" src\lib\MdiDialog.f" create-doc s" src\lib\AXControl.F" create-doc \ -tr s" src\lib\HTMLcontrol.F" create-doc +tr s" demos\HtmlControlDemo.f" create-doc -tr s" src\lib\Mdi.F" create-doc +tr s" demos\MdiExample.f" create-doc \ \ GDI class library s" src\gdi\gdiStruct.f" create-doc s" src\gdi\gdiBase.f" create-doc s" src\gdi\gdiPen.f" create-doc s" src\gdi\gdiBrush.f" create-doc s" src\gdi\gdiBitmap.f" create-doc s" src\gdi\gdiFont.f" create-doc s" src\gdi\gdiMetafile.f" create-doc s" src\gdi\gdiDC.f" create-doc s" src\gdi\gdiWindowDC.f" create-doc s" src\gdi\gdiMetafileDC.f" create-doc \ \ other classes s" src\lib\file.f" create-doc s" src\lib\SQLite.F" create-doc s" src\lib\ExtDC.F" create-doc s" src\lib\BitmapDC.F" create-doc \ \ ADO s" src\lib\Ado.f" create-doc \ other documentation W32FDocs \ s" src\lib\AcceleratorTables.f" create-doc s" src\lib\task.f" create-doc s" src\Module.f" create-doc s" src\Classdbg.f" create-doc s" src\FLOAT.F" create-doc s" src\console\NoConsole.f" create-doc s" src\Callback.f" create-doc s" src\paths.f" create-doc s" src\interpif.f" create-doc s" src\floadcmdline.f" create-doc s" src\tools\W32fdexh.f" create-doc s" src\tools\DexH-CreateDocs.f" create-doc s" src\lib\Sock.f" create-doc s" apps\Internet\WebServer\sockserv.f" create-doc ; module \ also hidden \ debug create-doc cls create-docs \ *Z --- NEW FILE: W32fdexh.f --- \ $Id: W32fdexh.f,v 1.1 2008/12/22 22:56:14 camilleforth Exp $ \ *D doc \ *! p-W32fdexh \ *T Extensions to DexH for producing Win32Forth Documents \ *P DexH is a versatile system for producing documentation and these extensions are designed \ ** to customise it for producing the Win32Forth documentation itself (including this \ ** file). needs tools/dexh anew -w32fdexh.f internal create W32Fheader ,| <?xml version="1.0"?> | ,| <!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Strict//EN" | ,| "http://www.w3.org/TR/xhtml1/DTD/xhtml1-strict.dtd"> | ,| <html xmlns="http://www.w3.org/1999/xhtml" xml:lang="en" lang="en"> | ,| <head> | ,| <meta name="GENERATOR" content="dexh v03"> | ,| <meta name="ProgId" content="FrontPage.Editor.Document"> | ,| <meta http-equiv="Content-Type" content="text/html; charset=windows-1252"> | ,| <title> | 0 c, create W32FHeaderA ,| </title><style><!-- | ,| h1 { font-family: Tahoma; font-size: 24pt; font-weight: bold } | ,| h2 { font-family: Tahoma; font-size: 18pt; font-weight: bold } --> | ,| </style> | ,| </head> | ,| <body><h1 align="center"> | ,| <a href="mailto:win...@ya...?subject=DOC:Doc error in $Id: W32fdexh.f,v 1.1 2008/12/22 22:56:14 camilleforth Exp $"> | ,| <img border="0" src="TELLUS.gif" align="left" width="32" height="32"></a> | ,| <img border="0" src="FORTHPRO.gif" | ,| width="32" height="32"> Win32Forth</h1> | 0 c, create W32FClassheaderA ,| </title><style><!-- | ,| h1 { font-family: Tahoma; font-size: 24pt; font-weight: bold } | ,| h2 { font-family: Tahoma; font-size: 18pt; font-weight: bold } --> | ,| </style> | ,| </head> | ,| <body><h1 align="center"> | ,| <a href="mailto:win...@ya...?subject=DOC:Doc error in $Id: W32fdexh.f,v 1.1 2008/12/22 22:56:14 camilleforth Exp $"> | ,| <img border="0" src="../TELLUS.gif" align="left" width="32" height="32"></a> | ,| <img border="0" src="../FORTHPRO.gif" | ,| width="32" height="32"> Win32Forth</h1> | 0 c, create W32FTrailer ,| <hr><p>Document $Id: W32fdexh.f,v 1.1 2008/12/22 22:56:14 camilleforth Exp $</p> | ,| </body></html> | 0 c, create W32FNoTrailer 0 c, external \ *S Glossary : W32FDocs ( -- ) \ *G Set output for Win32Forth documents in the doc folder. W32Fheader to HtmlHeader W32FheaderA to HtmlheaderA W32FTrailer to HtmlTrailer ; : W32FClassDocs ( -- ) \ *G Set output for Win32Forth documents in the doc\classes folder. W32Fheader to HtmlHeader W32FClassheaderA to HtmlheaderA W32FTrailer to HtmlTrailer ; : DexDocs ( -- ) \ *G Set normal DexH output style. DexHTMLheader to HTMLheader DexHTMLheaderA to HTMLheaderA DexHTMLtrailer to HTMLtrailer ; internal 0 value OLDtrailer external : -tr ( -- ) \ *G Stop output of the HTML trailer. OLDtrailer 0= if HTMLtrailer to OLDtrailer W32FNoTrailer to HTMLtrailer then ; : +tr ( -- ) \ *G Restart output of the HTML trailer. OLDtrailer ?DUP if to HTMLtrailer 0 to OLDtrailer then ; : create-doc ( addr len -- ) \ *G Create the document for a file. To find the file the forth \ ** search path is used. Prepend<home>\ (dex) ; internal in-application FileOpenDialog DexFile "Dex Forth File" "Forth Files (*.f)|*.f|All Files (*.*)|*.*|" in-system external : DEXF ( -- ) \ *G Choose a file and convert it to HTML. Output filenames are included in the \ ** source file. conhndl start: DexFile count ?dup if (dex) else drop then ; [defined] dexh [if] \in-system-ok ' DEXF is dexh \ link into w32f console menu [then] module cr .( DexH -- Document Extractor loaded ) cr cr .( Usage: " DEX <filename> " to convert the file <filenname> ) cr .( or " DEXF " to choose a file and convert it. ) cr cr .( Use W32FDocs or W32FClassDocs to set the style for Win32Forth docs, ) cr .( in the docs folder or Class docs, in the docs\class folder. ) cr .( Use DexDocs for the standard DexH style. The DexH style is the default. ) \ *Z --- NEW FILE: DexH.f --- \ $Id: DexH.f,v 1.1 2008/12/22 22:56:14 camilleforth Exp $ ( *! dexh DexH ) ( *T DexH -- Document Extractor, HTML output ) \ *Q Version 3 \ ** Primary contributors: Brad Eckert br...@SP... \ ** Modified for use in Win32Forth by George Hubert and Dirk Busch ( *Q Abstract ) ( ** DexH is a simple literate programming tool inspired by MPE's DOCGEN. DexH ) ( ** can also be used to write articles about Forth featuring a mixture of ) ( ** documentation and source code. DexH is a standalone program that processes) ( ** a Forth source file. The following command does the conversion: \n ) ( ** \bDEX input_filename\d ) ( *S Commands ) ( *P Commands are embedded within comments. You can use the following formats, ) ( ** with either starting at the first column. ) \ *B ( ?? ... ) where ?? is the command, or \ *B \ ?? ... ( *P You can append HTML to created files by DEXing any number of source files ) ( ** but you should use a *Z command to complete the HTML. ) ( *L |c||l| ) ( *| Command | Effect | ) ( *| ** | continuation of G, E or P | ) ( *| *D | Select a new output folder | ) \ dbu ( *| *! | create and select a new output file | ) ( *| *> | select an existing file to add text to | ) ( *| *T | Title | ) ( *| *Q | Quotation or abstract | ) ( *| *S | Section | ) ( *| *N | Sub-section | ) ( *| *P | Paragraph | ) ( *| *E | Paragraph which is a code example | ) ( *| *B | Bullet entry | ) ( *| *G | Glossary entry for the previous line | ) ( *| *R | raw LaTeX | ) ( *| *W | raw HTML | ) ( *| *Z | End output | ) ( *| *+ | Include source code as document text | ) ( *| *- | Turn off source code inclusion | ) anew -DexH.f internal \ Set to true when a separate glossary.txt should be created \ Still work in progress... (dbu) 1 value create-glossary-file? ( *P DexH is ANS Forth except for the need for BOUNDS, SCAN, SKIP and LCOUNT. ) ( ** They are commonly used words but redefined here for completeness. ) ( *+ ) \ : BOUNDS OVER + SWAP ; \ : SCAN ( addr len char -- addr' len' ) \ >R BEGIN DUP WHILE OVER C@ R@ <> \ WHILE 1 /STRING REPEAT THEN R> DROP ; \ : SKIP ( addr len char -- addr' len' ) \ >R BEGIN DUP WHILE OVER C@ R@ = \ WHILE 1 /STRING REPEAT THEN R> DROP ; \ : LCOUNT ( addr -- addr' len ) DUP CELL+ SWAP @ ; ( *P Some files use very long lines, which is desirable for long sections of ) ( ** documentation. You can allocate buffers for lines longer than 2000 chars ) ( ** by changing the following line: ) 2000 CHARS CONSTANT max$ ( *- ) CREATE inbuf max$ 2 CELLS + ALLOT \ current line CREATE prevline max$ 2 CELLS + ALLOT \ previous line CREATE XPAD max$ 2 CELLS + ALLOT \ temporary ( *+ ) ( *P HTML needs some canned boilerplate. This is created by ,| since HTML ) ( ** doesn't use | characters. ) : (,$) ( a len -- ) DUP C, 0 ?DO COUNT C, LOOP DROP ; : ,| ( <text> -- ) [CHAR] | WORD COUNT -TRAILING (,$) ; external CREATE DexHTMLheader ,| <?xml version="1.0"?> | ,| <!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Strict//EN" | ,| "http://www.w3.org/TR/xhtml1/DTD/xhtml1-strict.dtd"> | ,| <html xmlns="http://www.w3.org/1999/xhtml" xml:lang="en" lang="en"> | ,| <head> | ,| <meta http-equiv="Content-Type" content="text/xml; charset=iso-8859-1" />| ,| <meta name="GENERATOR" content="DexH v03" /> | ,| <style type="text/css"> | ,| </style> | ,| <title> | 0 C, ( *- ) DexHTMLheader value HTMLheader CREATE DexHTMLheaderA ,| </title> | ,| </head> | ,| <body> | 0 C, DexHTMLheaderA value HTMLheaderA CREATE DexHTMLtrailer ,| <hr /> | ,| </body></html> | 0 C, DexHTMLtrailer value HTMLtrailer internal 0 VALUE outfile \ The current output file 0 VALUE infile 0 VALUE echoing 0 value plain \ Echo the code as output 0 VALUE mode 0 VALUE gl-outfile \ The glossary current output file ( *P All output is via OUT and OUTLN, which can be sent to the screen for ) ( ** debugging purposes. ) ( *+ ) 0 VALUE testing \ screen is for testing : werr ( n -- ) ABORT" Error writing file" ; : out ( a len -- ) testing IF TYPE ELSE outfile WRITE-FILE werr THEN ; : outln ( a len -- ) testing IF TYPE CR ELSE outfile WRITE-LINE werr THEN ; ( *- ) : boiler ( addr -- ) BEGIN COUNT DUP WHILE 2DUP + >R outln R> REPEAT 2DROP ; : tag| ( <name><str> -- ) CREATE ,| DOES> COUNT out ( ln ) ; tag| +t <table border="1"> | \ table tag| -t </table> | tag| +b <ul><li> | \ bullets tag| -b </li></ul> | tag| ~b </li><li> | tag| +e <pre> | \ code paragraph tag| -e </pre> | tag| +p <p> | \ paragraph tag| -p </p> | tag| +g <pre><b> | \ preformatted bold glossary tag| -g </b></pre> | tag| hr <hr /> | \ rule tag| +h1 <h1> | \ title tag| -h1 </h1> | tag| +h2 <h2> | \ section tag| -h2 </h2> | tag| +h3 <h3> | \ sub-section tag| -h3 </h3> | tag| +qu <h3><i> | \ quotation or abstract tag| -qu </i></h3> | tag| +au <h4><i> | \ Author tag| -au </i></h4> | tag| -a </a> tag| +n <a name=" | tag| -n "> | tag| +href <a href=" | tag| -href "> | ( *P Some characters are replaced by special strings so they can't be ) ( ** interpreted as tags. Also, runs of blanks need special treatment. ) ( ** Some escape sequences are supported: ) ( *L |c||l| ) ( *| \bseq\d | \bEscape command \d | ) ( *| \\i | Italics | ) ( *| \\b | Bold | ) ( *| \\t | Typewriter | ) \ *| \\^ | Superscript (i.e. ax\\^2\\d+bx+c=0) | \ *| \\_ | Subscript | \ *| \\d | Default font (ends italic, superscript, etc.) | ( *| \\n | Line break | ) ( *| \\r | Horizontal rule | ) ( *| \\p | Page break | ) ( *| \\\\ | \ | ) \ *P Sample usage: \ ** "ax\\^2\\d + bx + w\\_0\\d = 0" displays ax\^2\d + bx + w\_0\d = 0 \ *P "Try \\bbold, \\iitalic \\dand \\ttypewriter.\\d" displays \ ** "Try \bbold, \iitalic \dand \ttypewriter\d." VARIABLE bltally \ counts runs of blanks VARIABLE thisfont \ current font attributes VARIABLE escape \ escape sequence in progress? VARIABLE captive \ ESC sequence not allowed : no-escape ( -- ) S" \" out 0 escape ! ; ( *+ ) : new-font ( n -- ) \ switch to a new font thisfont @ SWAP thisfont ! CASE [CHAR] i OF S" </i>" out ENDOF [CHAR] b OF S" </b>" out ENDOF [CHAR] t OF S" </code>" out ENDOF [CHAR] ^ OF S" </sup>" out ENDOF [CHAR] _ OF S" </sub>" out ENDOF ENDCASE ; : outh ( addr len -- ) \ HTMLized text output 999 bltally ! BOUNDS ?DO I C@ escape @ IF CASE [CHAR] \ OF S" \" out ENDOF [CHAR] n OF S" <br />" out ENDOF [CHAR] r OF hr ENDOF [CHAR] i OF I C@ new-font S" <i>" out ENDOF [CHAR] b OF I C@ new-font S" <b>" out ENDOF [CHAR] t OF I C@ new-font S" <code>" out ENDOF [CHAR] ^ OF I C@ new-font S" <sup>" out ENDOF [CHAR] _ OF I C@ new-font S" <sub>" out ENDOF [CHAR] d OF 0 new-font ENDOF no-escape I 1 out ENDCASE 0 escape ! ELSE CASE [CHAR] \ OF captive @ IF no-escape ELSE 1 escape ! THEN ENDOF [CHAR] & OF S" &" out ENDOF [CHAR] < OF S" <" out ENDOF [CHAR] > OF S" >" out ENDOF [CHAR] " OF S" "" out ENDOF [CHAR] © OF S" ©" out ENDOF BL OF bltally @ IF S" " ELSE S" " THEN out 1 bltally +! ENDOF I 1 out 0 bltally ! ENDCASE THEN LOOP escape @ IF no-escape THEN \ trailing \ S" " outln ; ( *- ) : outt ( a n -- ) out ; \ output as title string \ : lastchar ( a n -- a n c ) \ 2DUP 1- CHARS + C@ ; : line ( -- a len ) inbuf LCOUNT 5 /STRING \ remove ( ** and ) or \ ** inbuf CELL+ C@ [CHAR] ( = IF lastchar [CHAR] ) = IF 1- THEN THEN -TRAILING ; : _parse ( $line char -- $line' $ ) >R 2DUP R@ SKIP R> SCAN BL SCAN \ parse out a substring 2SWAP 2 PICK - ; : closeout ( -- ) outfile ?DUP IF CLOSE-FILE DROP THEN 0 TO outfile ; : end ( -- ) \ insert end tags mode CASE [CHAR] P OF -p ENDOF [CHAR] E OF -e ENDOF [CHAR] B OF -b ENDOF [CHAR] L OF -t ENDOF ENDCASE BL TO mode ; CREATE $infile max$ 2 CELLS + ALLOT \ file name 0 value #gl-anchor : switchfolder ( -- ) \ Set new output folder end closeout line BL _parse \ get folder \in-system-ok Prepend<home>\ "chdir \ set current directory 2drop ; : switchfile ( -- $other $name io ) \ Set new output file end closeout line BL _parse \ get filename (minus extension) >R XPAD R@ MOVE S" .htm" XPAD R@ CHARS + SWAP MOVE \ add file extension xpad R@ 4 CHARS + $infile lplace \ save file name 0 to #gl-anchor \ reset anchor XPAD R> 4 CHARS + w/o ; : pgraph ( -- ) +p line outh [CHAR] P TO mode ; : egraph ( -- ) +e line outh [CHAR] E TO mode ; : iscommand? ( $ -- ) inbuf CELL+ 3 COMPARE 0= ; \ *P The fields in a table are separated by | (vertical bar) and end in |. : table| ( -- ) \ add line to a table line BEGIN [CHAR] | _parse BL SKIP 1- 0 MAX -TRAILING DUP IF S" <td>" out outh S" </td>" outln ELSE 2DROP 2DROP EXIT THEN AGAIN ; fload tools/DexH-Glossary.f : gl-open ( -- ) \ *G Open glossary File. create-glossary-file? if output-open drop then ; : gl-close ( -- ) \ *G Close glossary File. create-glossary-file? if output-close then ; : gl-anchor ( -- ) \ *G Write anchor number. #gl-anchor s>d (D.) out ; CREATE $line max$ 2 CELLS + ALLOT \ previous line : gl-get-type ( addr len - f ) $line lplace $line lcount get-definition-type definition-type #invalid-definition-type <> ; : gl-entry ( addr len -- ) \ cr 2dup type 2dup gl-get-type if IsCloseingClass? 0= if $line lplace #gl-anchor $line lcount process-word else 2drop then else 2drop cr ." Line: " $line lcount type ." skipped" then ; : gl-create-entry ( -- ) \ *G Create a glossary entry \ cr ." gl-create-entry: " prevline LCOUNT type +n gl-anchor -n prevline LCOUNT outh -a create-glossary-file? if prevline LCOUNT gl-entry 1 +to #gl-anchor then ; : command ( c -- ) plain IF -e 0 TO plain THEN \ terminate plain text CASE [CHAR] * OF line outh ENDOF [CHAR] ! OF switchfile create-file abort" Can't create file" TO outfile \ create and select a new file HTMLheader boiler outt \ add title HTMLheaderA boiler ENDOF [CHAR] > OF switchfile open-file abort" Can't open file" TO outfile 2DROP outfile FILE-SIZE DROP outfile REPOSITION-FILE DROP ENDOF [CHAR] T OF end hr +h1 line outh -h1 hr ENDOF [CHAR] S OF end +h2 line outh -h2 ENDOF [CHAR] N OF end +h3 line outh -h3 ENDOF [CHAR] A OF end +au line outh -au +p [CHAR] P TO mode ENDOF [CHAR] Q OF end +qu line outh -qu +p [CHAR] P TO mode ENDOF [CHAR] P OF end pgraph ENDOF [CHAR] E OF end egraph ENDOF [CHAR] B OF mode [CHAR] B <> IF end +b ELSE ~b THEN line outh [CHAR] B TO mode ENDOF [CHAR] G OF end +g gl-create-entry -g pgraph ENDOF [CHAR] W OF end line outln ENDOF [CHAR] + OF end +e 1 TO plain 1 TO echoing ENDOF [CHAR] - OF end 0 TO echoing ENDOF [CHAR] L OF end +t [CHAR] L TO mode ENDOF [CHAR] | OF S" <tr>" out table| S" </tr>" outln ENDOF [CHAR] Z OF end HTMLtrailer boiler ENDOF [CHAR] D OF switchfolder ENDOF \ dbu ENDCASE ; : process-line ( -- ) \ process INBUF S" ( *" iscommand? S" \ *" iscommand? OR inbuf @ 3 > AND IF 0 captive ! inbuf 3 CHARS + CELL+ C@ command \ a command ELSE end echoing \ not a command IF plain 0= IF 1 TO plain +e THEN 1 captive ! inbuf LCOUNT outh THEN THEN inbuf prevline OVER @ CELL+ MOVE ; \ save the old line ( *W <hr /> ) ( *S Glossary ) external : (dex) ( addr len -- ) ( *G Convert a file or files to HTML. Output filenames are included in the ) ( ** source file. ) 2dup cr ." Processing file: " type 0 TO testing \ output to file 0 TO echoing 0 TO plain 0 TO mode \ reset modes 0 escape ! R/O OPEN-FILE ABORT" Missing input file" TO infile gl-open prevline max$ BLANK BEGIN inbuf max$ BL FILL \ convert tabs to spaces XPAD max$ infile READ-LINE ABORT" Error reading file" >R >R 0 XPAD R> BOUNDS ( idx . . ) ?DO I C@ 9 = IF 3 RSHIFT 1+ 3 LSHIFT \ tab ELSE I C@ OVER CHARS CELL+ inbuf + C! 1+ DUP max$ = IF CR ." Input line too long" THEN THEN LOOP R> ( len eof ) WHILE inbuf ! process-line REPEAT DROP closeout infile CLOSE-FILE DROP \ close files gl-close ; : DEX ( <filename> -- ) ( *G Convert a file or files to HTML. Output filenames are included in the ) ( ** source file. ) BL PARSE (dex) ; : q ( <string> -- ) ( *G Test a single line of text, outputting to the screen. ) 1 TO testing -1 PARSE inbuf OVER ! inbuf CELL+ SWAP MOVE process-line ; \ *W <hr /><p>This file generated by <a href="dexh.F">DexH</a></p> \ *Z module \ also hidden \ debug gl-create-entry \ dex c:\test.f |
