2019-03-29 14:50:53 +01:00
|
|
|
#!/usr/bin/env retro
|
|
|
|
|
|
|
|
This program generates an HTML index and exports (using the
|
|
|
|
`export-as-html.forth` example) the samples to HTML. The files
|
|
|
|
are stored in `/home/crc/public/examples`.
|
|
|
|
|
2019-04-16 20:18:17 +02:00
|
|
|
# Configuration
|
|
|
|
|
|
|
|
~~~
|
|
|
|
'/home/crc/public/examples/ 'FILE-PATH s:const
|
|
|
|
~~~
|
|
|
|
|
2019-05-09 15:45:44 +02:00
|
|
|
# Variables
|
|
|
|
|
|
|
|
~~~
|
|
|
|
'FID var
|
2019-03-29 14:50:53 +01:00
|
|
|
~~~
|
|
|
|
|
2019-05-09 15:45:44 +02:00
|
|
|
# Support
|
|
|
|
|
|
|
|
This word takes a string and provides a flag of `TRUE` if it
|
|
|
|
ends in `/`, or `FALSE` otherwise. It leaves the string pointer
|
|
|
|
on the stack.
|
2019-03-29 14:50:53 +01:00
|
|
|
|
2019-05-09 15:45:44 +02:00
|
|
|
~~~
|
2019-03-29 14:50:53 +01:00
|
|
|
:dir? (s-sf)
|
|
|
|
dup s:length over + n:dec fetch $/ eq? ;
|
|
|
|
~~~
|
|
|
|
|
2019-05-09 15:45:44 +02:00
|
|
|
# Words To Create The Index
|
2019-03-29 14:50:53 +01:00
|
|
|
|
|
|
|
~~~
|
2019-05-09 15:45:44 +02:00
|
|
|
:s:put [ @FID file:write ] s:for-each ;
|
|
|
|
:css '<style>*{background:#111;color:#fff;font-family:monospace;}</style>
|
|
|
|
s:put ;
|
|
|
|
:dtd '<!DOCTYPE_html> s:put ;
|
|
|
|
:title '<title>RETRO_Examples</title> s:put ;
|
|
|
|
:head '<head> s:put title css '</head> s:put ;
|
2019-05-10 15:04:54 +02:00
|
|
|
:li '<li> s:put call '</li><br>\n s:format s:put ;
|
|
|
|
:link dup '<a_href="/examples/%s.html">%s</a>_ s:format s:put ;
|
|
|
|
:link2 '<a_href="/examples/%s.glossary"><br>→_glossary</a> s:format s:put
|
|
|
|
$. c:put ;
|
|
|
|
:links [ dup link link2 ] li ;
|
2019-05-09 15:45:44 +02:00
|
|
|
:body '<body> s:put call '</body> s:put ;
|
|
|
|
:make dtd head body ;
|
|
|
|
~~~
|
2019-03-29 14:50:53 +01:00
|
|
|
|
2019-05-09 15:45:44 +02:00
|
|
|
# Generate index.html
|
2019-03-29 14:50:53 +01:00
|
|
|
|
2019-05-09 15:45:44 +02:00
|
|
|
~~~
|
|
|
|
FILE-PATH 'index.html s:append file:W file:open !FID
|
2019-05-10 15:04:54 +02:00
|
|
|
[ '<h1>Examples</h1><br><ul> s:put
|
|
|
|
[ dir? &drop &links choose ] unix:for-each-file
|
|
|
|
'</ul> s:put nl ] make
|
2019-05-09 15:45:44 +02:00
|
|
|
@FID file:close
|
2019-03-29 14:50:53 +01:00
|
|
|
~~~
|
|
|
|
|
|
|
|
# Generate HTML Files
|
|
|
|
|
|
|
|
~~~
|
2019-04-16 20:18:17 +02:00
|
|
|
:export FILE-PATH over
|
|
|
|
'./export-as-html.forth_%s_>%s%s.html s:format unix:system $. c:put ;
|
2019-03-29 14:50:53 +01:00
|
|
|
|
|
|
|
[ dir? &drop [ export ] choose ] unix:for-each-file nl
|
|
|
|
~~~
|
2019-05-10 15:04:54 +02:00
|
|
|
|
|
|
|
# Generate a Glossary File For Each
|
|
|
|
|
|
|
|
~~~
|
|
|
|
:glossary FILE-PATH over
|
|
|
|
'retro-document_%s_>%s%s.glossary s:format unix:system $. c:put ;
|
|
|
|
|
|
|
|
[ dir? &drop &glossary choose ] unix:for-each-file
|
|
|
|
~~~
|