--- gforth/wf.fs 2005/06/05 22:11:09 1.36 +++ gforth/wf.fs 2006/08/26 12:39:57 1.47 @@ -1,6 +1,6 @@ \ wiki forth -\ Copyright (C) 2003,2004 Free Software Foundation, Inc. +\ Copyright (C) 2003,2004,2005 Free Software Foundation, Inc. \ This file is part of Gforth. @@ -31,6 +31,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 +43,7 @@ require string.fs case '& of ." &" endof '< of ." <" endof - '¤ of ." €" endof +\ &164 of ." €" endof dup emit endcase LOOP ; @@ -67,7 +68,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 #> ; @@ -192,11 +197,14 @@ Create jfif $FF c, $D8 c, $FF c, $E0 c scratch r> 0 max /string 0 max -zeros dup IF '. emit THEN type ; +12.9e FConstant pixels +FVariable factor 1e factor f! + : size-does> ( -- ) DOES> ( -- ) ." img." dup body> >name .name 2@ ." { width: " - s>d d>f 13.8e f/ f.size ." em; height: " - s>d d>f 13.8e f/ f.size ." em; }" cr ; + s>d d>f pixels f/ f.size ." em; height: " + s>d d>f pixels f/ f.size ." em; }" cr ; : size-css ( file< > -- ) outfile-id >r @@ -214,7 +222,10 @@ Create jfif $FF c, $D8 c, $FF c, $E0 c 2dup img-sizes search-wordlist IF drop 2drop ELSE get-current >r img-sizes set-current - nextname Create 2dup , , size-does> + nextname Create 2dup + s>d d>f factor f@ f* f>d d>s , + s>d d>f factor f@ f* f>d d>s , + size-does> r> set-current THEN ; @@ -508,7 +519,7 @@ true Value toc-image 3 OF s" down" class= ENDOF ENDCASE THEN - s" a" tagged + s" a" tag parse-string s" a" /tag THEN rdrop 1 toc-index +! toc-index @ /toc-line mod 0= @@ -648,18 +659,35 @@ definitions \ HTML head Variable css-file +Variable print-file +Variable ie-css-file Variable content -Variable lang +Variable _charset +Variable _lang +Variable _favicon : lang@ ( -- addr u ) - lang @ IF lang $@ ELSE s" en" THEN ; + _lang @ IF _lang $@ ELSE s" en" THEN ; : .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 @@ -668,7 +696,12 @@ Variable lang 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= + s" image/x-icon" s" type" opt + s" link" tag/ cr THEN s" title" tagged cr -env ; @@ -703,7 +736,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 @@ -712,7 +745,9 @@ charset iso-8859-1 : icons bl sword icon-prefix $! ; : lang - bl sword lang $! ; + bl sword _lang $! ; +: favicon + bl sword _favicon $! ; : expands '# sword expand-prefix $! bl sword expand-postfix $! ; icons icons @@ -730,6 +765,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