Patch title: Release 94 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"


method c add p
  arg_rw BrowserClientContext c ; oarg_rw LayoutPrototype p
  p set_parent c:parent
  c chain :> p
  c chain :>> p next

method c standard_body parent first instruction_name -> status
  arg_rw BrowserClientContext c ; arg LayoutPrototype parent ; arg_rw Link:LayoutPrototype first ; arg Str instruction_name ; arg Status status
  if not c:connection:ibody_begin
    c ierror "incorrect '"+instruction_name+"' instruction"
    return failure
  var Pointer:LayoutPrototype memo_parent :> c parent
  c parent :> parent
  var (Pointer Link:LayoutPrototype) memo_chain :>> c chain
  c chain :>> first
  while c:connection:ibody_more
    c process_instruction false
  c parent :> memo_parent
  c chain :>> memo_chain
  if not c:connection:ibody_end
    c ierror "incorrect '"+instruction_name+"' instruction"
    return failure
  status := success

method c standard_no_body instruction_name -> status
  arg_rw BrowserClientContext c ; arg Str instruction_name ; arg Status status
  if not c:connection:ibody_none
    c ierror "incorrect '"+instruction_name+"' instruction"
    return failure
  status := success


browser_client_instruction text
  if not (connection itag "text" (var Str txt))
    ierror "incorrect 'text' instruction"
    return
  var Link:LayoutText t :> new LayoutText
  t text := txt
  add t
  standard_no_body "text"


method c para_instruction id flags
  arg_rw BrowserClientContext c ; arg Str id ; arg Int flags
  implicit c
    if not (connection itag id)
      ierror "incorrect 'para' instruction"
      return
    var Link:LayoutPara para :> new LayoutPara
    para flags := flags
    if (connection iattr "stick")
      para flags := para:flags .and. .not. (cast 3 Int)
    if (connection iattr "cursor")
      para flags += 4
    if (connection iattr "edit")
      para flags += 8
    add para
    standard_body para para:first_son id

browser_client_instruction para
  para_instruction "para" 3

browser_client_instruction header
  para_instruction "header" 13h

browser_client_instruction title
  para_instruction "title" 23h


browser_client_instruction table
  if not (connection itag "table")
    ierror "incorrect 'table' instruction"
    return
  var Link:LayoutTable t :> new LayoutTable
  add t
  standard_body t t:first_son "table"

browser_client_instruction row
  if not (connection itag "row")
    ierror "incorrect 'row' instruction"
    return
  var Link:LayoutRow r :> new LayoutRow
  add r
  standard_body r r:first_son "row"

browser_client_instruction cell
  if not (connection itag "cell")
    ierror "incorrect 'cell' instruction"
    return
  var Link:LayoutCell c :> new LayoutCell
  if (connection iattr "header")
    c header := true
  add c
  standard_body c c:first_son "cell"


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
  add i
  standard_no_body "input"

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 "over")
    s flags := s:flags .or. 1
  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"

browser_client_instruction option
  var LayoutSelectOption o
  if not (connection itag "option" o:label o:value)
    ierror "incorrect 'select' instruction"
    return
  var Link:LayoutSelect s :> addressof:current map LayoutSelect
  if exists:s and (entry_type addressof:s)=LayoutSelect
    s options += o
  standard_no_body "option"

browser_client_instruction button
  var Link:LayoutButton b :> new LayoutButton
  if not (connection itag "button" b:id)
    ierror "incorrect 'button' instruction"
    return
  connection iattr "label" b:label
  if (connection iattr "key" b:key)
    var (Pointer Link:LayoutPrototype) k :>> session:keys first b:key
    if exists:k
      k :> b
    else
      var Link:LayoutPrototype ptr :> b
      session:keys insert b:key ptr
  if (connection iattr "over")
    b flags := b:flags .or. 1
  if (connection iattr "stretch")
    b flags := b:flags .or. 2
  if (connection iattr "selected")
    b flags := b:flags .or. 4
  add b
  standard_no_body "button"

browser_client_instruction link
  var Link:LayoutLink b :> new LayoutLink
  if not (connection itag "link" b:label b:id)
    ierror "incorrect 'link' instruction"
    return
  add b
  standard_no_body "link"


