Patch title: Release 94 bulk changes
Abstract:
File: /pliant/language/type/text/str.pli
Key:
    Removed line
    Added line
   
# Copyright  Hubert Tonneau  hubert.tonneau@pliant.cx
#
# This program is free software; you can redistribute it and
# modify it under the terms of the GNU General Public Licens
# as published by the Free Software Foundation.
#
# This program is distributed in the hope that it will be us
# but WITHOUT ANY WARRANTY; without even the implied warrant
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See 
# GNU General Public License for more details.
#
# You should have received a copy of the GNU General Public 
# version 2 along with this program; if not, write to the Fr
# Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 


# Copyright  Hubert Tonneau  hubert.tonneau@pliant.cx
#
# This program is free software; you can redistribute it and
# modify it under the terms of the GNU General Public Licens
# as published by the Free Software Foundation.
#
# This program is distributed in the hope that it will be us
# but WITHOUT ANY WARRANTY; without even the implied warrant
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See 
# GNU General Public License for more details.
#
# You should have received a copy of the GNU General Public 
# version 2 along with this program; if not, write to the Fr
# Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 


public
  constant default_charset_is_utf8 false



function '+=' s e
  arg_rw Str s ; arg Str e
  strong_definition
  # this is speedup only function
  s resize s:len+e:len
  memory_copy e:characters (s:characters translate Char s:le



method data 'to string' options -> string
  arg Str data ; arg Str options ; arg Str string
function '+=' s e
  arg_rw Str s ; arg Str e
  strong_definition
  # this is speedup only function
  s resize s:len+e:len
  memory_copy e:characters (s:characters translate Char s:le



method data 'to string' options -> string
  arg Str data ; arg Str options ; arg Str string
  if options="raw" or options="db"
  if options="raw" or options="db" or options="con"
    string := data
  else
    string := "[dq]"+data+"[dq]"
    var Int i := 1
    while i<string:len-1
      var Int ch := string:i number
      if string_encoding:ch<>null
        var Pointer:Str e :> string_encoding:ch map Str
        string := (string 0 i)+e+(string i+1 string:len)
        i := i+e:len
      else
        i := i+1


method data 'from string' string options may_skip skiped off
  arg_w Str data ; arg Str string options ; arg CBool may_sk
    string := data
  else
    string := "[dq]"+data+"[dq]"
    var Int i := 1
    while i<string:len-1
      var Int ch := string:i number
      if string_encoding:ch<>null
        var Pointer:Str e :> string_encoding:ch map Str
        string := (string 0 i)+e+(string i+1 string:len)
        i := i+e:len
      else
        i := i+1


method data 'from string' string options may_skip skiped off
  arg_w Str data ; arg Str string options ; arg CBool may_sk
  if options="raw" or options="db"
  if options="raw" or options="db" or options="con"
    data := string
    skiped := 0
    offset := string len
    return success
  var Int stop := string:len-1
  if not may_skip and stop<>(-1)
    stop := 0
  for (var Int i) 0 stop
    var Int ci := string:i number
    if ci="[dq]":0:number
      skiped := i
      var Address cursor := string:characters translate Char
      var Int remain := string:len-(i+1)
      var Address dq := memory_search cursor remain "[dq]":c
      var Address lb := memory_search cursor remain "[lb]":c
      if dq<>null and (lb=null or dq<lb)
        # the string to decode does not contain any [ charac
        var Int l := (cast dq Int).-.(cast cursor Int)
        if (memory_search cursor l "[rb]":characters 1)=null
          data set (memory_allocate l addressof:data) l true
          memory_copy cursor data:characters l
          offset := (cast dq Int) .+. 1 .-. (cast string:cha
          return success
        else
          # the string contains an unmatched ] character
          return failure
      var Address buf := memory_allocate remain null
      var Address b := buf
      var CBool ok := true
      while ok
        var Int remain := (cast string:characters Int).+.str
        var Address dq := memory_search cursor remain "[dq]"
        if dq=null
          # no " character: this is not a valid string
          ok := false
        else
          var Address lb := memory_search cursor remain "[lb
          if lb=null or dq<lb
            # no more [ character
            var Int n := (cast dq Int).-.(cast cursor Int)
            if (memory_search cursor n "[rb]":characters 1)=
              # store the remaining not encoded characters a
              memory_copy cursor b n ; b := b translate Char
              var Int l := (cast b Int).-.(cast buf Int)
              data set (memory_allocate l addressof:data) l 
              memory_copy buf data:characters l
              memory_free buf
              offset := (cast dq Int) .+. 1 .-. (cast string
              return success
            else
              # the string contains an unmatched ] character
              ok := false
          else
            var Int n := (cast lb Int).-.(cast cursor Int)
            if (memory_search cursor n "[rb]":characters 1)=
              # stores the charcters before the first [ : th
              memory_copy cursor b n ; b := b translate Char
              var Address rb := memory_search (lb translate 
              if rb<>null
                (var Str sub) set lb (cast rb Int).-.(cast l
                # 'sub' is the encoded character
                var Pointer:Char ch :> (string_decoding firs
                var Char c
                if addressof:ch<>null
                  # we found it in the encoding dictionary
                  c := ch
                else
                  c := sub 1
                  if c:number>="0":0:number and c:number<="9
                    # we are looking for an integer between 
                    var Int n := 0
                    for (var Int j) 1 sub:len-2
                      c := sub:j
                      if c:number>="0":0:number and c:number
                        n := n*10+c:number-"0":0:number
                      else
                        ok := false
                    if n<256
                      c := character n
                    else
                      ok := false
                  eif sub:len=3 and not (c:number>="a":0:num
                    # we have a single character in the midd
                    void
                  else
                    # this is an unsupported encoding
                    ok := false
                b map Char := c
                b := b translate Char 1
                cursor := lb translate Char sub:len
              else
                # unmatched [ character
                ok := false
            else
              # unmatched ] character
              ok := false
      # if we get there, then ok=false, so free the temporar
      memory_free buf
      data := ""
      return failure
  data := ""
  status := failure



export string
    data := string
    skiped := 0
    offset := string len
    return success
  var Int stop := string:len-1
  if not may_skip and stop<>(-1)
    stop := 0
  for (var Int i) 0 stop
    var Int ci := string:i number
    if ci="[dq]":0:number
      skiped := i
      var Address cursor := string:characters translate Char
      var Int remain := string:len-(i+1)
      var Address dq := memory_search cursor remain "[dq]":c
      var Address lb := memory_search cursor remain "[lb]":c
      if dq<>null and (lb=null or dq<lb)
        # the string to decode does not contain any [ charac
        var Int l := (cast dq Int).-.(cast cursor Int)
        if (memory_search cursor l "[rb]":characters 1)=null
          data set (memory_allocate l addressof:data) l true
          memory_copy cursor data:characters l
          offset := (cast dq Int) .+. 1 .-. (cast string:cha
          return success
        else
          # the string contains an unmatched ] character
          return failure
      var Address buf := memory_allocate remain null
      var Address b := buf
      var CBool ok := true
      while ok
        var Int remain := (cast string:characters Int).+.str
        var Address dq := memory_search cursor remain "[dq]"
        if dq=null
          # no " character: this is not a valid string
          ok := false
        else
          var Address lb := memory_search cursor remain "[lb
          if lb=null or dq<lb
            # no more [ character
            var Int n := (cast dq Int).-.(cast cursor Int)
            if (memory_search cursor n "[rb]":characters 1)=
              # store the remaining not encoded characters a
              memory_copy cursor b n ; b := b translate Char
              var Int l := (cast b Int).-.(cast buf Int)
              data set (memory_allocate l addressof:data) l 
              memory_copy buf data:characters l
              memory_free buf
              offset := (cast dq Int) .+. 1 .-. (cast string
              return success
            else
              # the string contains an unmatched ] character
              ok := false
          else
            var Int n := (cast lb Int).-.(cast cursor Int)
            if (memory_search cursor n "[rb]":characters 1)=
              # stores the charcters before the first [ : th
              memory_copy cursor b n ; b := b translate Char
              var Address rb := memory_search (lb translate 
              if rb<>null
                (var Str sub) set lb (cast rb Int).-.(cast l
                # 'sub' is the encoded character
                var Pointer:Char ch :> (string_decoding firs
                var Char c
                if addressof:ch<>null
                  # we found it in the encoding dictionary
                  c := ch
                else
                  c := sub 1
                  if c:number>="0":0:number and c:number<="9
                    # we are looking for an integer between 
                    var Int n := 0
                    for (var Int j) 1 sub:len-2
                      c := sub:j
                      if c:number>="0":0:number and c:number
                        n := n*10+c:number-"0":0:number
                      else
                        ok := false
                    if n<256
                      c := character n
                    else
                      ok := false
                  eif sub:len=3 and not (c:number>="a":0:num
                    # we have a single character in the midd
                    void
                  else
                    # this is an unsupported encoding
                    ok := false
                b map Char := c
                b := b translate Char 1
                cursor := lb translate Char sub:len
              else
                # unmatched [ character
                ok := false
            else
              # unmatched ] character
              ok := false
      # if we get there, then ok=false, so free the temporar
      memory_free buf
      data := ""
      return failure
  data := ""
  status := failure



export string