Patch title: Release 90 bulk changes
Abstract:
File: /graphic/browser/tag/prototype.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 


gvar Dictionary tag_position_dictionary
gvar Dictionary tag_draw_dictionary
# 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 


gvar Dictionary tag_position_dictionary
gvar Dictionary tag_draw_dictionary
gvar Dictionary tag_event_dictionary


named_expression tag_position_prototype


named_expression tag_position_prototype
  function 'pliant tag position function' tree context
    arg_rw XmlTree tree ; arg_rw XmlContext context
    implicit tree context
  method context 'pliant tag position function' tree
    arg_rw XmlContext context ; arg_rw XmlTree tree
    implicit context tree
      body

meta tag_position e
  if e:size=2 and e:0:is_pure_ident and e:1:ident="{}"
    var Address mark := e:module mark
    var Link:Expression ee :> expression duplicate tag_posit
    error_push_record (var ErrorRecord er) error_filter_all
    ee compile
    if er:id<>error_id_noerror
      console er:message eol
      er id := error_id_noerror
      e suckup_error ee
    error_pull_record er
      body

meta tag_position e
  if e:size=2 and e:0:is_pure_ident and e:1:ident="{}"
    var Address mark := e:module mark
    var Link:Expression ee :> expression duplicate tag_posit
    error_push_record (var ErrorRecord er) error_filter_all
    ee compile
    if er:id<>error_id_noerror
      console er:message eol
      er id := error_id_noerror
      e suckup_error ee
    error_pull_record er
    var Link:Function f :> (pliant_general_dictionary first 
    var Link:Function f :> (pliant_general_dictionary first ". pliant tag position function") map Function
    e:module rewind mark
    if exists:f
      tag_position_dictionary insert e:0:ident true addresso
      e set_void_result


named_expression tag_draw_prototype
    e:module rewind mark
    if exists:f
      tag_position_dictionary insert e:0:ident true addresso
      e set_void_result


named_expression tag_draw_prototype
  function 'pliant tag draw function' tree draw context
    arg_rw XmlTree tree ; oarg_rw DrawPrototype draw ; arg_r
    implicit tree context
  method context 'pliant tag draw function' tree
    arg_rw XmlContext context ; arg_rw XmlTree tree
    implicit context tree
      body

meta tag_draw e
  if e:size=2 and e:0:is_pure_ident and e:1:ident="{}"
    var Address mark := e:module mark
    var Link:Expression ee :> expression duplicate tag_draw_
    error_push_record (var ErrorRecord er) error_filter_all
    ee compile
    if er:id<>error_id_noerror
      console er:message eol
      er id := error_id_noerror
      e suckup_error ee
    error_pull_record er
      body

meta tag_draw e
  if e:size=2 and e:0:is_pure_ident and e:1:ident="{}"
    var Address mark := e:module mark
    var Link:Expression ee :> expression duplicate tag_draw_
    error_push_record (var ErrorRecord er) error_filter_all
    ee compile
    if er:id<>error_id_noerror
      console er:message eol
      er id := error_id_noerror
      e suckup_error ee
    error_pull_record er
    var Link:Function f :> (pliant_general_dictionary first 
    var Link:Function f :> (pliant_general_dictionary first ". pliant tag draw function") map Function
    e:module rewind mark
    if exists:f
      tag_draw_dictionary insert e:0:ident true addressof:f
      e set_void_result

    e:module rewind mark
    if exists:f
      tag_draw_dictionary insert e:0:ident true addressof:f
      e set_void_result


named_expression tag_event_prototype
  method context 'pliant tag event function' tree -> consumed
    arg_rw XmlContext context ; arg_rw XmlTree tree ; arg CBool consumed
    consumed := false
    implicit context tree
      body

meta tag_event e
  if e:size=2 and e:0:is_pure_ident and e:1:ident="{}"
    var Address mark := e:module mark
    var Link:Expression ee :> expression duplicate tag_event_prototype substitute body e:1 near e
    error_push_record (var ErrorRecord er) error_filter_all
    ee compile
    if er:id<>error_id_noerror
      console er:message eol
      er id := error_id_noerror
      e suckup_error ee
    error_pull_record er
    var Link:Function f :> (pliant_general_dictionary first ". pliant tag event function") map Function
    e:module rewind mark
    if exists:f
      tag_event_dictionary insert e:0:ident true addressof:f
      e set_void_result

export tag_position_dictionary tag_draw_dictionary
export tag_position_dictionary tag_draw_dictionary
export tag_position tag_draw
export tag_position tag_draw tag_event




function tag_position_prototype tree context f
  arg_rw XmlTree tree ; arg_rw XmlContext context ; arg Func
#-----------------------------------------------------------------------------


method context tag_position_prototype tree f
  arg_rw XmlContext context ; arg_rw XmlTree tree ; arg Function f
  indirect

  indirect

method tree position context
  arg_rw XmlTree tree ; arg_rw XmlContext context
method context position tree
  arg_rw XmlContext context ; arg_rw XmlTree tree
  var Str tag := tree tag
  context mark
  context set tag
  tree first_attr (var Str attr) (var Str value)
  while attr<>""
    context set tag attr value
    tree next_attr (var Str attr) (var Str value)
  tree x0 := undefined ; tree y0 := undefined ; tree x1 := u
  tree x0 := undefined ; tree y0 := undefined ; tree x1 := u
  var Pointer:Arrow c :> tag_position_dictionary first tree:
  if exists:c
    tag_position_prototype tree context (c map Function)
  var Pointer:Arrow c :> tag_position_dictionary first tag
  if c<>null
    context tag_position_prototype tree (c map Function)
  else
    each sub tree
  else
    each sub tree
      sub position context
      context position sub
  context rewind




function tag_draw_prototype tree draw context f
  arg_rw XmlTree tree ; oarg_rw DrawPrototype draw ; arg_rw 
method context tag_draw_prototype tree f
  arg_rw XmlContext context ; arg_rw XmlTree tree ; arg Function f
  indirect

  indirect

method tree draw draw context
  arg_rw XmlTree tree ; oarg_rw DrawPrototype draw ; arg_rw 
  tree x0 := undefined ; tree y0 := undefined ; tree x1 := u
  var Pointer:Arrow c :> tag_position_dictionary first tree:
  if exists:c
    tag_draw_prototype tree draw context (c map Function)
method context draw tree
  arg_rw XmlContext context ; arg_rw XmlTree tree
  if tree:x0=defined and context:clip_x0=defined
    if tree:x0>=context:clip_x1 or tree:x1<=context:clip_x0 or tree:y0>context:clip_y1 or tree:y1<context:clip_y0
      return
  var Str tag := tree tag
  context mark
  context set tag
  tree first_attr (var Str attr) (var Str value)
  while attr<>""
    context set tag attr value
    tree next_attr (var Str attr) (var Str value)
  var Pointer:Arrow c :> tag_draw_dictionary first tree:tag
  if c<>null
    context tag_draw_prototype tree (c map Function)
  else
    each sub tree
  else
    each sub tree
      sub draw draw context
      context draw sub
  context rewind


export '. position' '. draw'

method context tag_event_prototype tree f -> consumed
  arg_rw XmlContext context ; arg_rw XmlTree tree ; arg Function f ; arg CBool consumed
  indirect

method context event tree -> result
  arg_rw XmlContext context ; arg_rw XmlTree tree ; arg Int result
  result := 0
  if tree:x0=defined
    if tree:x0>context:x or tree:x1<context:x or tree:y0>context:y or tree:y1<context:y
      return
    else
      result := 1
  var Str tag := tree tag
  context mark
  context set tag
  tree first_attr (var Str attr) (var Str value)
  while attr<>""
    context set tag attr value
    tree next_attr (var Str attr) (var Str value)
  each sub tree
    result := max result (context event sub)
  if result=1
    var Pointer:Arrow c :> tag_event_dictionary first tree:tag
    if c<>null
      if (context tag_event_prototype tree (c map Function))
        result=2
  context rewind


export '. position' '. draw' '. event'