browser_client_instruction hook
  var Link:LayoutHook h :> new LayoutHook
  if not (connection itag "hook" h:id)
    ierror "incorrect 'hook' instruction"
    return
  if (connection iattr "move")
    h flags := h:flags .or. 1
  add h
  standard_body h h:first_son "hook"


browser_client_instruction focus_set
  if not (connection itag "focus_set" (var Str section) (var Int index))
    ierror "incorrect 'focus_set' instruction"
    return
  var Link:LayoutSection s :> (session:namespace first section) map LayoutSection
  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
  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=(addressof w:overlay)
        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 focus_save
  if not (connection itag "focus_save" )
    ierror "incorrect 'focus_save' instruction"
    return
  var BrowserFocusHistory h
  h window :> session focus_window
  h target :> session focus_target
  h index := session focus_index
  session focus_history += h
  standard_no_body "focus_save"


browser_client_instruction focus_restore
  if not (connection itag "focus_restore" )
    ierror "incorrect 'focus_restore' instruction"
    return
  var Pointer:BrowserFocusHistory h :> session:focus_history last
  if exists:h
    var LayoutEC c
    c window :> h window
    c set_focus h:target h:index
    session:focus_history remove h
  standard_no_body "focus_restore"


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


browser_client_instruction section
  if not (connection itag "section" (var Str name))
    ierror "incorrect 'section' instruction"
    return
  var Link:LayoutSection s :> new LayoutSection
  s section := name
  if (addressof Link:LayoutPrototype chain)<>null # FIXME
    add s
  standard_body s s:first_son "section"
  session:namespace remove name null
  session:namespace insert name true addressof:s


method s reposition start
  arg_rw BrowserSession s ; oarg_rw LayoutPrototype start
  var Pointer:LayoutPrototype p :> start
  var Str all := ""
  part scan
    all += " "+string:(cast addressof:p Int)
    all += ":"+(entry_type addressof:p):name
    p reset_position
    var Pointer:LayoutPrototype q :> p parent
    if exists:q
      p :> q
      restart scan
  each w s:windows
    if (addressof w:root)=addressof:p
      w refresh := true
    if (addressof w:overlay)=addressof:p
      w orefresh := true


browser_client_instruction section_overwrite
  if not (connection itag "section_overwrite" (var Str name))
    ierror "incorrect 'section_overwrite' instruction"
    return
  var Link:LayoutSection s :> (session:namespace first name) map LayoutSection
  if not exists:s or (entry_type addressof:s)<>LayoutSection
    ierror "there is no '"+name+"' section"
    return
  # console datetime " section overwrite '" name "'" eol
  var Link:LayoutPrototype p :> s first
  while exists:p
    session discard p
    var Link:LayoutPrototype n :> p next
    p next :> null map LayoutPrototype
    p :> n
  s first_son :> null map LayoutPrototype
  standard_body s s:first_son "section_overwrite"
  session reposition s


browser_client_instruction section_head
  if not (connection itag "section_head" (var Str name))
    ierror "incorrect 'section_head' instruction"
    return
  var Link:LayoutSection s :> (session:namespace first name) map LayoutSection
  if not exists:s or (entry_type addressof:s)<>LayoutSection
    ierror "there is no '"+name+"' section"
    return
  var (Pointer Link:LayoutPrototype) chain :>> s first_son
  var Link:LayoutPrototype memo :> chain ; chain :> null map LayoutPrototype
  standard_body s chain "section_head"
  while exists:chain
    chain :>> chain next
  chain :> memo
  session reposition s


browser_client_instruction section_tail
  if not (connection itag "section_tail" (var Str name))
    ierror "incorrect 'section_tail' instruction"
    return
  var Link:LayoutSection s :> (session:namespace first name) map LayoutSection
  if not exists:s or (entry_type addressof:s)<>LayoutSection
    ierror "there is no '"+name+"' section"
    return
  var (Pointer Link:LayoutPrototype) chain :>> s first_son
  while exists:chain
    chain :>> chain next
  standard_body s chain "section_tail"
  session reposition s


