Patch title: Release 95 bulk changes
Abstract:
File: /pliant/graphic/browser/client/instructions.pli
Key:
    Removed line
    Added line
   
module "/pliant/language/compiler.pli"
module "/pliant/util/pml/io.pli"
module "/pliant/util/pml/body.pli"
module "/pliant/graphic/color/color.pli"
module "/pliant/graphic/vector/font.pli"
module "/pliant/graphic/layout/prototype.pli"
module "/pliant/graphic/layout/sequence.pli"
module "/pliant/graphic/layout/restyle.pli"
module "/pliant/graphic/layout/text.pli"
module "/pliant/graphic/layout/table.pli"
module "/pliant/graphic/layout/form.pli"
module "/pliant/graphic/layout/hook.pli"
module "/pliant/graphic/image/pixmap.pli"
module "/pliant/graphic/image/packed.pli"
module "/pliant/graphic/color/gamut.pli"
module "/pliant/language/type/misc/blob.pli"
module "/pliant/util/encoding/pack4.pli"
module "/pliant/graphic/layout/image.pli"
module "/pliant/graphic/layout/draw.pli"
module "/pliant/graphic/draw/prototype.pli"
module "/pliant/math/curve.pli"
module "context.pli"
module "connect.pli"
module "window.pli"
module "/pliant/graphic/layout/helper/text.pli"
module "/pliant/graphic/layout/helper/event.pli"



browser_client_instruction input
  var Link:LayoutInput i :> new LayoutInput
  if not (connection itag "input" i:id)
    ierror "incorrect 'input' instruction"
    return
  connection iattr "value" i:value
  if (connection iattr "label" (var Str label))
    var Link:LayoutText t :> new LayoutText
    t text := label
    add t
  if (connection iattr "over")
    i flags := i:flags .or. 1
  if (connection iattr "password")
    i flags := i:flags .or. 2
  if (connection iattr "multiline")
    i flags := i:flags .or. 4
module "/pliant/language/compiler.pli"
module "/pliant/util/pml/io.pli"
module "/pliant/util/pml/body.pli"
module "/pliant/graphic/color/color.pli"
module "/pliant/graphic/vector/font.pli"
module "/pliant/graphic/layout/prototype.pli"
module "/pliant/graphic/layout/sequence.pli"
module "/pliant/graphic/layout/restyle.pli"
module "/pliant/graphic/layout/text.pli"
module "/pliant/graphic/layout/table.pli"
module "/pliant/graphic/layout/form.pli"
module "/pliant/graphic/layout/hook.pli"
module "/pliant/graphic/image/pixmap.pli"
module "/pliant/graphic/image/packed.pli"
module "/pliant/graphic/color/gamut.pli"
module "/pliant/language/type/misc/blob.pli"
module "/pliant/util/encoding/pack4.pli"
module "/pliant/graphic/layout/image.pli"
module "/pliant/graphic/layout/draw.pli"
module "/pliant/graphic/draw/prototype.pli"
module "/pliant/math/curve.pli"
module "context.pli"
module "connect.pli"
module "window.pli"
module "/pliant/graphic/layout/helper/text.pli"
module "/pliant/graphic/layout/helper/event.pli"



browser_client_instruction input
  var Link:LayoutInput i :> new LayoutInput
  if not (connection itag "input" i:id)
    ierror "incorrect 'input' instruction"
    return
  connection iattr "value" i:value
  if (connection iattr "label" (var Str label))
    var Link:LayoutText t :> new LayoutText
    t text := label
    add t
  if (connection iattr "over")
    i flags := i:flags .or. 1
  if (connection iattr "password")
    i flags := i:flags .or. 2
  if (connection iattr "multiline")
    i flags := i:flags .or. 4
  var CBool focus := connection iattr "focus"
  add i
  standard_no_body "input"
  add i
  standard_no_body "input"
  if focus
    var Pointer:LayoutPrototype r :> i
    while (exists r:parent)
      r :> r parent
    each w session:windows
      if addressof:r=(addressof w:root) or addressof:r=(addressof w:overlay)
        var LayoutEC c
        c style :> session:console default_style
        c window :> w
        c set_focus i 0

browser_client_instruction select
  var Link:LayoutSelect s :> new LayoutSelect
  if not (connection itag "select" s:id)
    ierror "incorrect 'select' instruction"
    return
  connection iattr "value" s:value

