[Win32forth-cvs] win32forth/src Est.f,NONE,1.1

[Jos v.d.V. <jo...@us...>]

Update of /cvsroot/win32forth/win32forth/src
In directory sfp-cvs-1.v30.ch3.sourceforge.com:/tmp/cvs-serv13562

Added Files:
	Est.f 
Log Message:
Jos: Needed for Forth 2012

--- NEW FILE: Est.f ---
anew -Est.f \ Ported from ffl ( est.fs )
\ ==============================================================================
\
\           est - the string with escaped characters in the ffl
\
\               Copyright (C) 2007  Dick van Oudheusden
\
\ This library is free software; you can redistribute it and/or
\ modify it under the terms of the GNU Lesser General Public
\ License as published by the Free Software Foundation; either
\ version 3 of the License, or (at your option) any later version.
\
\ This library is distributed in the hope that it will be useful,
\ but WITHOUT ANY WARRANTY; without even the implied warranty of
\ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
\ Lesser General Public License for more details.
\
\ You should have received a copy of the GNU Lesser General Public
\ License along with this library; if not, write to the Free
\ Software Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
\
\ ==============================================================================
\
\  $Date: 2016/02/03 18:35:22 $ $Revision: 1.1 $
\
\ ==============================================================================
((

\ include ffl/config.fs
\ *D doc\
\ *S Abstract

\ *T Est -- String with escaped characters.

\ *P Est.f implements a string with escaped characters. The code is
\ ** inspired by the proposal for escaped strings by Stephen Pelc and Peter
\ ** Knaggs. The following conversion characters are translated:
\ *+
\a  - bel = ascii 7
\b  - backspace = ascii 8
\e  - escape = ascii 27
\f  - formfeed = ascii 12
\l  - linefeed = ascii 10
\m  - cr/lf = ascii 13,10
\n  - new line
\q  - quote = ascii 34
\r  - cr = ascii 13
\t  - ht = ascii 9
\v  - vt = ascii 11
\z  - nul = ascii 0
\"  - quote = ascii 34
xhh - hex digit
\\  - backslash
\ *- ))

\ February 3rd, 2016 Jos:
\ Uses crlf$ instead of end-of-line
\ Added .\"
\ Dexed it.

1 constant est.version


( Private words )

create est-table
       7 c,     \ a
       8 c,     \ b
  char c c,     \ c
  char d c,     \ d
      27 c,     \ e
      12 c,     \ f
  char g c,     \ g
  char h c,     \ h
  char i c,     \ i
  char j c,     \ j
  char k c,     \ k
      10 c,     \ l
  char m c,     \ m
      10 c,     \ n
  char o c,     \ o
  char p c,     \ p
  char " c,     \ q
      13 c,     \ r
  char s c,     \ s
       9 c,     \ t
  char u c,     \ u
      11 c,     \ v
  char w c,     \ w
  char x c,     \ x
  char y c,     \ y
       0 c,     \ z


: est-add-char   ( char c-addr -- )
\ *G Add the char to the counted string
  tuck count + c!
  dup c@ 1+ swap c!
;


: est-add-2hex  ( c-addr1 u1 c-addr2 -- c-addr3 u3 )
\ *G Read a two hex digit from string c-addr1 u1,
\ ** convert it to a character and store it in c-addr2
\ ** and return the string after the two digits
  base @ >r                  \ Save current base
  >r
  hex
  0 0 2over 2 min            \ Maximum convert 2 hex digits
  >r
  r@ >number
  nip nip                    \ No interest in start of string and most significant cell
  r> swap -                  \ Get converted length
  swap r> est-add-char       \ Add result in string
  /string                    \ Update source string
  r> base !
;


[UNDEFINED] place [IF]
: place   ( c-addr1 u1 c-addr2 -- = Place string c-addr1 u1 at address c-addr2 as counted string )
  2dup c!
  char+ swap cmove
;
[THEN]


( String words )

[UNDEFINED] parse-esc [IF]
: parse-esc   ( c-addr1 u1 c-addr2 -- c-addr3 u3 )
\ *G Parse the escaped character in string c-addr1 u1,
\ ** store the result in string c-addr2 and return the remaining string c-addr3 u3
   over 0<> IF
    >r
    over c@
    dup [char] x = IF
      drop
      1 /string r@ est-add-2hex
    ELSE
      dup [char] m = IF
        drop
        13 r@ est-add-char
        10 r@ est-add-char
      ELSE
        dup [char] n = IF
          drop
          ( end-of-line ) crlf$ count tuck r@ count + swap cmove r@ c@ + r@ c!
        ELSE
          dup [char] a [char] z 1+ within IF
            [char] a - chars est-table + c@
          THEN
          r@ est-add-char
        THEN
      THEN
      1 /string
    THEN
    rdrop
  ELSE
    drop
  THEN
;
[THEN]


[UNDEFINED] parse\" [DEFINED] overrule:parse\" OR [IF]
: parse\"   ( "ccc<quote>" -- c-addr u )
\ *G Parse the input stream for a escaped string
   source >in @ /string tuck
  pad >r
  0 r@ c!                    \ Length destination = 0
  BEGIN
    dup IF
      over c@ [char] " <>
    ELSE
      false
    THEN
  WHILE
    over c@ dup [char] \ = IF
      drop
      1 /string r@ parse-esc
    ELSE
      r@ est-add-char
      1 /string
    THEN
  REPEAT
  nip
  dup IF 1- THEN            \ Skip "
  - >in +!                  \ Store processed chars
  r> count                  \ Parsed string
  ;
[THEN]


[UNDEFINED] s\" [IF]
: s\"   ( "ccc<quote>" -- c-addr u )
\ *G Create a string with escaped characters
   parse\" state @ IF
    postpone sliteral
  ELSE
    dup chars allocate throw swap 2>r 2r@ cmove 2r>
  THEN
; immediate
[THEN]


[UNDEFINED] ,\" [IF]
: ,\"   ( "ccc<quote>" -- )
\ *G Store a string with escaped characters in the dictionary
  parse\"
  here
  over char+ allot
  place align
;
 [THEN]

[UNDEFINED] .\" [IF]
: .\"   ( "ccc<quote>" -- )
\ *G Store a string with escaped characters in a definition
  parse\"  postpone sliteral ; immediate
 [THEN]


\s
\ *G Eg:
cr
\ *+
          s\" \nab\mdef\x40\u8c5e\x41\\\z"         type
: y ( - ) .\" \nab\mdef\x40\u8c5e\x41\\\z"         type ; y
create m  ,\" \nab\mdef\x40\u8c5e\x41\\\z" m count type

\s Output:
ab
def@u8c5eA\
ab
def@u8c5eA\
ab
def@u8c5eA\
\ *-

\ *Z