Patch title: Release 96 bulk changes
Abstract:
File: /pliant/graphic/layout/hook.pli
Key:
    Removed line
    Added line
   
module "/pliant/language/compiler.pli"
module "/pliant/language/compiler.pli"
module "/pliant/language/compiler/type/inherit.pli"
module "/pliant/language/stream.pli"
module "/pliant/util/pml/io.pli"
module "/pliant/graphic/draw/prototype.pli"
module "/pliant/language/stream.pli"
module "/pliant/util/pml/io.pli"
module "/pliant/graphic/draw/prototype.pli"
module "/pliant/graphic/browser/client/context.pli"
module "/pliant/graphic/ui/client/context.pli"
module "/pliant/graphic/ui/client/window.pli"
module "prototype.pli"
module "sequence.pli"
module "helper/recurse.pli"
module "helper/position.pli"
module "prototype.pli"
module "sequence.pli"
module "helper/recurse.pli"
module "helper/position.pli"
module "helper/event.pli"


public
  type LayoutHook


public
  type LayoutHook
    field Link:LayoutPrototype next
    field Int parent_and_flags <- 0
    inherit LayoutPrototype
    field LayoutArea bbox
    field Link:LayoutPrototype first_son
    field Str id
    field Int flags <- 0


method h draw d c
  oarg_rw LayoutHook h ; oarg_rw DrawPrototype d ; arg_rw La
  if h:bbox:x0=undefined or (h:bbox intersects c:bbox)
    h draw_recurse d c
    field LayoutArea bbox
    field Link:LayoutPrototype first_son
    field Str id
    field Int flags <- 0


method h draw d c
  oarg_rw LayoutHook h ; oarg_rw DrawPrototype d ; arg_rw La
  if h:bbox:x0=undefined or (h:bbox intersects c:bbox)
    h draw_recurse d c
  if (addressof c:window:session:focus_target)=addressof:h
    c:window focus_area h:bbox:x0 h:bbox:y0 h:bbox:x1 h:bbox:y1


method h event c
  oarg_rw LayoutHook h ; arg_rw LayoutEC c


method h event c
  oarg_rw LayoutHook h ; arg_rw LayoutEC c
  # console "hook mode " c:mode " for event " c:event " " c:
  h event_recurse c
  h event_recurse c
  if c:event="move" and (h:flags .and. 1)=0
    return
  var CBool clic := c:event="press" and (c:key parse "button
  if c:mode=(shunt clic layout_event_pointer layout_event_fo
    var Pointer:BrowserSession s :> c:window session
  if c:mode=layout_event_pointer
    if not (h:bbox:x0=undefined or h:bbox:y0<=c:y and h:bbox:y1>=c:y and h:bbox:x0<=c:x and h:bbox:x1>=c:x)
      return
    var Pointer:LayoutPrototype p :> c:window:session:over_target
    while exists:p and addressof:p<>addressof:h
      p :> p parent
    if not exists:p
      c set_over h
      c cancel := true
  var CBool concerned
  if c:event="press" and c:key="button1"
    concerned := (h:flags .and. 3)<>0
  eif c:event="press" or c:event="release" or c:event="character" or c:event="uncharacter"
    concerned := (h:flags .and. 2)<>0
  eif c:event="change"
    concerned := (h:flags .and. 4)<>0
  eif c:event="focus"
    concerned := (h:flags .and. 8)<>0
  eif c:event="over"
    concerned := (h:flags .and. 16)<>0
  eif c:event="move"
    concerned := (h:flags .and. 32)<>0
  else
    concerned := false
  var CBool inside := c:x>=h:bbox:x0 and c:x<=h:bbox:x1 and c:y>=h:bbox:y0 and c:y<=h:bbox:y1
  var CBool clic := (c:event="press" or c:event="release") and (c:key parse "button" any) and inside
  # var CBool now := c:mode=(shunt clic or c:event="move" or not (exists c:window:session:focus_target) and inside layout_event_pointer layout_event_focus)
  var CBool now
  if c:event="change" or c:event="over" or c:event="focus"
    now := true
  eif clic or c:event="move"
    now := c:mode=layout_event_pointer
  else
    now := c:mode=layout_event_focus
  # console "event " c:event " key " c:key " " c:mode " " (shunt concerned "yes" "no") " " (shunt now "yes" "no") eol
  if concerned and now
    var Pointer:UISession s :> c:window session
    s:connection otag "event" h:id
    s:connection oattr "event" c:event
    s:connection oattr "key" c:key
    s:connection otag "event" h:id
    s:connection oattr "event" c:event
    s:connection oattr "key" c:key
    if c:x<>undefined
      s:connection oattr "pointer_x" c:x
    if c:y<>undefined
      s:connection oattr "pointer_y" c:y
    s:connection oattr "buttons" c:buttons
    if c:x<>undefined and h:bbox:x0<>undefined
      s:connection oattr "x" c:x-h:bbox:x0
      s:connection oattr "sx" h:bbox:x1-h:bbox:x0
    if c:y<>undefined and h:bbox:y0<>undefined
      s:connection oattr "y" c:y-h:bbox:y0
      s:connection oattr "sy" h:bbox:y1-h:bbox:y0
    part pointer_section
      var Pointer:LayoutPrototype p :> c pointer_target
      while exists:p
        if (entry_type addressof:p)=LayoutSection
          s:connection oattr "pointer_section" (addressof:p 
          if c:pointer_index<>undefined
            s:connection oattr "pointer_index" c:pointer_ind
          leave pointer_section          
        p :> p parent
    part focus_section
      var Pointer:LayoutPrototype p :> s focus_target
      while exists:p
        if (entry_type addressof:p)=LayoutSection
          s:connection oattr "focus_section" (addressof:p ma
          if s:focus_index<>undefined
    part pointer_section
      var Pointer:LayoutPrototype p :> c pointer_target
      while exists:p
        if (entry_type addressof:p)=LayoutSection
          s:connection oattr "pointer_section" (addressof:p 
          if c:pointer_index<>undefined
            s:connection oattr "pointer_index" c:pointer_ind
          leave pointer_section          
        p :> p parent
    part focus_section
      var Pointer:LayoutPrototype p :> s focus_target
      while exists:p
        if (entry_type addressof:p)=LayoutSection
          s:connection oattr "focus_section" (addressof:p ma
          if s:focus_index<>undefined
            s:connection oattr "focus_index" (shunt clic s:f
            s:connection oattr "focus_index" s:focus_index # (shunt clic s:focus_index c:focus_was)
          leave focus_section          
        p :> p parent
          leave focus_section          
        p :> p parent
    if c:event_options<>""
      s:connection oattr "event_options" c:event_options
    s:connection flush anytime
    c cancel := true


method s first -> p
  oarg_rw LayoutHook s ; arg_C Link:LayoutPrototype p
  p :>> s first_son
    s:connection flush anytime
    c cancel := true


method s first -> p
  oarg_rw LayoutHook s ; arg_C Link:LayoutPrototype p
  p :>> s first_son


method h focusable -> c
  oarg_rw LayoutHook h ; arg CBool c
  c := true