Patch title: Release 89 bulk changes
Abstract:
File: /graphic/browser/xml/context.pli
Key:
    Removed line
    Added line
module "/pliant/language/unsafe.pli"
module "tree.pli"

type XmlArea
  field Float x0 y0 x1 y1

type XmlContext
  # attributes forwarding
  field (Dictionary Str Str) values
  field (List List:Str) stack
  # space
  field Float x0 y0 x1 y1
  field List:XmlArea areas
  # current line
  field Float line_y0 line_x line_y
  field (List Pointer:XmlTree) line_content


#-----------------------------------------------------------------------------


method c mark
  arg_rw XmlContext c
  c stack += var List:Str empty_list

method c set tag attr value
  arg_rw XmlContext c ; arg Str tag attr value
  c:values insert tag+" "+attr value
  var (Pointer List:Str) l :> c:stack last
  l += attr+" "+value

method c query tag attr -> value
  arg_rw XmlContext c ; arg Str tag attr value
  var Pointer:Str p :> c:values first tag+" "+attr
  if exists:p
    value := p
  else
    value := ""

method c rewind
  arg_rw XmlContext c
  var (Pointer List:Str) l :> c:stack last
  var Pointer:Str p :> l last
  while exists:p
    c:values remove (c:values first p)
    p :> l previous p
  c:stack remove l


#-----------------------------------------------------------------------------


method c newline
  arg_rw XmlContext c
  c line_y0 := c y0
  c line_x := c x0 ; c line_y := c y0
  c line_content := var (List Pointer:XmlTree) empty_list

method c addtoline t
  arg_rw XmlContext c ; arg_rw XmlTree t
  # vcenter is not covered yet
  if c:line_x+t:x1-t:x0>c:x1 and c:line_x<>c:x0
    c newline
  var Float move_y := (-t:y0)-(c:line_y-c:line_y0)
  if move_y>0
    each lc c:line_content
      lc y0 += move_y
      lc y1 += move_y
    c line_y += move_y
    c y0 += move_y
  var Float move_y := t:y1-(c:y0-c:line_y)
  if move_y>0
    c y0 += move_y
    # might need to switch to next area
  t x0 += c line_x ; t y0 += c line_y
  t x1 += c line_x ; t y1 += c line_y
  var Pointer:XmlTree p :> t ; c line_content += p
  c line_x += t:x1-t:x0


method c newarea
  arg_rw XmlContext c
  var Pointer:XmlArea a :> c:areas first
  c x0 := a x0 ; c y0 := a y0 ; c x1 := a x1 ; c y1 := a y1
  c:areas remove a
  c newline


#-----------------------------------------------------------------------------


if false
method t position_undefined c
  arg_rw XmlTree t ; arg_rw XmlContext c
  each sub t
    sub position c

  method t position_undefined c
    arg_rw XmlTree t ; arg_rw D2Context c
    b x0 := undefined
    b y0 := undefined
    b x1 := undefined
    b y1 := undefined
    var Pointer:(List Link:D2Box) l :> b list
    if exists:l
      each bb l
        bb position c
if false
  
  method b position_container c
    oarg_rw D2Box b ; arg_rw D2Context c
    function position_include b c
      oarg_rw D2Box b ; arg_rw D2Box c
      if b:x0=defined
        c x0 := min c:x0 b:x0
        c y0 := min c:y0 b:y0
        c x1 := max c:x1 b:x1
        c y1 := max c:y1 b:y1
      else
        var Pointer:(List Link:D2Box) l :> b list
        if exists:l
          each bb l
            position_include bb c
    b x0 := float_max
    b y0 := float_max
    b x1 := float_min
    b y1 := float_min
    var Pointer:(List Link:D2Box) l :> b list
    if exists:l
      each bb l
        bb position c
        position_include bb b
    if b:x0=float_max
      b x0 := undefined
      b y0 := undefined
      b x1 := undefined
      b y1 := undefined
  
  method b position_zero c
    oarg_rw D2Box b ; arg_rw D2Context c
    var D2Context c2 := c
    c2 x0 := 0
    c2 y0 := 0
    c2 x1 := c:x1-c:x0
    c2 y1 := float_max/2
    c2 newline
    b position_container c2  
  
  method b position_hidden c
    oarg_rw D2Box b ; arg_rw D2Context c
    b x0 := undefined
    b y0 := undefined
    b x1 := undefined
    b y1 := undefined
    var Pointer:(List Link:D2Box) l :> b list
    if exists:l
      each bb l
        bb position_hidden c
  
  
  method b draw_recurse img c
    oarg_rw D2Box b ; oarg_rw ImagePrototype img ; arg_rw D2Context c
    var Pointer:(List Link:D2Box) l :> b list
    if exists:l
      each bb l
        if bb:x0=undefined
          bb draw img c
        eif bb:x0<=img:x1 and bb:y0<=img:y1 or bb:x1>=img:x0 and bb:y1>=img:y0
          bb draw img c
  
  
  method c bind img
    arg_rw D2Context c ; arg ImagePrototype img
    c x0 := img x0
    c y0 := img y0
    c x1 := img x1
    c y1 := img y1
    c areas := var List:D2Area empty_areas_list
    c newline


#-----------------------------------------------------------------------------


export XmlContext
export '. mark' '. set' '. query' '. rewind'
export '. newline' '. addtoline' '. newarea'