version 1.21, 2003/11/23 23:14:28
|
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 366 Create nav-buf 0 c,
|
Line 370 Create nav-buf 0 c,
|
: new-toc toc-link off ; |
: new-toc toc-link off ; |
|
|
Variable toc-name |
Variable toc-name |
|
Variable toc-index |
|
6 Value /toc-line |
|
|
: .toc-entry ( toc flag -- ) |
: .toc-entry ( toc flag -- ) |
swap cell+ dup @ swap cell+ dup cell+ $@ 2dup href= s" a" tag |
swap cell+ dup @ swap cell+ dup cell+ $@ 2dup href= s" a" tag |
Line 386 Variable toc-name
|
Line 392 Variable toc-name
|
3 of s" v]|-icons/arrow_down.jpg" .img endof |
3 of s" v]|-icons/arrow_down.jpg" .img endof |
endcase |
endcase |
THEN |
THEN |
s" a" /tag rdrop |
s" a" /tag rdrop ." <!--" cr ." -->" |
; |
1 toc-index +! toc-index @ /toc-line mod 0= |
: print-toc ( -- ) cr s" menu" id= s" div" tag cr 0 parse |
IF s" br" tag/ THEN ; |
|
|
|
: print-toc ( -- ) toc-index off cr s" menu" id= s" div" >env cr |
|
0 parse |
dup 0= IF toc-name $! 0 ELSE |
dup 0= IF toc-name $! 0 ELSE |
toc-name $! toc-name $@ id= s" " s" a" tagged 2 |
toc-name $! toc-name $@ id= s" " s" a" tagged 2 |
THEN >r |
THEN >r |
toc-link BEGIN @ dup WHILE |
toc-link BEGIN @ dup WHILE |
dup cell+ @ 3 = r@ 0= and IF rdrop 1 >r ( s" br" tag/ cr ) THEN |
dup cell+ @ 3 = r@ 0= and IF rdrop 1 >r ( s" br" tag/ cr ) THEN |
dup cell+ @ r@ >= IF dup r@ 2 = .toc-entry THEN |
dup cell+ @ r@ >= IF dup r@ 2 = .toc-entry THEN |
dup cell+ @ 2 = r@ 2 = and IF s" br" tag/ cr THEN |
dup cell+ @ 2 = r@ 2 = and IF s" br" tag/ toc-index off THEN |
REPEAT drop rdrop cr s" div" /tag cr ; |
REPEAT drop rdrop -env cr ; |
|
|
\ handle global tags |
\ handle global tags |
|
|
: indent ( n -- ) |
: indent ( n -- ) |
\ indentlevel @ over |
indentlevel @ over |
indentlevel ! |
indentlevel ! |
\ 2dup < IF swap DO -env -env LOOP EXIT THEN |
2dup < IF swap DO -env -env LOOP EXIT THEN |
\ 2dup > IF DO s" dl" >env s" dt" >env LOOP EXIT THEN |
over 1 = IF = IF -env -env THEN EXIT THEN |
\ 2dup = IF drop IF -env s" dt" >env THEN THEN |
2dup > IF DO s" dl" >env s" dt" >env LOOP EXIT 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 423 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 484 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 518 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 ( -- ) |