[gforth] / gforth / wf.fs  

gforth: gforth/wf.fs

Diff for /gforth/wf.fs between version 1.33 and 1.34

version 1.33, Sat Jan 22 16:39:58 2005 UTC version 1.34, Wed Mar 30 21:57:12 2005 UTC
Line 42 
Line 42 
         case          case
             '& of  ." &"  endof              '& of  ." &"  endof
             '< of  ." &lt;"   endof              '< of  ." &lt;"   endof
               '¤ of  ." &euro;" endof
             dup emit              dup emit
         endcase          endcase
     LOOP ;      LOOP ;
Line 92 
Line 93 
   
 : env$ ( -- addr ) envs dup @ 1+ cells + ;  : env$ ( -- addr ) envs dup @ 1+ cells + ;
 : env ( addr u -- ) env$ $! ;  : env ( addr u -- ) env$ $! ;
 : env? ( -- ) envs @ oldenv @  : env? ( -- ) envs @ oldenv @ over oldenv !
     2dup > IF  env$ $@ tag  THEN      2dup > IF  env$ $@ tag  THEN
     2dup < IF  env$ cell+ $@ /tag  env$ cell+ $off  THEN      2dup < IF  env$ cell+ $@ /tag  env$ cell+ $off  THEN
     drop oldenv ! ;      2drop ;
 : +env  1 envs +! ;  : +env  1 envs +! ;
 : -env end-sec @ envs @ 2 > or  IF  -1 envs +! env?  THEN ;  : -env end-sec @ envs @ 1 > or  IF  -1 envs +! env?  THEN ;
 : -envs envs @ 0 ?DO  -env cr  LOOP ;  : -envs envs @ 0 ?DO  -env cr  LOOP ;
   : -tenvs envs @ 1 ?DO  -env cr  LOOP ;
 : >env ( addr u -- ) +env env env? ;  : >env ( addr u -- ) +env env env? ;
   
 \ alignment  \ alignment
Line 182 
Line 184 
   f$ dup >r 0<=    f$ dup >r 0<=
   IF    '0 emit    IF    '0 emit
   ELSE  scratch r@ min type  r@ precision - zeros  THEN    ELSE  scratch r@ min type  r@ precision - zeros  THEN
   '. emit r@ negate zeros    r@ negate zeros
   scratch r> 0 max /string 0 max -zeros type ;    scratch r> 0 max /string 0 max -zeros
     dup IF  '. emit  THEN  type ;
   
 : size-does> ( -- )  DOES> ( -- )  : size-does> ( -- )  DOES> ( -- )
     ." img." dup body> >name .name      ." img." dup body> >name .name
Line 488 
Line 491 
     1 toc-index +! toc-index @ /toc-line mod 0=      1 toc-index +! toc-index @ /toc-line mod 0=
     IF  s" br" tag/ THEN ;      IF  s" br" tag/ THEN ;
   
 : print-toc ( -- ) toc-index off cr s" menu" id= s" div" >env cr  : print-toc ( -- ) toc-index off cr s" menu" class= s" div" >env cr
     0 parse      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
Line 530 
Line 533 
 : :   s" dl" env s" dd" par ;  : :   s" dl" env s" dd" par ;
 : -<< s" ul" env env? s" li" >env ;  : -<< s" ul" env env? s" li" >env ;
 : +<< s" ol" env env? s" li" >env ;  : +<< s" ol" env env? s" li" >env ;
 : ?<< s" dl" env env? s" dt" >env ;  \ : ?<< s" dl" env env? s" dt" >env ; \ not allowed
 : :<< s" dl" env env? s" dd" >env ;  : :<< s" dl" env env? s" dd" >env ;
 : p<< s" p" >env ;  : p<< s" p" >env ;
 : <<  +env ;  : <<  +env ;
 : <*  s" center" class= ;  : <*  s" center" class= ;
 : <red  s" #ff0000" s" color" opt s" font" >env ;  : <red  s" p" >env s" #ff0000" s" color" opt s" font" >env parse-par ;
 : red> -env ;  : red> -env -env ;
 : >>  -env ;  : >>  -env ;
 : *> ;  : *> ;
 : ::  interpret ;  : ::  interpret ;
 : .   end-sec on 0 indent ;  : .   end-sec on 0 indent ;
 : :code s" pre" >env  : :code 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 s" pre" >env  : :code-file s" pre" >env
