Patch title: Release 90 bulk changes
Abstract:
File: /graphic/browser/xml/parser.pli
Key:
    Removed line
    Added line
   
module "/pliant/language/compiler.pli"
module "/pliant/language/stream.pli"



gvar (Array uInt8 256) tag_end
reset tag_end
tag_end ">":number := 1
tag_end " ":number := 1
tag_end "[tab]":number := 1
tag_end "[cr]":number := 1
tag_end "[lf]":number := 1
 
gvar (Array uInt8 256) attr_end
reset attr_end
attr_end "=":number := 1
attr_end ">":number := 1
 
gvar (Array uInt8 256) value_end
reset value_end
value_end "[dq]":0:number := 1
value_end ">":number := 1
 
gvar (Array uInt8 256) direct_end
reset direct_end
direct_end " ":number := 1
direct_end "[tab]":number := 1
module "/pliant/language/compiler.pli"
module "/pliant/language/stream.pli"



gvar (Array uInt8 256) tag_end
reset tag_end
tag_end ">":number := 1
tag_end " ":number := 1
tag_end "[tab]":number := 1
tag_end "[cr]":number := 1
tag_end "[lf]":number := 1
 
gvar (Array uInt8 256) attr_end
reset attr_end
attr_end "=":number := 1
attr_end ">":number := 1
 
gvar (Array uInt8 256) value_end
reset value_end
value_end "[dq]":0:number := 1
value_end ">":number := 1
 
gvar (Array uInt8 256) direct_end
reset direct_end
direct_end " ":number := 1
direct_end "[tab]":number := 1
direct_end "[cr]":number := 1
direct_end "[lf]":number := 1
direct_end ",":number := 1
direct_end ";":number := 1
direct_end ">":number := 1
 


method parser parse s root
  oarg_rw XmlParser parser ; arg_rw Stream s ; arg Address r
  var List:XmlLevel stack
  var List:Arrow root_pending ; var (Pointer List:Arrow) pen
  var (Array Char buffer_len) buf1 buf2 buf3
  part scan
    if s:atend
      leave scan
    s scan tag_begin buf1 (var Str txt)
    if txt<>""
      parser new_text txt (var Arrow node) ; pending += node
    if s:atend
      leave scan
    s forward
    if s:character="/"
      s forward
      s scan tag_end buf1 (var Str tag)
      s forward
      var Pointer:XmlLevel l :> stack last
      while exists:l
        if l:tag=tag
          var Address n := l node
          while exists:l
            var Pointer:Arrow p :> l:pending first
            while exists:p
              parser bind p n
              p :> l:pending remove p
            l :> stack remove l
          if (exists stack:last)
            pending :> stack:last pending
          else
            pending :> root_pending
        else
          l :> stack previous l
    else
      s scan tag_end buf1 (var Str tag)
      parser new_tag tag (var Arrow node) ; pending += node
      part scan_attr
direct_end ",":number := 1
direct_end ";":number := 1
direct_end ">":number := 1
 


method parser parse s root
  oarg_rw XmlParser parser ; arg_rw Stream s ; arg Address r
  var List:XmlLevel stack
  var List:Arrow root_pending ; var (Pointer List:Arrow) pen
  var (Array Char buffer_len) buf1 buf2 buf3
  part scan
    if s:atend
      leave scan
    s scan tag_begin buf1 (var Str txt)
    if txt<>""
      parser new_text txt (var Arrow node) ; pending += node
    if s:atend
      leave scan
    s forward
    if s:character="/"
      s forward
      s scan tag_end buf1 (var Str tag)
      s forward
      var Pointer:XmlLevel l :> stack last
      while exists:l
        if l:tag=tag
          var Address n := l node
          while exists:l
            var Pointer:Arrow p :> l:pending first
            while exists:p
              parser bind p n
              p :> l:pending remove p
            l :> stack remove l
          if (exists stack:last)
            pending :> stack:last pending
          else
            pending :> root_pending
        else
          l :> stack previous l
    else
      s scan tag_end buf1 (var Str tag)
      parser new_tag tag (var Arrow node) ; pending += node
      part scan_attr
        while not s:atend and { var Char ch := s character ;
        while not s:atend and { var Char ch := s character ; ch=" " or ch="[tab]" or ch="," or ch=";" or ch="[cr]" or ch="[lf]" }
          s forward
        s scan attr_end buf2 (var Str attr)
        if s:character="="
          s forward
        else 
          leave scan_attr
          s forward
        s scan attr_end buf2 (var Str attr)
        if s:character="="
          s forward
        else 
          leave scan_attr
        while not s:atend and { ch := s character ; ch=" " o
        while not s:atend and { ch := s character ; ch=" " or ch="[tab]" or ch="[cr]" or ch="[lf]" }
          s forward
        var Str value
        if ch="[dq]"
          s forward
          s scan value_end buf3 value
          if s:character="[dq]"
            s forward
        else
          s scan direct_end buf3 value
        parser set_tag_attribute node attr value
        if s:character<>">"
          restart scan_attr
      while not s:atend and { ch := s character ; s forward 
        void
      if not (parser is_raw_tag tag)
        var XmlLevel level ; level tag := tag ; level node :
        stack += level
        pending :> stack:last pending
      else
        var Str txt := ""
        while not s:atend and { var Str line := s readline ;
          txt += line+"[lf]"
        parser new_text txt (var Arrow node)
    if not s:atend and s:character="[cr]"
      s forward
    if not s:atend and s:character="[lf]"
      s forward
    restart scan
  var Pointer:Arrow p :> root_pending first
  while exists:p
    parser bind p root
    p :> root_pending remove p
          s forward
        var Str value
        if ch="[dq]"
          s forward
          s scan value_end buf3 value
          if s:character="[dq]"
            s forward
        else
          s scan direct_end buf3 value
        parser set_tag_attribute node attr value
        if s:character<>">"
          restart scan_attr
      while not s:atend and { ch := s character ; s forward 
        void
      if not (parser is_raw_tag tag)
        var XmlLevel level ; level tag := tag ; level node :
        stack += level
        pending :> stack:last pending
      else
        var Str txt := ""
        while not s:atend and { var Str line := s readline ;
          txt += line+"[lf]"
        parser new_text txt (var Arrow node)
    if not s:atend and s:character="[cr]"
      s forward
    if not s:atend and s:character="[lf]"
      s forward
    restart scan
  var Pointer:Arrow p :> root_pending first
  while exists:p
    parser bind p root
    p :> root_pending remove p
  var Pointer:XmlLevel l :> stack last
  var Pointer:XmlLevel l :> stack first
  while exists:l
    var Pointer:Arrow p :> l:pending first
    while exists:p
      parser bind p root
      p :> l:pending remove p
    l :> stack next l

export '. parse'
  while exists:l
    var Pointer:Arrow p :> l:pending first
    while exists:p
      parser bind p root
      p :> l:pending remove p
    l :> stack next l

export '. parse'