browser_client_instruction select
  var Link:LayoutSelect s :> new LayoutSelect
  if not (connection itag "select" s:id)
    ierror "incorrect 'select' instruction"
    return
  connection iattr "value" s:value
  if (connection iattr "label" (var Str label))
    var Link:LayoutText t :> new LayoutText
    t text := label
    add t
  if (connection iattr "over")
    s flags := s:flags .or. 1
  if (connection iattr "over")
    s flags := s:flags .or. 1
  var CBool focus := connection iattr "focus"
  add s
  if not connection:ibody_begin
    ierror "incorrect 'select' instruction"
    return
  current :> s
  while connection:ibody_more
    process_instruction false
  current :> null map LayoutPrototype
  if not connection:ibody_end
    ierror "incorrect 'select' instruction"
  add s
  if not connection:ibody_begin
    ierror "incorrect 'select' instruction"
    return
  current :> s
  while connection:ibody_more
    process_instruction false
  current :> null map LayoutPrototype
  if not connection:ibody_end
    ierror "incorrect 'select' instruction"
  if focus
    var Pointer:LayoutPrototype r :> s
    while (exists r:parent)
      r :> r parent
    each w session:windows
      if addressof:r=(addressof w:root) or addressof:r=(addressof w:overlay)
        var LayoutEC c
        c style :> session:console default_style
        c window :> w
        c set_focus s 0




method l find_focus -> f
  oarg_rw LayoutPrototype l ; arg_C LayoutPrototype f
  var Link:LayoutPrototype p :> l first
  while exists:p
    f :> p find_focus
    if exists:f
      return
    p :> p next
  if l:focusable
    f :> l
  else
    f :> null map LayoutPrototype

