Annotation of gforth/substitute.fs, revision 1.3

1.1       pazsan      1: \ substitute stuff
                      2: 
                      3: require string.fs
                      4: 
                      5: wordlist AConstant macros-wordlist
                      6: 
                      7: : macro: ( addr u -- ) Create here 0 , $! DOES> $@ ;
                      8: 
                      9: : replaces ( addr1 len1 addr2 len2 -- )
                     10:     \G create a macro with name @var{addr2 len2} and content @var{addr1 len1}.
                     11:     \G if the macro already exists, just change the content.
                     12:     2dup macros-wordlist search-wordlist
                     13:     IF  nip nip >body $!
                     14:     ELSE
                     15:        get-current >r macros-wordlist set-current
                     16:        ['] macro: execute-parsing
                     17:        r> set-current
                     18:     THEN ;
                     19: 
                     20: Variable macro$
                     21: 
                     22: : $substitute ( addr1 len1 -- addr2 len2 n )
                     23:     \G substitute all macros in text @var{addr1 len1}.
                     24:     \G @var{n} is the number of substitutions, @var{addr2 len2} the result.
                     25:     s" " macro$ $! 0 >r
                     26:     BEGIN  dup  WHILE  '%' $split
                     27:            2swap macro$ $+! dup IF
                     28:                over c@ '%' = IF
                     29:                    over dup 1+ over - macro$ $+! 1 /string
                     30:                ELSE
                     31:                    '%' $split 2swap dup 0= IF
                     32:                        2drop s" %" macro$ $+! r> 1+ >r
                     33:                    ELSE
1.2       pazsan     34:                        macros-wordlist search-wordlist  IF
                     35:                            -rot 2>r execute macro$ $+! 2r> r> 1+ >r
                     36:                        THEN
1.1       pazsan     37:                    THEN
                     38:                THEN
                     39:            THEN
                     40:     REPEAT  2drop macro$ $@ r> ;
                     41: 
                     42: : substitute ( addr1 len1 addr2 len2 -- addr2 len3 n )
                     43:     \G substitute all macros in text @var{addr1 len1}, and copy the
                     44:     \G result to @var{addr2 len2}.  @var{n} is the number of
                     45:     \G substitutions, @var{addr2 len3} the result.  If
                     46:     \G @var{len2}=@var{len3}, it is likely that the string did not fit.
1.3     ! pazsan     47:     2>r $substitute -rot
        !            48:     2r> rot umin 2dup 2>r move 2r> rot ;
1.1       pazsan     49: 
                     50: : unescapes ( addr1 u1 dest -- dest u2 )
                     51:     \G double all delimiters in @var{addr1 u1}, so that substitute
                     52:     \G will result in the original text.  Note that the buffer
                     53:     \G @var{dest} does not have a size, as in worst case, it will need
                     54:     \G just twice as many characters as @var{u1}. @{dest u2} is the
                     55:     \G resulting string.
                     56:     dp @ >r dup >r dp !
                     57:     bounds ?DO
                     58:        I c@ dup '%' = IF  dup c,  THEN  c,
                     59:     LOOP  r> here over -  r> dp ! ;

FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>