browser_client_instruction section_before
  if not (connection itag "section_before" (var Str name))
    ierror "incorrect 'section_before' instruction"
    return
  var Link:LayoutSection s :> (session:namespace first name) map LayoutSection
  if not exists:s or (entry_type addressof:s)<>LayoutSection
    ierror "there is no '"+name+"' section"
    return
  var Link:LayoutPrototype parent :> s parent
  var (Pointer Link:LayoutPrototype) chain :>> parent first
  while addressof:chain<>addressof:s
    chain :>> chain next
  var Link:LayoutPrototype memo :> chain ; chain :> null map LayoutPrototype
  standard_body s:parent chain "section_before"
  while exists:chain
    chain :>> chain next
  chain :> memo
  session reposition s


browser_client_instruction section_after
  if not (connection itag "section_after" (var Str name))
    ierror "incorrect 'section_after' instruction"
    return
  var Link:LayoutSection s :> (session:namespace first name) map LayoutSection
  if not exists:s or (entry_type addressof:s)<>LayoutSection
    ierror "there is no '"+name+"' section"
    return
  var (Pointer Link:LayoutPrototype) chain :>> s next
  var Link:LayoutPrototype memo :> chain ; chain :> null map LayoutPrototype
  standard_body s:parent chain "section_after"
  while exists:chain
    chain :>> chain next
  chain :> memo
  session reposition s


browser_client_instruction section_delete
  if not (connection itag "section_delete" (var Str name))
    ierror "incorrect 'section_before' instruction"
    return
  var Link:LayoutSection s :> (session:namespace first name) map LayoutSection
  if not exists:s or (entry_type addressof:s)<>LayoutSection
    ierror "there is no '"+name+"' section"
    return
  session reposition s
  var Link:LayoutPrototype parent :> s parent
  var (Pointer Link:LayoutPrototype) chain :>> parent first
  while addressof:chain<>addressof:s
    chain :>> chain next
  chain :> s next
  session discard s
  standard_no_body "section_delete"


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


browser_client_instruction image_define
  if not (connection itag "image_define" (var Str id))
    ierror "incorrect 'image_define' instruction"
    return
  if not (connection iattr "bbox" (var Float x0) (var Float y0) (var Float x1) (var Float y1))
    ierror "incorrect 'image_define' instruction (bbox)"
    return
  if not (connection iattr "size" (var Int size_x) (var Int size_y))
    ierror "incorrect 'image_define' instruction (size)"
    return
  if not (connection iattr "gamut" (var Str gamutname))
    ierror "incorrect 'image_define' instruction (gamut)"
    return
  var Link:ColorGamut gamut :> color_gamut gamutname ""
  if gamut=failure
    ierror "incorrect 'image_define' instruction (invalid gamut name)"
    return
  var Link:ImagePrototype img :> new ImagePacked
  img setup (image_prototype x0 y0 x1 y1 size_x size_y gamut) ""
  session:namespace remove id null
  session:namespace insert id true addressof:img
  standard_no_body "image_define"


browser_client_instruction image_write_pack4
  if not (connection itag "image_write_pack4" (var Str id) (var Int x0) (var Int y0) (var Int x1) (var Int y1))
    ierror "incorrect 'image_write_pack4' instruction"
    return
  var Link:ImagePrototype img :> (session:namespace first id) map ImagePrototype
  if not exists:img or (entry_type addressof:img)<>ImagePixmap and (entry_type addressof:img)<>ImagePacked
    ierror "there is no '"+id+"' image"
    return
  if x0<0 or y0<0 or x1>img:size_x or y1>img:size_y or x1<x0 or y1<y0
    ierror "incorrect 'image_write_pack4' instruction (bounds check)"
    return
  if not connection:ibody_begin
    ierror "incorrect 'image_write_pack4' instruction (body begin)"
    return
  var Address buffer1 := memory_zallocate (x1-x0)*img:pixel_size null
  var Address buffer2 := memory_allocate (x1-x0)*img:pixel_size null
  for (var Int y) y0 y1-1
    if not (connection iraw (var Blob b))
      ierror "incorrect 'image_write_pack4' instruction (body)"
      return
    if (pack4_decode b:content buffer2 img:pixel_size x1-x0 buffer1)<>b:size
      ierror "incorrect 'image_write' instruction (segment)"
    img write x0 y x1-x0 buffer2
    swap buffer1 buffer2
  memory_free buffer1
  memory_free buffer2
  if not connection:ibody_end
    ierror "incorrect 'image_write_pack4' instruction (body end)"
    return
 

