Annotation of gforth/substitute.fs, revision 1.1
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
! 34: 2dup macros-wordlist search-wordlist IF
! 35: execute 2swap 2drop r> 1+ >r macro$ $+!
! 36: ELSE 2drop THEN
! 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.
! 47: 2swap $substitute >r
! 48: 2swap rot umin 2dup >r >r move r> r> r> ;
! 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>