version 1.22, 2003/12/07 23:05:30
|
version 1.24, 2004/02/02 14:15:23
|
Line 26 require string.fs
|
Line 26 require string.fs
|
: -$split ( addr u char -- addr1 u1 addr2 u2 ) |
: -$split ( addr u char -- addr1 u1 addr2 u2 ) |
>r 2dup r@ -scan 2dup + c@ r> = negate over + >r |
>r 2dup r@ -scan 2dup + c@ r> = negate over + >r |
2swap r> /string ; |
2swap r> /string ; |
|
: parse" ( -- addr u ) '" parse 2drop '" parse ; |
|
|
\ tag handling |
\ tag handling |
|
|
Line 36 Variable indentlevel
|
Line 37 Variable indentlevel
|
Variable tag-option |
Variable tag-option |
s" " tag-option $! |
s" " tag-option $! |
|
|
|
: .type ( addr u -- ) |
|
bounds ?DO I c@ |
|
case |
|
'& of ." &" endof |
|
'< of ." <" endof |
|
dup emit |
|
endcase |
|
LOOP ; |
|
|
: tag ( addr u -- ) '< emit type tag-option $@ type '> emit |
: tag ( addr u -- ) '< emit type tag-option $@ type '> emit |
s" " tag-option $! ; |
s" " tag-option $! ; |
: tag/ ( addr u -- ) s" /" tag-option $+! tag ; |
: tag/ ( addr u -- ) s" /" tag-option $+! tag ; |
: /tag ( addr u -- ) '< emit '/ emit type '> emit ; |
: /tag ( addr u -- ) '< emit '/ emit type '> emit ; |
: tagged ( addr1 u1 addr2 u2 -- ) 2dup 2>r tag type 2r> /tag ; |
: tagged ( addr1 u1 addr2 u2 -- ) 2dup 2>r tag .type 2r> /tag ; |
|
|
: opt ( addr u opt u -- ) s" " tag-option $+! |
: opt ( addr u opt u -- ) s" " tag-option $+! |
tag-option $+! s' ="' tag-option $+! tag-option $+! |
tag-option $+! s' ="' tag-option $+! tag-option $+! |
Line 85 Variable table-start
|
Line 95 Variable table-start
|
CASE |
CASE |
'l OF s" left" class= ENDOF |
'l OF s" left" class= ENDOF |
'r OF s" right" class= ENDOF |
'r OF s" right" class= ENDOF |
'c OF s" center" class= ENDOF |
'c OF s" center" align= ENDOF |
'< OF s" left" class= ENDOF |
'< OF s" left" class= ENDOF |
'> OF s" right" class= ENDOF |
'> OF s" right" class= ENDOF |
'= OF s" center" class= ENDOF |
'= OF s" center" align= ENDOF |
'~ OF s" absmiddle" class= ENDOF |
'~ OF s" absmiddle" align= ENDOF |
ENDCASE ; |
ENDCASE ; |
|
|
: >talign ( c -- ) |
: >talign ( c -- ) |
Line 242 s" Gforth" environment? [IF] s" 0.5.0" s
|
Line 252 s" Gforth" environment? [IF] s" 0.5.0" s
|
\ line handling |
\ line handling |
|
|
: char? ( -- c ) >in @ char swap >in ! ; |
: char? ( -- c ) >in @ char swap >in ! ; |
|
|
: parse-tag ( addr u char -- ) |
: parse-tag ( addr u char -- ) |
>r r@ parse type |
>r r@ parse .type |
r> parse 2swap tagged ; |
r> parse 2swap tagged ; |
|
|
: .text ( -- ) >in @ >r char drop |
: .text ( -- ) >in @ >r char drop |
source r@ /string >in @ r> - nip |
source r@ /string >in @ r> - nip .type ; |
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] |
|
|
Line 409 Variable toc-index
|
Line 413 Variable toc-index
|
indentlevel @ over |
indentlevel @ over |
indentlevel ! |
indentlevel ! |
2dup < IF swap DO -env -env LOOP EXIT THEN |
2dup < IF swap DO -env -env LOOP EXIT THEN |
|
over 1 = IF = IF -env -env THEN EXIT THEN |
2dup > IF DO s" dl" >env s" dt" >env LOOP EXIT THEN |
2dup > IF DO s" dl" >env s" dt" >env LOOP EXIT THEN |
2dup = IF drop IF -env s" dt" >env THEN THEN |
2dup = IF drop IF -env s" dt" >env THEN THEN |
; |
; |
: +indent ( -- ) |
: +indent ( -- ) |
indentlevel @ IF -env s" dd" >env THEN |
indentlevel @ IF -env -env s" dl" >env s" dd" >env THEN |
; |
; |
|
|
wordlist constant longtags |
wordlist constant longtags |
Line 428 longtags set-current
|
Line 433 longtags set-current
|
: *** 2 indent s" h3" line +indent ; |
: *** 2 indent s" h3" line +indent ; |
: -- 0 indent cr print-toc ; |
: -- 0 indent cr print-toc ; |
: && ( -- ) divs @ IF -env THEN +env |
: && ( -- ) divs @ IF -env THEN +env |
0 parse id= s" div" env divs on ; |
0 parse id= s" div" env env? divs on ; |
: - s" ul" env s" li" par ; |
: - s" ul" env s" li" par ; |
: + s" ol" env s" li" par ; |
: + s" ol" env s" li" par ; |
: << +env ; |
: << +env ; |
: <* s" center" class= s" p" >env ; |
: <* s" center" class= ; |
: <red s" #ff0000" s" color" opt s" font" >env ; |
: <red s" #ff0000" s" color" opt s" font" >env ; |
: red> -env ; |
: red> -env ; |
: >> -env ; |
: >> -env ; |
: *> -env ; |
: *> ; |
: :: interpret ; |
: :: interpret ; |
: . end-sec on 0 indent ; |
: . end-sec on 0 indent ; |
: :code indent= s" pre" >env |
: :code indent= s" pre" >env |
BEGIN source >in @ /string type cr refill WHILE |
BEGIN source >in @ /string type cr refill WHILE |
source s" :endcode" str= UNTIL THEN |
source s" :endcode" str= UNTIL THEN |
-env ; |
-env ; |
|
: :code-file indent= s" pre" >env |
|
parse" r/o open-file throw >r |
|
r@ file-size throw drop dup allocate throw |
|
2dup swap r@ read-file throw 2dup type drop |
|
-env free throw drop |
|
r> close-file throw ; |
: \ postpone \ ; |
: \ postpone \ ; |
|
|
definitions |
definitions |
Line 489 definitions
|
Line 500 definitions
|
Variable css-file |
Variable css-file |
|
|
: .title ( addr u -- ) |
: .title ( addr u -- ) |
.' <!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Strict//en" "http://www.w3.org/TR/xhtml1/DTD/xhtml1-strict.dtd">' cr |
.' <!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Transitional//en" "http://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd">' cr |
s" html" >env s" head" >env cr |
s" html" >env s" head" >env cr |
s" Content-Type" s" http-equiv" opt |
s" Content-Type" s" http-equiv" opt |
s" text/xhtml; charset=iso-8859-1" s" content" opt |
s" text/xhtml; charset=iso-8859-1" s" content" opt |
s" meta" tag/ |
s" meta" tag/ |
css-file $@len IF |
css-file @ IF css-file $@len IF |
s" StyleSheet" s" rel" opt |
s" StyleSheet" s" rel" opt |
css-file $@ href= |
css-file $@ href= |
s" text/css" s" type" opt s" link" tag/ |
s" text/css" s" type" opt s" link" tag/ |
THEN |
THEN THEN |
s" title" tagged cr |
s" title" tagged cr |
-env ; |
-env ; |
|
|
Line 523 Variable orig-date
|
Line 534 Variable orig-date
|
|
|
\ top word |
\ top word |
|
|
: parse" ( -- addr u ) '" parse 2drop '" parse ; |
|
|
|
: maintainer ( -- ) |
: maintainer ( -- ) |
bl sword mail $! parse" mail-name $! ; |
bl sword mail $! parse" mail-name $! ; |
: created ( -- ) |
: created ( -- ) |