browser_client_instruction image_copy
  if not (connection itag "image_copy" (var Str src_id) (var Int x0) (var Int y0) (var Int x1) (var Int y1) (var Str dest_id) (var Int xx) (var Int yy))
    ierror "incorrect 'image_copy' instruction"
    return
  var Link:ImagePrototype src :> (session:namespace first src_id) map ImagePrototype
  if not exists:src or (entry_type addressof:src)<>ImagePixmap and (entry_type addressof:src)<>ImagePacked
    ierror "there is no '"+src_id+"' image"
    return
  var Link:ImagePrototype dest :> (session:namespace first dest_id) map ImagePrototype
  if not exists:dest or (entry_type addressof:dest)<>ImagePixmap and (entry_type addressof:dest)<>ImagePacked
    ierror "there is no '"+dest_id+"' image"
    return
  if x0<0 or y0<0 or x1>src:size_x or y1>src:size_y or x1<x0 or y1<y0
    ierror "incorrect 'image_copy' instruction (bounds check)"
    return
  if xx<0 or yy<0 or xx+x1-x0>dest:size_x or yy+y1-y0>dest:size_y
    ierror "incorrect 'image_copy' instruction (bounds check)"
    return
  if dest:gamut:pixel_size<>src:gamut:pixel_size
    ierror "incorrect 'image_copy' instruction (gamut)"
    return
  var Address buffer := memory_allocate (x1-x0)*src:gamut:pixel_size null
  if addressof:dest<>addressof:src or yy<=y0
    for (var Int y) y0 y1-1
      src read x0 y x1-x0 buffer
      dest write xx y+yy-y0 x1-x0 buffer
  else
    for (var Int y) y1-1 y0 step -1
      src read x0 y x1-x0 buffer
      dest write xx y+yy-y0 x1-x0 buffer
  memory_free buffer
  standard_no_body "image_copy"
 

browser_client_instruction image_inline
  if not (connection itag "image_inline" (var Str id))
    ierror "incorrect 'image_inline' instruction"
    return
  var Link:ImagePrototype img :> (session:namespace first id) map ImagePrototype
  if not exists:img or (entry_type addressof:img)<>ImagePixmap and (entry_type addressof:img)<>ImagePacked
    ierror "there is no '"+id+"' image"
    return
  var Link:LayoutImage i :> new LayoutImage
  i image :> img
  add i
  standard_no_body "image_inline"
 

browser_client_instruction draw
  if not (connection itag "draw" (var Float x0) (var Float y0) (var Float x1) (var Float y1))
    ierror "incorrect 'draw' instruction"
    return
  var Link:LayoutDraw d :> new LayoutDraw
  d:bbox x0 := x0
  d:bbox y0 := y0
  d:bbox x1 := x1
  d:bbox y1 := y1
  add d
  standard_body d d:first_son "draw"


browser_client_instruction fill
  if not (connection itag "fill" open (var Ident g) (var Int cr) (var Int cg) (var Int cb) close)
    ierror "incorrect 'fill' instruction"
    return
  if (cast g Str)<>"rgb"
    ierror "incorrect 'fill' instruction (gamut)"
    return
  var Link:LayoutDrawFill f :> new LayoutDrawFill
  if not connection:ibody_begin
    ierror "incorrect 'fill' instruction (body begin)"
    return
  f mode := shunt (connection iattr "nonzero") fill_nonzero fill_evenodd
  f t := transform 0 0 1 1 0 0
  f color := color rgb cr cg cb
  while connection:ibody_more
    if (connection itag "c" (var Int mode))
      (var Curve curve) reset
      connection ibody_begin
      while connection:ibody_more
        if (connection itag "p" (var Float x) (var Float y))
          var CurvePoint p := curve_point x y true
          if (connection iattr "i" (var Int m) p:in_x p:in_y)
            p in_mode := m
          if (connection iattr "o" (var Int m) p:out_x p:out_y)
            p out_mode := m
          connection ibody_none
          curve += p
        eif (connection itag "t" (var Float x) (var Float y))
          connection ibody_none
          curve through x y
        eif (connection itag "a" (var Float x) (var Float y)) # same as 'p'
          connection ibody_none
          curve angle x y
        else
          ierror "incorrect 'fill' instruction (point)"
          return
      connection ibody_end
      curve compute mode
      if curve=success
        f curves += curve
    else
      ierror "incorrect 'fill' instruction (curve)"
      return
  if not connection:ibody_end
    ierror "incorrect 'fill' instruction (body end)"
    return
  add f
 

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


