--- gforth/wf.fs 2005/12/31 15:46:10 1.41 +++ gforth/wf.fs 2008/10/06 19:31:36 1.57 @@ -1,12 +1,12 @@ \ wiki forth -\ Copyright (C) 2003,2004,2005 Free Software Foundation, Inc. +\ Copyright (C) 2003,2004,2005,2006,2007,2008 Free Software Foundation, Inc. \ This file is part of Gforth. \ Gforth is free software; you can redistribute it and/or \ modify it under the terms of the GNU General Public License -\ as published by the Free Software Foundation; either version 2 +\ as published by the Free Software Foundation, either version 3 \ of the License, or (at your option) any later version. \ This program is distributed in the hope that it will be useful, @@ -15,8 +15,7 @@ \ GNU General Public License for more details. \ You should have received a copy of the GNU General Public License -\ along with this program; if not, write to the Free Software -\ Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111, USA. +\ along with this program. If not, see http://www.gnu.org/licenses/. require string.fs @@ -31,6 +30,7 @@ require string.fs : parse" ( -- addr u ) '" parse 2drop '" parse ; : .' '' parse postpone SLiteral postpone type ; immediate : s' '' parse postpone SLiteral ; immediate +: .upcase ( addr u -- ) bounds ?DO I c@ toupper emit LOOP ; \ character recoding @@ -42,7 +42,7 @@ require string.fs case '& of ." &" endof '< of ." <" endof -\ '¤ of ." €" endof +\ &164 of ." €" endof dup emit endcase LOOP ; @@ -67,7 +67,11 @@ s" " default-class $! : tagged ( addr1 u1 addr2 u2 -- ) 2dup 2>r tag .type 2r> /tag ; : opt ( addr u opt u -- ) s" " tag-option $+! - tag-option $+! s' ="' tag-option $+! tag-option $+! + tag-option $+! s' ="' tag-option $+! +\ BEGIN dup WHILE '& $split >r >r tag-option $+! r> r> +\ dup IF s" %26" tag-option $+! THEN +\ REPEAT 2drop + tag-option $+! s' "' tag-option $+! ; : n>string ( n -- addr u ) 0 <# #S #> ; : xy>string ( x y -- ) swap 0 <# #S 'x hold 2drop 0 #S 's hold #> ; @@ -254,7 +258,7 @@ Defer parse-line ELSE 2swap icon-tmp $! icon-prefix $@ icon-tmp $+! icon-tmp $+! icon-tmp $@ THEN dup >r '| -$split dup r> = IF 2swap THEN - dup IF 2swap alt= ELSE 2drop THEN + dup IF 2swap alt= ELSE 2drop s" " alt= THEN tag-class $@len >r over c@ >align tag-class $@len r> = 1+ /string tag-class $@len >r over c@ >border tag-class $@len r> = 1+ /string 2dup .img-size src= s" img" tag/ ; @@ -333,10 +337,15 @@ Variable expand-link Variable expand-prefix Variable expand-postfix -: ?expand ( addr u -- ) expand-link $! +: ?expand ( addr u -- addr u' ) expand-link $! do-expand @ IF expand-prefix $@ expand-link 0 $ins expand-postfix $@ expand-link $+! THEN + 0 >r + BEGIN expand-link $@ r@ /string WHILE + r> 1+ >r + c@ '& = IF s" amp;" expand-link r@ $ins THEN + REPEAT drop rdrop expand-link $@ ; : .link ( addr u -- ) dup >r '| -$split dup r> = IF 2swap THEN @@ -349,7 +358,7 @@ Variable expand-postfix \ line handling -: char? ( -- c ) >in @ char swap >in ! ; +: char? ( -- c ) >in @ char swap >in ! $FF umin ; : parse-tag ( addr u char -- ) >r r@ parse .type @@ -371,6 +380,7 @@ Create do-words $100 0 [DO] ' .text , [ : >tag '\ parse type '\ parse tag ; char>tag * b +char>tag / i char>tag _ em char>tag # code :noname '~ parse .type '~ parse .type ; '~ cells do-words + ! @@ -451,9 +461,10 @@ Create nav-buf 0 c, bounds ?DO I c@ dup 'A 'Z 1+ within IF bl + nav+ ELSE dup 'a 'z 1+ within IF nav+ - ELSE dup '0 '9 1+ within IF nav+ - ELSE dup bl = swap '- = or IF '- nav+ - THEN THEN THEN THEN + ELSE dup '0 '9 1+ within IF nav+ + ELSE dup bl = over '- = or IF '- nav+ + ELSE nav+ + THEN THEN THEN THEN LOOP ; : >nav ( addr u -- addr' u' ) nav-name $! create-navs @ 0= @@ -480,7 +491,7 @@ Variable toc-index true Value toc-image : .toc-entry ( toc flag -- ) - swap cell+ dup @ swap cell+ dup cell+ $@ 2dup href= + swap cell+ dup @ swap cell+ dup cell+ $@ 2dup ?expand href= '# scan 1 /string toc-name $@ compare >r $@ toc-image IF s" a" tag .img swap IF @@ -514,14 +525,14 @@ true Value toc-image 3 OF s" down" class= ENDOF ENDCASE THEN - s" a" tag parse-string s" a" /tag + s" a" tag parse-string s" a" /tag ." " THEN rdrop 1 toc-index +! toc-index @ /toc-line mod 0= IF -env cr s" p" >env THEN ; : print-toc ( -- ) toc-index off cr - toc-image IF s" img-menu" ELSE s" menu" THEN id= + toc-image IF s" img-menu" ELSE s" menu" THEN class= s" div" >env cr s" p" >env 0 parse dup 0= IF toc-name $! 0 ELSE @@ -553,9 +564,9 @@ Variable divs longtags set-current : --- 0 indent cr s" hr" tag/ cr ; -: * 1 indent s" h1" dclass= s" h1" par +indent s" " dclass= ; -: ** 1 indent s" h2" dclass= s" h2" par +indent s" " dclass= ; -: *** 2 indent s" h3" dclass= s" h3" par +indent s" " dclass= ; +: * 1 indent +indent s" h1" dclass= s" h1" par s" " dclass= ; +: ** 1 indent +indent s" h2" dclass= s" h2" par s" " dclass= ; +: *** 2 indent +indent s" h3" dclass= s" h3" par s" " dclass= ; : -- 0 indent cr print-toc ; : && 0 parse id= ; : - s" ul" env s" li" par ; @@ -569,8 +580,8 @@ longtags set-current : p<< s" p" >env ; : << +env ; : <* s" center" class= ; -: env s" #ff0000" s" color" opt s" font" >env parse-par ; -: red> -env -env ; +: env parse-par ; +: red> -env ; : >> -env ; : *> ; : :: interpret ; @@ -654,7 +665,10 @@ definitions \ HTML head Variable css-file +Variable print-file +Variable ie-css-file Variable content +Variable _charset Variable _lang Variable _favicon @@ -663,19 +677,32 @@ Variable _favicon : .css ( -- ) css-file @ IF css-file $@len IF s" StyleSheet" s" rel" opt - css-file $@ href= + css-file $@ href= s" screen" s" media" opt s" text/css" s" type" opt s" link" tag/ cr - THEN THEN ; + THEN THEN + ie-css-file @ IF + ." " cr + THEN ; +: .print ( -- ) + print-file @ IF print-file $@len IF + s" StyleSheet" s" rel" opt + print-file $@ href= s" print" s" media" opt + s" text/css" s" type" opt s" link" tag/ cr + THEN THEN ; : .title ( addr u -- ) 1 envs ! oldenv off + _charset $@ s" utf-8" str= 0= + IF .' ' cr THEN .' ' cr + .' PUBLIC "-//W3C//DTD XHTML 1.0 Strict//EN"' cr + .' "http://www.w3.org/TR/xhtml1/DTD/xhtml1-strict.dtd">' cr s" http://www.w3.org/1999/xhtml" s" xmlns" opt lang@ s" xml:lang" opt lang@ s" lang" opt s" html" >env cr s" head" >env cr s" Content-Type" s" http-equiv" opt content $@ s" content" opt - s" meta" tag/ cr .css + s" meta" tag/ cr .css .print _favicon @ IF s" shortcut icon" s" rel" opt _favicon $@ href= @@ -715,7 +742,7 @@ Variable orig-date : pgp-key ( -- ) bl sword -trailing public-key $! ; : charset ( -- ) s" text/xhtml; charset=" content $! - bl sword -trailing content $+! ; + bl sword -trailing 2dup content $+! _charset $! ; charset iso-8859-1 @@ -744,6 +771,8 @@ Variable style$ : vlink ( -- ) parse" s" vlink" style ; : marginheight ( -- ) parse" s" marginheight" style ; : css ( -- ) parse" css-file $! ; +: print-css ( -- ) parse" print-file $! ; +: ie-css ( -- ) parse" ie-css-file $! ; : wf ( -- ) outfile-id >r