Patch title: Release 94 bulk changes
Abstract:
File: /pliant/graphic/browser/naive/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/or
# modify it under the terms of the GNU General Public License version 2
# as published by the Free Software Foundation.
#
# This program 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 General Public License for more details.
#
# You should have received a copy of the GNU General Public License
# version 2 along with this program; if not, write to the Free Software
# Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA  02111-1307, USA.

module "/pliant/language/compiler.pli"
module "/pliant/graphic/browser/naive/document.pli"
module "/pliant/graphic/browser/naive/context.pli"


gvar Dictionary tag_position_dictionary
gvar Dictionary tag_split_dictionary
gvar Dictionary tag_draw_dictionary
gvar Dictionary tag_event_dictionary


named_expression tag_position_prototype
  method context 'pliant tag position function' node
    arg_rw BrowserContext context ; arg_rw BrowserNode node
    implicit context node
      body

meta browser_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_position_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 position function") map Function
    e:module rewind mark
    if exists:f
      tag_position_dictionary insert e:0:ident true addressof:f
      e set_void_result


named_expression tag_split_prototype
  method context 'pliant tag split function' node extend -> boxes
    arg_rw BrowserContext context ; arg_rw BrowserNode node ; arg CBool extend ; arg Array:BrowserArea boxes
    implicit context node
      body

meta browser_tag_split 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_split_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 split function") map Function
    e:module rewind mark
    if exists:f
      tag_split_dictionary insert e:0:ident true addressof:f
      e set_void_result


named_expression tag_draw_prototype
  method context 'pliant tag draw function' node
    arg_rw BrowserContext context ; arg_rw BrowserNode node
    implicit context node
      body

meta browser_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_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 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


named_expression tag_event_prototype
  method context 'pliant tag event function' node
    arg_rw BrowserContext context ; arg_rw BrowserNode node
    implicit context node
      body

meta browser_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 browser_tag_position browser_tag_split browser_tag_draw browser_tag_event


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


method context tag_position_prototype node f
  arg_rw BrowserContext context ; arg_rw BrowserNode node ; arg Function f
  indirect

method context position node
  arg_rw BrowserContext context ; arg_rw BrowserNode node
  context mark
  context set_attributes node
  memory_free node:extra ; node extra := null
  var Pointer:Arrow c :> tag_position_dictionary first node:tag
  if c<>null
    context tag_position_prototype node (c map Function)
  else
    each sub node
      context position sub
  context rewind


method context tag_split_prototype node extend f -> boxes
  arg_rw BrowserContext context ; arg_rw BrowserNode node ; arg CBool extend ; arg Function f ; arg Array:BrowserArea boxes
  indirect

method context split node extend -> boxes
  arg_rw BrowserContext context ; arg_rw BrowserNode node ; arg CBool extend ; arg Array:BrowserArea boxes
  implicit context node
    boxes size := 0
    var Pointer:Arrow c :> tag_split_dictionary first tag
    if c<>null
      boxes := context tag_split_prototype node extend (c map Function)


method context tag_draw_prototype node f
  arg_rw BrowserContext context ; arg_rw BrowserNode node ; arg Function f
  indirect

method context draw node
  arg_rw BrowserContext context ; arg_rw BrowserNode node
  if node:has_area and context:clip_x0=defined
    if node:area:x0>=context:clip_x1 or node:area:x1<=context:clip_x0 or node:area:y0>context:clip_y1 or node:area:y1<context:clip_y0
      return
  context mark
  context set_attributes node
  var Pointer:Arrow c :> tag_draw_dictionary first node:tag
  if c<>null
    context tag_draw_prototype node (c map Function)
  else
    each sub node
      context draw sub
  context rewind


method context tag_event_prototype node f
  arg_rw BrowserContext context ; arg_rw BrowserNode node ; arg Function f
  indirect

method context event node
  arg_rw BrowserContext context ; arg_rw BrowserNode node
  later

method context event_recurse node
  arg_rw BrowserContext context ; arg_rw BrowserNode node
  if context:event_recurse_flag
    var Pointer:BrowserNode sub :> node first
    if exists:sub
      while { var Pointer:BrowserNode n :> sub next ; exists n }
        sub :> n
      while exists:sub
        context event sub
        if context:event_discard_flag
          return
        sub :> sub previous

method context event node
  arg_rw BrowserContext context ; arg_rw BrowserNode node
  if context:x<>undefined and node:has_area and context:event_recurse_flag
    if node:area:x0>context:x or node:area:x1<context:x or node:area:y0>context:y or node:area:y1<context:y
      return
  context mark
  context set_attributes node
  var Pointer:Arrow c :> tag_event_dictionary first node:tag
  if c<>null
    context tag_event_prototype node (c map Function)
  else
    context event_recurse node
  context rewind

export '. position' '. split' '. draw' '. event' '. event_recurse'