browser_client_instruction window
  if not (connection itag "window" (var Str name))
    ierror "incorrect 'window' instruction"
    return
  var Link:LayoutSequence s :> new LayoutSequence
  s set_parent (null map LayoutPrototype)
  standard_body s s:first_son "window"
  var Pointer:BrowserWindow w :> session window name
  if exists:w
    if (exists w:root)
      session discard w:root
    w root :> s
    w refresh := true


browser_client_instruction group
  if not (connection itag "group")
    ierror "incorrect 'group' instruction"
    return
  standard_body parent chain "group"
  # session:console lazy_display


browser_client_instruction url_call
  if not (connection itag "url_call" (var Str url))
    ierror "incorrect 'url_call' instruction"
    return
  if (url 0 1)="/"
    if (session:url eparse any:(var Str protocol) "://" any:(var Str server) "/" any) and (protocol search "/" undefined)=undefined
      url := protocol+"://"+server+url
    eif (session:url eparse any:(var Str protocol) ":/" any) and (protocol search "/" undefined)=undefined
      url := protocol+":"+url
  var Pointer:BrowserConsole c :> session console
  session history_push
  each w session:windows
    w scroll_x := 0 ; w scroll_y := 0
    if (exists w:root)
      session discard w:root
      w root :> null map LayoutPrototype
    if (exists w:overlay)
      session discard w:overlay
      w overlay :> null map LayoutPrototype
    w refresh := true
  session keys := var (Dictionary Str Link:LayoutPrototype) no_keys
  if not connection:ibody_none
    ierror "incorrect 'url_call' instruction"
    return
  session connect_main url (var Dictionary empty_context)
  eos := true


browser_client_instruction url_return
  if not (connection itag "url_return")
    ierror "incorrect 'url_return' instruction"
    return
  session history_pull
  each w session:windows
    if (exists w:root)
      session discard w:root
      w root :> null map LayoutPrototype
    if (exists w:overlay)
      session discard w:overlay
      w overlay :> null map LayoutPrototype
    w refresh := true
  session keys := var (Dictionary Str Link:LayoutPrototype) no_keys
  if not connection:ibody_none
    ierror "incorrect 'url_return' instruction"
    return
  session connect_main session:url session:context
  eos := true


browser_client_instruction thread_create
  if not (connection itag "thread_create" (var Str id))
    ierror "incorrect 'thread_create' instruction"
    return
  if not connection:ibody_none
    ierror "incorrect 'thread_create' instruction"
    return
  var Link:Stream stream :> new Stream
  session extra_connections += stream
  thread
    share session
    session connect_another session:url session:context stream
    stream otag "thread_run" id
    stream flush anytime
    var BrowserClientContext c2
    c2 connection :> stream
    c2 session :> session
    c2 extra_thread := true
    while stream=success
      c2 process_instruction true
    session:console:sem request
    var (Pointer Link:Stream) p :>> session:extra_connections first
    while exists:p and addressof:p<>addressof:stream
      p :>> session:extra_connections next p
    if addressof:p=addressof:stream
      session:extra_connections remove p
    session:console:sem release


browser_client_instruction style_copy
  if not (connection itag "style_copy" (var Str src_id) (var Str dest_id))
    ierror "incorrect 'style_copy' instruction"
    return
  var Pointer:LayoutStyle src :> (session:namespace first "style "+src_id) map LayoutStyle
  if src_id=""
    src :> session:console default_style
  if exists:src and (entry_type addressof:src)=LayoutStyle
    session:namespace remove "style "+dest_id null
    session:namespace insert "style "+dest_id true addressof:(new LayoutStyle src)
  if not connection:ibody_none
    ierror "incorrect 'style_copy' instruction"
    return