Line 615 
Line 618 
     ELSE  source nip IF  >in off s" p" par  THEN  THEN ;      ELSE  source nip IF  >in off s" p" par  THEN  THEN ;
 : parse-section ( -- )  end-sec off  : parse-section ( -- )  end-sec off
     BEGIN  refill  WHILE      BEGIN  refill  WHILE
         section-par end-sec @  UNTIL  THEN ;          section-par end-sec @  UNTIL  THEN  end-sec off ;
   
 \ HTML head  \ HTML head
   
 Variable css-file  Variable css-file
   Variable content
   Variable lang
   
 : .title ( addr u -- )  : lang@  ( -- addr u )
     .' <!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Transitional//en" "http://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd">' cr      lang @ IF  lang $@  ELSE  s" en"  THEN ;
     s" html" >env s" head" >env cr  : .css ( -- )
     s" Content-Type" s" http-equiv" opt  
     s" text/xhtml; charset=iso-8859-1" s" content" opt  
     s" meta" tag/  
     css-file @ IF  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/ cr
     THEN  THEN          THEN  THEN ;
   : .title ( addr u -- )  1 envs ! oldenv off
       .' <!DOCTYPE html' cr
       .'   PUBLIC "-//W3C//DTD XHTML 1.0 Transitional//EN"' cr
       .'   "http://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.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" title" tagged cr      s" title" tagged cr
     -env ;      -env ;
   
Line 665 
Line 677 
     '< sword -trailing mail-name $! '> sword mail $! ;      '< sword -trailing mail-name $! '> sword mail $! ;
 : pgp-key ( -- )  : pgp-key ( -- )
     bl sword -trailing public-key $! ;      bl sword -trailing public-key $! ;
   : charset ( -- )  s" text/xhtml; charset=" content $!
       bl sword -trailing content $+! ;
   
   charset iso-8859-1
   
 : created ( -- )  : created ( -- )
     bl sword orig-date $! ;      bl sword orig-date $! ;
 : icons  : icons
     bl sword icon-prefix $! ;      bl sword icon-prefix $! ;
   : lang
       bl sword lang $! ;
 : expands '# sword expand-prefix $! bl sword expand-postfix $! ;  : expands '# sword expand-prefix $! bl sword expand-postfix $! ;
   
 icons icons  icons icons
Line 701 
Line 720 
   s" wf-temp.wf" r/w create-file throw >r    s" wf-temp.wf" r/w create-file throw >r
   r@ write-file r> close-file throw    r@ write-file r> close-file throw
   push-file s" wf-temp.wf" r/o open-file throw loadfile !    push-file s" wf-temp.wf" r/o open-file throw loadfile !
   parse-par parse-section    parse-par -env parse-section
   loadfile @ close-file swap 2dup or    loadfile @ close-file swap 2dup or
   pop-file  drop throw throw    pop-file  drop throw throw
   s" wf-temp.wf" delete-file throw ;    s" wf-temp.wf" delete-file throw ;
Line 744 
Line 763 
   
 : db-par ( -- )  LT postpone p<< postpone >r  : db-par ( -- )  LT postpone p<< postpone >r
     BEGIN  db-line refill  WHILE  next-char '. = UNTIL  1 >in +!  THEN      BEGIN  db-line refill  WHILE  next-char '. = UNTIL  1 >in +!  THEN
     postpone rdrop LT postpone >> ; immediate      postpone rdrop ( LT postpone >> ) ; immediate

Generate output suitable for use with a patch program
Legend:
Removed from v.1.33  
changed lines
  Added in v.1.34
CVS Admin

Powered by ViewCVS 1.0-dev 		(Powered by ViewCVS)

ViewCVS and CVS Help