version 1.8, 2001/07/24 21:21:26
|
version 1.9, 2001/07/29 20:19:25
|
Line 109 Variable link-suffix
|
Line 109 Variable link-suffix
|
Variable iconpath |
Variable iconpath |
|
|
Variable do-size |
Variable do-size |
|
Variable do-icon |
|
|
Defer parse-line |
Defer parse-line |
|
|
Line 131 Defer parse-line
|
Line 132 Defer parse-line
|
UNTIL ELSE drop THEN |
UNTIL ELSE drop THEN |
r> close-dir throw ; |
r> close-dir throw ; |
|
|
: link-icon? ( -- ) iconpath @ IF iconpath $off THEN |
: link-icon? ( -- ) do-icon @ 0= ?EXIT |
link $@ |
iconpath @ IF iconpath $off THEN |
|
link $@ + 1- c@ '/ = IF s" index.html" ELSE link $@ THEN |
BEGIN '. $split 2swap 2drop dup WHILE |
BEGIN '. $split 2swap 2drop dup WHILE |
2dup get-icon REPEAT 2drop ; |
2dup get-icon REPEAT 2drop ; |
|
|
Line 142 Defer parse-line
|
Line 144 Defer parse-line
|
r> close-file throw ; |
r> close-file throw ; |
|
|
: link-options ( addr u -- addr' u' ) |
: link-options ( addr u -- addr' u' ) |
do-size off |
do-size off do-icon on |
over c@ '% = over 0> and IF do-size on 1 /string THEN ; |
over c@ '% = over 0> and IF do-size on 1 /string THEN |
|
over c@ '\ = over 0> and IF do-icon off 1 /string THEN ; |
|
|
: parse-string ( addr u -- ) |
: parse-string ( addr u -- ) |
evaluate-input cell new-tib #tib ! tib ! |
evaluate-input cell new-tib #tib ! tib ! |
['] parse-line catch pop-file throw ; |
['] parse-line catch pop-file throw ; |
|
|
: .link ( -- ) '[ parse type '] parse '| $split |
: .link ( addr u -- ) '| $split |
link-options link $! |
link-options link $! |
link $@len 0= IF 2dup link $! s" .html" link $+! THEN |
link $@len 0= IF 2dup link $! s" .html" link $+! THEN |
link-icon? link $@ href= s" a" tag |
link-icon? link $@ href= s" a" tag |
parse-string s" a" /tag link-size? ; |
parse-string s" a" /tag link-size? ; |
|
: >link ( -- ) '[ parse type '] parse .link ; |
|
|
: .img ( -- ) '{ parse type '} parse '| $split |
: .img ( addr u -- ) '| $split |
dup IF 2swap alt= ELSE 2drop THEN |
dup IF 2swap alt= ELSE 2drop THEN |
tag-option $@len >r over c@ >align tag-option $@len r> = 1+ /string |
tag-option $@len >r over c@ >align tag-option $@len r> = 1+ /string |
2dup .img-size src= s" img" tag ; |
2dup .img-size src= s" img" tag ; |
|
: >img ( -- ) '{ parse type '} parse .img ; |
|
|
\ line handling |
\ line handling |
|
|
Line 168 Defer parse-line
|
Line 173 Defer parse-line
|
r> parse 2swap tagged ; |
r> parse 2swap tagged ; |
|
|
: .text ( -- ) >in @ >r char drop |
: .text ( -- ) >in @ >r char drop |
source r@ /string >in @ r> - nip type ; |
source r@ /string >in @ r> - nip |
|
bounds ?DO I c@ |
|
case |
|
'& of ." &" endof |
|
'< of ." <" endof |
|
dup emit |
|
endcase |
|
LOOP ; |
|
|
Create do-words $100 0 [DO] ' .text , [LOOP] |
Create do-words $100 0 [DO] ' .text , [LOOP] |
|
|
|
:noname '( emit 1 >in +! ; '( cells do-words + ! |
|
|
: bind-char ( xt -- ) char cells do-words + ! ; |
: bind-char ( xt -- ) char cells do-words + ! ; |
|
|
: char>tag ( -- ) char >r |
: char>tag ( -- ) char >r |
Line 182 char>tag * b
|
Line 196 char>tag * b
|
char>tag _ em |
char>tag _ em |
char>tag # code |
char>tag # code |
|
|
' .link bind-char [ |
' >link bind-char [ |
' .img bind-char { |
' >img bind-char { |
|
|
: do-word ( char -- ) cells do-words + perform ; |
: do-word ( char -- ) cells do-words + perform ; |
|
|
|
: word? ( -- addr u ) >in @ >r bl sword r> >in ! ; |
|
|
|
wordlist Constant autoreplacements |
|
|
:noname ( -- ) |
:noname ( -- ) |
BEGIN char? do-word source nip >in @ = UNTIL ; is parse-line |
BEGIN char? do-word source nip >in @ = UNTIL ; is parse-line |
|
|
|
: parse-line+ ( -- ) |
|
BEGIN |
|
word? autoreplacements search-wordlist |
|
IF execute bl sword 2drop |
|
source >in @ 1- /string drop c@ bl = >in +! |
|
ELSE char? do-word THEN |
|
source nip >in @ = UNTIL ; |
|
|
: parse-to ( char -- ) >r |
: parse-to ( char -- ) >r |
BEGIN char? dup r@ <> WHILE |
BEGIN char? dup r@ <> WHILE |
do-word source nip >in @ = UNTIL ELSE drop THEN |
do-word source nip >in @ = UNTIL ELSE drop THEN |
r> parse type ; |
r> parse type ; |
|
|
|
\ autoreplace |
|
|
|
: autoreplace ( <[string|url]> -- ) |
|
get-current autoreplacements set-current |
|
Create set-current |
|
here 0 , '[ parse 2drop '] parse rot $! |
|
DOES> $@ .link ; |
|
|
\ paragraph handling |
\ paragraph handling |
|
|
: parse-par ( -- ) |
: parse-par ( -- ) |
BEGIN parse-line cr refill WHILE |
BEGIN parse-line+ cr refill WHILE |
source nip 0= UNTIL THEN ; |
source nip 0= UNTIL THEN ; |
|
|
: par ( addr u -- ) env? 2dup tag parse-par /tag cr cr ; |
: par ( addr u -- ) env? 2dup tag parse-par /tag cr cr ; |
: line ( addr u -- ) env? 2dup tag parse-line /tag cr cr ; |
: line ( addr u -- ) env? 2dup tag parse-line+ /tag cr cr ; |
|
|
\ handle global tags |
\ handle global tags |
|
|
Line 230 longtags set-current
|
Line 264 longtags set-current
|
: <* s" center" >env ; |
: <* s" center" >env ; |
: >> -env ; |
: >> -env ; |
: *> -env ; |
: *> -env ; |
: :: also forth interpret previous ; |
: :: interpret ; |
: . end-sec on indentlevel off ; |
: . end-sec on indentlevel off ; |
|
: :code s" pre" >env |
|
BEGIN source >in @ /string type cr refill WHILE |
|
source s" :endcode" compare 0= UNTIL THEN |
|
-env ; |
: \ postpone \ ; |
: \ postpone \ ; |
|
|
definitions |
definitions |
Line 266 definitions
|
Line 304 definitions
|
\ parse a section |
\ parse a section |
|
|
: section-line ( -- ) >in off |
: section-line ( -- ) >in off |
bl sword find-name |
bl sword longtags search-wordlist |
?dup IF name>int execute |
IF execute |
ELSE source nip IF >in off s" p" par THEN THEN ; |
ELSE source nip IF >in off s" p" par THEN THEN ; |
: refill-loop ( -- ) end-sec off |
: refill-loop ( -- ) end-sec off |
BEGIN refill WHILE |
BEGIN refill WHILE |
section-line end-sec @ UNTIL THEN ; |
section-line end-sec @ UNTIL THEN ; |
: parse-section ( -- ) |
: parse-section ( -- ) |
get-order longtags 1 set-order refill-loop set-order ; |
refill-loop ; |
|
|
\ HTML head |
\ HTML head |
|
|