browser_client_instruction style_set
  if not (connection iraw open (var Ident instr) (var Str style_id) (var Str tag_id) (var Str attr_id))
    ierror "incorrect 'style_set' instruction"
    return
  var Pointer:LayoutStyle st :> (session:namespace first "style "+style_id) map LayoutStyle
  if exists:st and (entry_type addressof:st)=LayoutStyle
    var Pointer:Type t1 :> LayoutStyle
    for (var Int i) 0 t1:nb_fields-1
      if (t1 field i):name=tag_id
        var Pointer:Type t2 :> (t1 field i) type
        for (var Int j) 0 t2:nb_fields-1
          if (t2 field j):name=attr_id
            var Address a := addressof:st translate Byte (t1 field i):offset+(t2 field j):offset
            var Pointer:Type t3 :> (t2 field j) type
            if t3=CBool and (connection ipick (var CBool bvalue))
              a map CBool := bvalue
            eif t3=Int and (connection ipick (var Int ivalue))
              a map Int := ivalue
              console "done2" eol
            eif t3=Str and (connection ipick (var Str svalue))
              a map Str := svalue
            eif t3=Float and (connection ipick (var Float fvalue))
              a map Float := fvalue
            eif t3=Float and (connection ipick (var Int ivalue))
              a map Float := ivalue
            eif t3=Link:Font and (connection ipick (var Str svalue))
              var Link:Font font :> session font_load svalue
              if exists:font
                a map Link:Font :> font
            eif t3=(Array Link:Font) and (connection ipick (var Str svalue))
              var Link:Font font :> session font_load svalue
              if exists:font
                (a map (Array Link:Font)) 0 :> font
                (a map (Array Link:Font)) 1 :> font # FIXME
                (a map (Array Link:Font)) 2 :> font # FIXME
                (a map (Array Link:Font)) 3 :> font # FIXME
            eif t3=LayoutColor and (connection ipick open (var Ident id) (var Int r) (var Int g) (var Int b) close) and (cast id Str)="rgb" and r>=0 and r<256 and g>=0 and g<256 and b>=0 and b<256
              a map LayoutColor := color rgb r g b
            else
              console "style_set oops '" tag_id "' '" attr_id "'" eol
  connection iskip
  if not (connection iraw close)
    ierror "incorrect 'style_set' instruction"
    return

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 name))
      var Pointer:LayoutStyle st :> (session:namespace first "style "+name) map LayoutStyle
      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 j):offset
                attr size := t3 size                
                if t3=CBool and (connection ipick (var CBool bvalue))
                  attr value := addressof (new CBool bvalue)
                  s attributes += attr
                eif t3=Int and (connection ipick (var Int ivalue))
                  attr value := addressof (new Int ivalue)
                  s attributes += attr
                eif t3=Str and (connection ipick (var Str svalue))
                  attr value := addressof (new Str svalue)
                  s attributes += attr
                eif t3=Float and (connection ipick (var Float fvalue))
                  attr value := addressof (new Float fvalue)
                  s attributes += attr
                eif t3=Float and (connection ipick (var Int ivalue))
                  attr value := addressof (new Float ivalue)
                  s attributes += attr
                eif t3=Link:Font and (connection ipick (var Str svalue))
                  var Link:Font font :> session font_load svalue
                  if exists:font
                    attr value := addressof (new Link:Font font)
                    s attributes += attr
                eif t3=(Array Link:Font) and (connection ipick (var Str svalue))
                  var Link:Font font :> session font_load svalue
                  if exists:font
                    (var (Array Link:Font) fonts) size := 4
                    fonts 0 :> font ; fonts 1 :> font ; fonts 2 :> font ; fonts 3 :> font
                    attr value := addressof (new (Array Link:Font) fonts)
                    s attributes += attr
                eif t3=LayoutColor and (connection ipick open (var Ident id) (var Int r) (var Int g) (var Int b) close) and (cast id Str)="rgb" and r>=0 and r<256 and g>=0 and g<256 and b>=0 and b<256
                  attr value := addressof (new LayoutColor (color rgb r g b))
                  s attributes += attr
                else
                  console "style oops '" (cast tag_id Str) "' '" (cast attr_id Str) "'" eol
        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"