browser_client_instruction focus_set
  if not (connection itag "focus_set" (var Str section) (var
    ierror "incorrect 'focus_set' instruction"
    return
  var Link:LayoutSection s :> (session:namespace first secti
  if not exists:s or (entry_type addressof:s)<>LayoutSection
    ierror "there is no '"+section+"' section"
    return
browser_client_instruction focus_set
  if not (connection itag "focus_set" (var Str section) (var
    ierror "incorrect 'focus_set' instruction"
    return
  var Link:LayoutSection s :> (session:namespace first secti
  if not exists:s or (entry_type addressof:s)<>LayoutSection
    ierror "there is no '"+section+"' section"
    return
  var Link:LayoutPrototype p :> s first
  # if exists:p and (entry_type addressof:p)=LayoutRestyle
  #   p :> p first
  var Link:LayoutPrototype p :> s find_focus
  if not exists:p
    p :> s parent
    while exists:p and not p:focusable
      p :> p parent
  if exists:p
    var Pointer:LayoutPrototype r :> p
    while (exists r:parent)
      r :> r parent
    each w session:windows
      if addressof:r=(addressof w:root) or addressof:r=(addr
        var LayoutEC c
        c style :> session:console default_style
        c window :> w
        c set_focus p index
  standard_no_body "focus_set"



browser_client_instruction style
  if not (connection itag "style")
    ierror "incorrect 'style' instruction"
    return
  var Link:LayoutRestyle s :> new LayoutRestyle
  while (connection iraw (var Ident tag_id))
    if (cast tag_id Str)="use" and (connection iraw (var Str
      var Pointer:LayoutStyle st :> (session:namespace first
      if exists:st and (entry_type addressof:st)=LayoutStyle
        s style :> st
    eif (connection iraw open)
      while (connection iraw (var Ident attr_id))
        var Pointer:Type t1 :> LayoutStyle
        for (var Int i) 0 t1:nb_fields-1
          if (t1 field i):name=(cast tag_id Str)
            var Pointer:Type t2 :> (t1 field i) type
            for (var Int j) 0 t2:nb_fields-1
              if (t2 field j):name=(cast attr_id Str)
                var Pointer:Type t3 :> (t2 field j) type
                var LayoutAttribute attr
                attr offset := (t1 field i):offset+(t2 field
                attr size := t3 size                
                if t3=CBool and (connection ipick (var CBool
                  attr value := addressof (new CBool bvalue)
                  s attributes += attr
                eif t3=Int and (connection ipick (var Int iv
                  attr value := addressof (new Int ivalue)
                  s attributes += attr
                eif t3=Str and (connection ipick (var Str sv
                  attr value := addressof (new Str svalue)
                  s attributes += attr
                eif t3=Float and (connection ipick (var Floa
                  attr value := addressof (new Float fvalue)
                  s attributes += attr
                eif t3=Float and (connection ipick (var Int 
                  attr value := addressof (new Float ivalue)
                  s attributes += attr
                eif t3=Link:Font and (connection ipick (var 
                  var Link:Font font :> session font_load sv
                  if exists:font
                    attr value := addressof (new Link:Font f
                    s attributes += attr
                eif t3=(Array Link:Font) and (connection ipi
                  var Link:Font font :> session font_load sv
                  if exists:font
                    (var (Array Link:Font) fonts) size := 4
                    fonts 0 :> font ; fonts 1 :> font ; font
                    attr value := addressof (new (Array Link
                    s attributes += attr
                eif t3=LayoutColor and (connection ipick ope
                  attr value := addressof (new LayoutColor (
                  s attributes += attr
                else
                  console "style oops '" (cast tag_id Str) "
        connection iskip
      if not (connection iraw close)
        ierror "incorrect 'style' instruction"
    else
      ierror "incorrect 'style' instruction"
  add s
  standard_body s s:first_son "style"
  if exists:p
    var Pointer:LayoutPrototype r :> p
    while (exists r:parent)
      r :> r parent
    each w session:windows
      if addressof:r=(addressof w:root) or addressof:r=(addr
        var LayoutEC c
        c style :> session:console default_style
        c window :> w
        c set_focus p index
  standard_no_body "focus_set"



browser_client_instruction style
  if not (connection itag "style")
    ierror "incorrect 'style' instruction"
    return
  var Link:LayoutRestyle s :> new LayoutRestyle
  while (connection iraw (var Ident tag_id))
    if (cast tag_id Str)="use" and (connection iraw (var Str
      var Pointer:LayoutStyle st :> (session:namespace first
      if exists:st and (entry_type addressof:st)=LayoutStyle
        s style :> st
    eif (connection iraw open)
      while (connection iraw (var Ident attr_id))
        var Pointer:Type t1 :> LayoutStyle
        for (var Int i) 0 t1:nb_fields-1
          if (t1 field i):name=(cast tag_id Str)
            var Pointer:Type t2 :> (t1 field i) type
            for (var Int j) 0 t2:nb_fields-1
              if (t2 field j):name=(cast attr_id Str)
                var Pointer:Type t3 :> (t2 field j) type
                var LayoutAttribute attr
                attr offset := (t1 field i):offset+(t2 field
                attr size := t3 size                
                if t3=CBool and (connection ipick (var CBool
                  attr value := addressof (new CBool bvalue)
                  s attributes += attr
                eif t3=Int and (connection ipick (var Int iv
                  attr value := addressof (new Int ivalue)
                  s attributes += attr
                eif t3=Str and (connection ipick (var Str sv
                  attr value := addressof (new Str svalue)
                  s attributes += attr
                eif t3=Float and (connection ipick (var Floa
                  attr value := addressof (new Float fvalue)
                  s attributes += attr
                eif t3=Float and (connection ipick (var Int 
                  attr value := addressof (new Float ivalue)
                  s attributes += attr
                eif t3=Link:Font and (connection ipick (var 
                  var Link:Font font :> session font_load sv
                  if exists:font
                    attr value := addressof (new Link:Font f
                    s attributes += attr
                eif t3=(Array Link:Font) and (connection ipi
                  var Link:Font font :> session font_load sv
                  if exists:font
                    (var (Array Link:Font) fonts) size := 4
                    fonts 0 :> font ; fonts 1 :> font ; font
                    attr value := addressof (new (Array Link
                    s attributes += attr
                eif t3=LayoutColor and (connection ipick ope
                  attr value := addressof (new LayoutColor (
                  s attributes += attr
                else
                  console "style oops '" (cast tag_id Str) "
        connection iskip
      if not (connection iraw close)
        ierror "incorrect 'style' instruction"
    else
      ierror "incorrect 'style' instruction"
  add s
  standard_body s s:first_son "style"