Patch title: Release 95 bulk changes
Abstract:
File: /pliant/graphic/browser/server/api.pli
Key:
    Removed line
    Added line
module "/pliant/language/compiler.pli"
module "/pliant/language/parser.pli"
module "/pliant/util/pml/io.pli"
submodule "context.pli"
module "/pliant/language/data/id.pli"
module "/pliant/storage/database.pli"
submodule "/pliant/graphic/color/rgb888.pli"
module "/pliant/util/encoding/utf8.pli"
module "/pliant/language/type/text/str32.pli"

function encode c -> e
  arg Str c e
  if default_charset_is_utf8
    e := c
  else
    e := utf8_encode c


method c para_in
  arg_rw BrowserServerContext c
  if c:inside_para=0
    c:connection oraw open (cast "para" Ident) (cast "stick" Ident) body
    c inside_para := 1
 
method c para_out
  arg_rw BrowserServerContext c
  if c:inside_para=1
    c:connection oraw close
    c inside_para := 0
 

method c text txt
  arg_rw BrowserServerContext c ; arg Str txt
  c para_in
  c:connection otag "text" txt
  c:connection otag "text" encode:txt

method c eol
  arg_rw BrowserServerContext c
  c para_in
  c:connection otag "text" (cast "[lf]" Str)


method c tag_open0 tag
  arg_rw BrowserServerContext c ; arg Ident tag
  c:connection oraw tag open

method c tag_open tag
  arg_rw BrowserServerContext c ; arg Ident tag
  c:connection oraw open tag

method c tag_open1 attr
  arg_rw BrowserServerContext c ; arg Ident attr
  c para_in
  c:connection oraw open (cast "style" Ident) (cast "text" Ident) open attr true close body

method c tag_open2 tag
  arg_rw BrowserServerContext c ; arg Ident tag
  c para_out
  c:connection oraw open tag

method c tag_ident ident
  arg_rw BrowserServerContext c ; arg Ident ident
  c:connection oraw ident

method c tag_value value
  arg_rw BrowserServerContext c ; arg CBool value
  c:connection oraw value

method c tag_value value
  arg_rw BrowserServerContext c ; arg Int value
  c:connection oraw value

method c tag_value value
  arg_rw BrowserServerContext c ; arg Str value
  c:connection oraw value

method c tag_value value
  arg_rw BrowserServerContext c ; arg Float value
  c:connection oraw value

method c tag_value value
  arg_rw BrowserServerContext c ; arg ColorRGB888 value
  c:connection oraw open (cast "rgb" Ident) (cast value:r Int) (cast value:g Int) (cast value:b Int) close


method c tag_body
  arg_rw BrowserServerContext c
  c:connection oraw body

method c tag_close
  arg_rw BrowserServerContext c
  c:connection oraw close

method c tag_close2
  arg_rw BrowserServerContext c
  c para_out
  c:connection oraw close


function attribute_tag e tag
  arg_rw Expression e ; arg Str tag
  if e:size<>2 or not (e:0 cast BrowserServerContext) or e:(e:size-1):ident<>"{}"
    return
  e:(e:size-1) compile ?
  e suckup e:0
  e add (instruction (the_function '. tag_open1' BrowserServerContext Ident) e:0:result (argument constant Ident (cast tag Ident)))
  e suckup e:(e:size-1)
  e add (instruction (the_function '. tag_close' BrowserServerContext) e:0:result)
  e set_void_result

meta '. bold' e
  attribute_tag e "bold"

meta '. italic' e
  attribute_tag e "italic"

meta '. fixed' e
  attribute_tag e "fixed"


method c para_open flags
  arg_rw BrowserServerContext c ; arg Int flags
  c para_out
  c:connection oraw open (cast (shunt (flags .and. 20h)<>0 "title" (flags .and. 10h)<>0 "header" "para") Ident)
  if (flags .and. 3)=0
    c:connection oraw (cast "stick" Ident)
  if (flags .and. 4)<>0
    c:connection oraw (cast "cursor" Ident)
  if (flags .and. 8)<>0
    c:connection oraw (cast "edit" Ident)
  c:connection oraw body
  c inside_para := 2

method c para_close
  arg_rw BrowserServerContext c
  c:connection oraw close
  c inside_para := 0

function para_tag e base
  arg_rw Expression e ; arg Int base
  if e:size<2 or not (e:0 cast BrowserServerContext) or e:(e:size-1):ident<>"{}"
    return
  var Int flags := base
  var Int i := 1
  while i<e:size-1
    if e:i:is_pure_ident and e:i:ident="stick"
      flags := flags .and. .not. (cast 3 Int)
      i += 1
    eif e:i:is_pure_ident and e:i:ident="cursor"
      flags := flags .or. 4
      i += 1
    eif e:i:is_pure_ident and e:i:ident="edit"
      flags := flags .or. 8
      i += 1
    else
      return
  e:(e:size-1) compile ?
  e suckup e:0
  e add (instruction (the_function '. para_open' BrowserServerContext Int) e:0:result (argument constant Int flags))
  e suckup e:(e:size-1)
  e add (instruction (the_function '. para_close' BrowserServerContext) e:0:result)
  e set_void_result

meta '. para' e
  para_tag e 3

method c header txt
  arg_rw BrowserServerContext c ; arg Str txt
  c para_out
  c:connection oraw open (cast "header" Ident) body open (cast "text" Ident) txt close close

meta '. header' e
  para_tag e 13h

method c title txt
  arg_rw BrowserServerContext c ; arg Str txt
  c para_out
  c:connection oraw open (cast "title" Ident) body open (cast "text" Ident) txt close close
  c:connection oraw open (cast "title" Ident) body open (cast "text" Ident) encode:txt close close

meta '. title' e
  para_tag e 23h


meta '. table' e
  if e:size<2 or not (e:0 cast BrowserServerContext) or e:(e:size-1):ident<>"{}"
    return
  e:(e:size-1) compile ?
  e suckup e:0
  e add (instruction (the_function '. tag_open2' BrowserServerContext Ident) e:0:result (argument constant Ident (cast "table" Ident)))
  var Int i := 1
  while i<e:size-1
    return
  e add (instruction (the_function '. tag_body' BrowserServerContext) e:0:result)
  e suckup e:(e:size-1)
  e add (instruction (the_function '. tag_close' BrowserServerContext) e:0:result)
  e set_void_result

meta '. row' e
  if e:size<2 or not (e:0 cast BrowserServerContext) or e:(e:size-1):ident<>"{}"
    return
  e:(e:size-1) compile ?
  e suckup e:0
  e add (instruction (the_function '. tag_open' BrowserServerContext Ident) e:0:result (argument constant Ident (cast "row" Ident)))
  var Int i := 1
  while i<e:size-1
    return
  e add (instruction (the_function '. tag_body' BrowserServerContext) e:0:result)
  e suckup e:(e:size-1)
  e add (instruction (the_function '. tag_close' BrowserServerContext) e:0:result)
  e set_void_result


meta '. cell' e
  if e:size<2 or not (e:0 cast BrowserServerContext) or e:(e:size-1):ident<>"{}"
    return
  e:(e:size-1) compile ?
  e suckup e:0
  e add (instruction (the_function '. tag_open' BrowserServerContext Ident) e:0:result (argument constant Ident (cast "cell" Ident)))
  var Int i := 1
  while i<e:size-1
    if (e:i is_pure_ident) and e:i:ident="header"
      e add (instruction (the_function '. tag_ident' BrowserServerContext Ident) e:0:result (argument constant Ident (cast "header" Ident)))
      i += 1
    else
      return
  e add (instruction (the_function '. tag_body' BrowserServerContext) e:0:result)
  e suckup e:(e:size-1)
  e add (instruction (the_function '. tag_close2' BrowserServerContext) e:0:result)
  e set_void_result

export '. text' '. eol'
export '. bold' '. italic' '. fixed'
export '. para' '. header' '. title'
export '. table' '. row' '. cell'


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


function ovar_init v t
  arg_rw Arrow v ; arg Type t
  if v=null
    v := entry_new t

meta ovar e
  var Pointer:Arrow c :> pliant_general_dictionary first "pliant function"
  if c=null or entry_type:c<>Function
    return
  var Link:Function current_function :> c map Function
  if e:size<2
    return
  var Pointer:Type t :> (e:0 constant Type) map Type
  if not exists:t
    return
  for (var Int i) 1 e:size-1
    if not e:i:is_pure_ident
      return
  for (var Int i) 1 e:size-1
    var Link:Argument v :> e local_variable e:i:ident linkto:t
    e add (instruction (the_function ovar_init Arrow Type) v (argument mapped_constant Type t))
  e set_result v access_read+access_write


constant to_index (the_function '. to string' Universal Str -> Str):generic_index

function to_string data options function -> string
  arg Universal data ; arg Str options ; arg Function function ; arg Str string
  indirect

method c input_data_tag label flags focus help run d
  arg_rw BrowserServerContext c ; arg Str label ; arg Int flags ; arg CBool focus ; arg Str help ; arg DelayedAction run ; arg Data_ d
  c para_in
  var Str var_id := generate_id
  c:connection otag "input" (string c:current_section)+" "+string:var_id
  if (d:interface get d addressof:(var Str value) Str)=failure
    value := ""
  if value<>""
    c:connection oattr "value" value
    c:connection oattr "value" encode:value
  if label<>""
    c:connection oattr "text" label
    c:connection oattr "label" encode:label
  if (flags .and. 1)<>0
    c:connection oattr "over"
  if (flags .and. 2)<>0
    c:connection oattr "password"
  if (flags .and. 4)<>0
    c:connection oattr "multiline"
  c:env_sem request
  var Link:BrowserServerSection section :> (c:env first "section "+c:current_section) map BrowserServerSection
  if not exists:section or (entry_type addressof:section)<>BrowserServerSection
    section :> new BrowserServerSection
    c:env insert "section "+c:current_section true addressof:section
  var Link:BrowserServerVariable va :> new BrowserServerVariable
  va data_path := d path
  va run := run
  section:env insert var_id true addressof:va
  if help<>""
    section:env insert var_id+" help" true addressof:(new Str help)
    section:env insert var_id+" help" true addressof:(new Str encode:help)
  c:env_sem release
  
method c input_var_tag label flags focus help run v
  arg_rw BrowserServerContext c ; arg Str label ; arg Int flags ; arg CBool focus ; arg Str help ; arg DelayedAction run ; arg Universal v
  c para_in
  var Str var_id := generate_id
  c:connection otag "input" (string c:current_section)+" "+string:var_id
  var Pointer:Function f :> (entry_type addressof:v) get_generic_method to_index
  var Str value := to_string v "db" f
  if value<>""
    c:connection oattr "value" value
    c:connection oattr "value" encode:value
  if label<>""
    c:connection oattr "label" label
    c:connection oattr "label" encode:label
  if (flags .and. 1)<>0
    c:connection oattr "over"
  if (flags .and. 2)<>0
    c:connection oattr "password"
  if (flags .and. 4)<>0
    c:connection oattr "multiline"
  if focus
    c:connection oattr "focus"
  c:env_sem request
  var Link:BrowserServerSection section :> (c:env first "section "+c:current_section) map BrowserServerSection
  if not exists:section or (entry_type addressof:section)<>BrowserServerSection
    section :> new BrowserServerSection
    c:env insert "section "+c:current_section true addressof:section
  var Link:BrowserServerVariable va :> new BrowserServerVariable
  va variable := addressof v
  va run := run
  section:env insert var_id true addressof:va
  if help<>""
    section:env insert var_id+" help" true addressof:(new Str help)
    section:env insert var_id+" help" true addressof:(new Str encode:help)
  c:env_sem release

meta '. input' e
  if e:size<3 or not (e:0 cast BrowserServerContext) or not (e:1 cast Str)
    return
  e:2 compile ?
  var CBool data := e:2 is_data
  if not data
    var Link:Type type :> e:2:result:type:real_data_type
    if not (e:2 cast type)
      return
    var Pointer:Function function :> type get_generic_method to_index
    if addressof:function=null or addressof:function=addressof:(the_function '. to string' Universal Str -> Str)
      return
  var Int flags := 0
  var Link:Argument focus :> argument constant CBool false
  var Link:Argument help :> argument constant Str ""
  var Link:Argument run :> argument constant DelayedAction (var DelayedAction no_action)
  var Int i := 3
  while i<e:size
    if e:i:ident="password"
      flags := flags .or. 2
      i += 1
    eif e:i:ident="multiline"
      flags := flags .or. 4
      i += 1
    eif e:i:ident="focus" and i+1<e:size and ((e i+1) cast CBool)
      e suckup (e i+1)
      focus :> (e i+1) result
      i += 2
    eif e:i:ident="over"
      flags := flags .or. 1
      i += 1
    eif e:i:ident="help" and i+1<e:size and ((e i+1) cast Str)
      flags := flags .or. 1
      e suckup (e i+1)
      help :> (e i+1) result
      i += 2
    eif e:i:ident="{}"
      var Link:List expressions :> new List
      expressions append (addressof e:i)
      var Link:List byaddress :> new List
      byaddress append addressof:(new Ident (cast "context" Ident))
      var Pointer:Module module :> e module
      var Address mark := module mark
      var List functions ; var Link:Type type
      e freeze expressions byaddress functions type
      module rewind mark ?
      run :> e:i:result
      i += 1
    else
      return
  e suckup e:0 ; e suckup e:1 ; e suckup e:2
  if data
    e add (instruction (the_function '. input_data_tag' BrowserServerContext Str Int CBool Str DelayedAction Data_) e:0:result e:1:result (argument constant Int flags) focus help run e:2:result)
  else
    e add (instruction (the_function '. input_var_tag' BrowserServerContext Str Int CBool Str DelayedAction Universal) e:0:result e:1:result (argument constant Int flags) focus help run e:2:result)
  e set_void_result


method c select_data_open label flags focus help run d
  arg_rw BrowserServerContext c ; arg Str label ; arg Int flags ; arg CBool focus ; arg Str help ; arg DelayedAction run ; arg Data_ d
  c para_in
  var Str var_id := generate_id
  c:connection oraw open (cast "select" Ident) (string c:current_section)+" "+string:var_id
  if (d:interface get d addressof:(var Str value) Str)=failure
    value := ""
  if value<>""
    c:connection oraw (cast "value" Ident) value
  if label<>""
    c:connection oraw (cast "label" Ident) label
  if (flags .and. 1)<>0
    c:connection oraw (cast "over" Ident)
  if focus
    c:connection oraw (cast "focus" Ident)
  c:connection oraw body
  c:env_sem request
  var Link:BrowserServerSection section :> (c:env first "section "+c:current_section) map BrowserServerSection
  if not exists:section or (entry_type addressof:section)<>BrowserServerSection
    section :> new BrowserServerSection
    c:env insert "section "+c:current_section true addressof:section
  var Link:BrowserServerVariable va :> new BrowserServerVariable
  va data_path := d path
  va run := run
  section:env insert var_id true addressof:va
  if help<>""
    section:env insert var_id+" help" true addressof:(new Str help)
    section:env insert var_id+" help" true addressof:(new Str encode:help)
  c:env_sem release

method c select_var_open label flags focus help run v
  arg_rw BrowserServerContext c ; arg Str label ; arg Int flags ; arg CBool focus ; arg Str help ; arg DelayedAction run ; arg Universal v
  c para_in
  var Str var_id := generate_id
  c:connection oraw open (cast "select" Ident) (string c:current_section)+" "+string:var_id
  var Pointer:Function f :> (entry_type addressof:v) get_generic_method to_index
  var Str value := to_string v "db" f
  if value<>""
    c:connection oraw (cast "value" Ident) value
  if label<>""
    c:connection oraw (cast "label" Ident) label
  if (flags .and. 1)<>0
    c:connection oraw (cast "over" Ident)
  c:connection oraw body
  c:env_sem request
  var Link:BrowserServerSection section :> (c:env first "section "+c:current_section) map BrowserServerSection
  if not exists:section or (entry_type addressof:section)<>BrowserServerSection
    section :> new BrowserServerSection
    c:env insert "section "+c:current_section true addressof:section
  var Link:BrowserServerVariable va :> new BrowserServerVariable
  va variable := addressof v
  va run := run
  section:env insert var_id true addressof:va
  if help<>""
    section:env insert var_id+" help" true addressof:(new Str help)
    section:env insert var_id+" help" true addressof:(new Str encode:help)
  c:env_sem release

method c select_close
  arg_rw BrowserServerContext c
  c:connection oraw close
  
meta '. select' e
  if e:size<4 or not (e:0 cast BrowserServerContext) or not (e:1 cast Str)
    return
  e:2 compile ?
  var CBool data := e:2 is_data
  if not data
    var Link:Type type :> e:2:result:type:real_data_type
    if not (e:2 cast type)
      return
    var Pointer:Function function :> type get_generic_method to_index
    if addressof:function=null or addressof:function=addressof:(the_function '. to string' Universal Str -> Str)
      return
  var Int flags := 0
  var Link:Argument focus :> argument constant CBool false
  var Link:Argument help :> argument constant Str ""
  var Link:Argument run :> argument constant DelayedAction (var DelayedAction no_action)
  var Int i := 3
  while i<e:size-1
    if e:i:ident="focus" and i+1<e:size and ((e i+1) cast CBool)
      e suckup (e i+1)
      focus :> (e i+1) result
      i += 2
    eif e:i:ident="over"
      flags := flags .or. 1
      i += 1
    eif e:i:ident="help" and i+1<e:size and ((e i+1) cast Str)
      flags := flags .or. 1
      e suckup (e i+1)
      help :> (e i+1) result
      i += 2
    eif e:i:ident="{}"
      var Link:List expressions :> new List
      expressions append (addressof e:i)
      var Link:List byaddress :> new List
      byaddress append addressof:(new Ident (cast "context" Ident))
      var Pointer:Module module :> e module
      var Address mark := module mark
      var List functions ; var Link:Type type
      e freeze expressions byaddress functions type
      module rewind mark ?
      run :> e:i:result
      i += 1
    else
      return
  (e e:size-1) compile ?
  e suckup e:0 ; e suckup e:1 ; e suckup e:2
  if data
    e add (instruction (the_function '. select_data_open' BrowserServerContext Str Int CBool Str DelayedAction Data_) e:0:result e:1:result (argument constant Int flags) focus help run e:2:result)
  else
    e add (instruction (the_function '. select_var_open' BrowserServerContext Str Int CBool Str DelayedAction Universal) e:0:result e:1:result (argument constant Int flags) focus help run e:2:result)
  e suckup (e e:size-1)
  e add (instruction (the_function '. select_close' BrowserServerContext) e:0:result)
  e set_void_result


method c option label value
  arg_rw BrowserServerContext c ; arg Str label value
  c:connection otag "option" label value
  c:connection otag "option" encode:label value


method c button_tag label key da help flags active selected
  arg_rw BrowserServerContext c ; arg Str label ; arg Str key ; arg DelayedAction da ; arg Str help ; arg Int flags ; arg CBool active selected
  c para_in
  var Str button_id := generate_id
  c:connection otag "button" (shunt active (string c:current_section)+" "+string:button_id "")
  if label<>""
    c:connection oattr "label" label
    c:connection oattr "label" encode:label
  if key<>""
    c:connection oattr "key" key
  if (flags .and. 1)<>0
    c:connection oattr "over"
  if (flags .and. 2)<>0
    c:connection oattr "stretch"
  if selected
    c:connection oattr "selected"
  if active
    c:env_sem request
    var Link:BrowserServerSection section :> (c:env first "section "+c:current_section) map BrowserServerSection
    if not exists:section or (entry_type addressof:section)<>BrowserServerSection
      section :> new BrowserServerSection
      c:env insert "section "+c:current_section true addressof:section
    var Link:DelayedAction lda :> new DelayedAction ; lda := da
    section:env insert button_id true addressof:lda
    if help<>""
      section:env insert button_id+" help" true addressof:(new Str help)
      section:env insert button_id+" help" true addressof:(new Str encode:help)
    c:env_sem release

meta '. button' e
  if e:size<3 or not (e:0 cast BrowserServerContext) or not (e:1 cast Str)
    return
  var Int flags := 0
  var Link:Argument help :> argument constant Str ""
  var Link:Argument active :> argument constant CBool true
  var Link:Argument selected :> argument constant CBool false
  var Link:Argument key :> argument constant Str ""
  var Int i := 2
  while i<e:size-1
    if not e:i:is_pure_ident or e:i:ident<>"over" and e:i:ident<>"stretch" and i+1>=e:size-1
      return
    eif e:i:ident="key" and ((e i+1) cast Str)
      e suckup (e i+1)
      key :> (e i+1) result
      i += 2
    eif e:i:ident="over"
      flags := flags .or. 1
      i += 1
    eif e:i:ident="stretch"
      flags := flags .or. 2
      i += 1
    eif e:i:ident="help" and ((e i+1) cast Str)
      e suckup (e i+1)
      flags := flags .or. 1
      help :> (e i+1) result
      i += 2
    eif e:i:ident="active" and ((e i+1) cast CBool)
      e suckup (e i+1)
      active :> (e i+1) result
      i += 2
    eif e:i:ident="selected" and ((e i+1) cast CBool)
      e suckup (e i+1)
      selected :> (e i+1) result
      i += 2
    else
      return
  var Link:List expressions :> new List
  expressions append addressof:(e e:size-1)
  var Link:List byaddress :> new List
  byaddress append addressof:(new Ident (cast "context" Ident))
  var Pointer:Module module :> e module
  var Address mark := module mark
  var List functions ; var Link:Type type
  e freeze expressions byaddress functions type
  module rewind mark ?
  e suckup e:0
  e suckup e:1
  e add (instruction (the_function '. button_tag' BrowserServerContext Str Str DelayedAction Str Int CBool CBool) e:0:result e:1:result key (e e:size-1):result help (argument constant Int flags) active selected)
  e set_void_result


method c link_tag label da
  arg_rw BrowserServerContext c ; arg Str label ; arg DelayedAction da
  var Str button_id := generate_id
  c para_in
  c:connection otag "link" label (string c:current_section)+" "+string:button_id
  c:connection otag "link" encode:label (string c:current_section)+" "+string:button_id
  c:env_sem request
  var Link:BrowserServerSection section :> (c:env first "section "+c:current_section) map BrowserServerSection
  if not exists:section or (entry_type addressof:section)<>BrowserServerSection
    section :> new BrowserServerSection
    c:env insert "section "+c:current_section true addressof:section
  var Link:DelayedAction lda :> new DelayedAction ; lda := da
  section:env insert button_id true addressof:lda
  c:env_sem release

meta '. link' e
  if e:size<3 or e:size%2<>1 or not (e:0 cast BrowserServerContext) or not (e:1 cast Str)
    return
  for (var Int i) 2 e:size-2 step 2
    return
  var Link:List expressions :> new List
  expressions append addressof:(e e:size-1)
  var Link:List byaddress :> new List
  byaddress append addressof:(new Ident (cast "context" Ident))
  var Pointer:Module module :> e module
  var Address mark := module mark
  var List functions ; var Link:Type type
  e freeze expressions byaddress functions type
  module rewind mark ?
  e suckup e:0
  e suckup e:1
  e add (instruction (the_function '. link_tag' BrowserServerContext Str DelayedAction) e:0:result e:1:result (e e:size-1):result)
  e set_void_result


export ovar '. input' '. select' '. option'
export '. button' '. link'


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


dual_keyword hook 1 1000 event 1 1

method c hook_open da
  arg_rw BrowserServerContext c ; arg DelayedAction da
  var Str hook_id := generate_id
  c:connection oraw open (cast "hook" Ident) (string c:current_section)+" "+string:hook_id
  c:connection oraw body
  c:env_sem request
  var Link:BrowserServerSection section :> (c:env first "section "+c:current_section) map BrowserServerSection
  if not exists:section or (entry_type addressof:section)<>BrowserServerSection
    section :> new BrowserServerSection
    c:env insert "section "+c:current_section true addressof:section
  var Link:DelayedAction lda :> new DelayedAction ; lda := da
  section:env insert hook_id true addressof:lda
  c:env_sem release

meta '. hook' e
  if e:size<4 or not (e:0 cast BrowserServerContext) or (e e:size-2):ident<>"event"
    return
  var Int i := 1
  while i<e:size-3
    return
  (e e:size-3) compile ?
  var Link:List expressions :> new List
  expressions append addressof:(e e:size-1)
  var Link:List byaddress :> new List
  byaddress append addressof:(new Ident (cast "context" Ident))
  var Pointer:Module module :> e module
  var Address mark := module mark
  var List functions ; var Link:Type type
  e freeze expressions byaddress functions type
  module rewind mark ?
  e suckup e:0
  e add (instruction (the_function '. hook_open' BrowserServerContext DelayedAction) e:0:result (e e:size-1):result)
  e suckup (e e:size-3)
  e add (instruction (the_function '. tag_close' BrowserServerContext) e:0:result)
  e set_void_result


method c focus_set section index
  arg_rw BrowserServerContext c ; arg Str section ; arg Int index
  c:connection otag "focus_set" section index


method c focus_save
  arg_rw BrowserServerContext c
  c:connection otag "focus_save"


method c focus_restore
  arg_rw BrowserServerContext c
  c:connection otag "focus_restore"


export '. hook' '. focus_set' '. focus_save' '. focus_restore'


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


method c style_copy src dest
  arg_rw BrowserServerContext c ; arg Str src dest
  c:connection otag "style_copy" src dest


method c style_set_bool style_id tag_id attr_id value
  arg_rw BrowserServerContext c ; arg Str style_id tag_id attr_id ; arg CBool value
  c:connection otag "style_set" style_id tag_id attr_id value

method c style_set_int style_id tag_id attr_id value
  arg_rw BrowserServerContext c ; arg Str style_id tag_id attr_id ; arg Int value
  c:connection otag "style_set" style_id tag_id attr_id value

method c style_set_str style_id tag_id attr_id value
  arg_rw BrowserServerContext c ; arg Str style_id tag_id attr_id value
  c:connection otag "style_set" style_id tag_id attr_id value

method c style_set_float style_id tag_id attr_id value
  arg_rw BrowserServerContext c ; arg Str style_id tag_id attr_id ; arg Float value
  c:connection otag "style_set" style_id tag_id attr_id value

method c style_set_color style_id tag_id attr_id value
  arg_rw BrowserServerContext c ; arg Str style_id tag_id attr_id ; arg ColorRGB888 value
  c:connection otag "style_set" style_id tag_id attr_id open (cast "rgb" Ident) (cast value:r Int) (cast value:g Int) (cast value:b Int) close

meta '. style_set' e
  if e:size<>5 or not (e:0 cast BrowserServerContext) or not (e:1 cast Str) or not e:2:is_pure_ident or not e:3:is_pure_ident
    return
  e suckup e:0
  e suckup e:1
  if (e:4 cast CBool)
    e suckup e:4
    e add (instruction (the_function '. style_set_bool' BrowserServerContext Str Str Str CBool) e:0:result e:1:result (argument constant Str e:2:ident) (argument constant Str e:3:ident) e:4:result)
  eif (e:4 cast Int)
    e suckup e:4
    e add (instruction (the_function '. style_set_int' BrowserServerContext Str Str Str Int) e:0:result e:1:result (argument constant Str e:2:ident) (argument constant Str e:3:ident) e:4:result)
  eif (e:4 cast Str)
    e suckup e:4
    e add (instruction (the_function '. style_set_str' BrowserServerContext Str Str Str Str) e:0:result e:1:result (argument constant Str e:2:ident) (argument constant Str e:3:ident) e:4:result)
  eif (e:4 cast Float)
    e suckup e:4
    e add (instruction (the_function '. style_set_float' BrowserServerContext Str Str Str Float) e:0:result e:1:result (argument constant Str e:2:ident) (argument constant Str e:3:ident) e:4:result)
  eif (e:4 cast ColorRGB888)
    e suckup e:4
    e add (instruction (the_function '. style_set_color' BrowserServerContext Str Str Str ColorRGB888) e:0:result e:1:result (argument constant Str e:2:ident) (argument constant Str e:3:ident) e:4:result)
  else
    return
  e set_void_result


meta '. style' e
  if e:size<2 or not (e:0 cast BrowserServerContext) or e:(e:size-1):ident<>"{}"
    return
  e:(e:size-1) compile ?
  e suckup e:0
  e add (instruction (the_function '. tag_open' BrowserServerContext Ident) e:0:result (argument constant Ident (cast "style" Ident)))
  var Int i := 1
  while i<e:size-1
    if e:i:is_pure_ident and e:i:ident="use" and i+1<e:size-1 and ((e i+1) cast Str)
      e add (instruction (the_function '. tag_ident' BrowserServerContext Ident) e:0:result (argument constant Ident (cast "use" Ident)))
      e suckup (e i+1)
      e add (instruction (the_function '. tag_value' BrowserServerContext Str) e:0:result (e i+1):result)
      i += 2
    eif e:i:ident<>"" and e:i:size>=2 and e:i:size%2=0
      e add (instruction (the_function '. tag_open0' BrowserServerContext Ident) e:0:result (argument constant Ident (cast e:i:ident Ident)))
      for (var Int j) 0 e:i:size-2 step 2
        if e:i:j:is_pure_ident and (e:i:(j+1) cast CBool)
          e add (instruction (the_function '. tag_ident' BrowserServerContext Ident) e:0:result (argument constant Ident (cast e:i:j:ident Ident)))
          e suckup (e:i j+1)
          e add (instruction (the_function '. tag_value' BrowserServerContext CBool) e:0:result (e:i j+1):result)
        eif e:i:j:is_pure_ident and (e:i:(j+1) cast Int)
          e add (instruction (the_function '. tag_ident' BrowserServerContext Ident) e:0:result (argument constant Ident (cast e:i:j:ident Ident)))
          e suckup (e:i j+1)
          e add (instruction (the_function '. tag_value' BrowserServerContext Int) e:0:result (e:i j+1):result)
        eif e:i:j:is_pure_ident and (e:i:(j+1) cast Str)
          e add (instruction (the_function '. tag_ident' BrowserServerContext Ident) e:0:result (argument constant Ident (cast e:i:j:ident Ident)))
          e suckup (e:i j+1)
          e add (instruction (the_function '. tag_value' BrowserServerContext Str) e:0:result (e:i j+1):result)
        eif e:i:j:is_pure_ident and (e:i:(j+1) cast Float)
          e add (instruction (the_function '. tag_ident' BrowserServerContext Ident) e:0:result (argument constant Ident (cast e:i:j:ident Ident)))
          e suckup (e:i j+1)
          e add (instruction (the_function '. tag_value' BrowserServerContext Float) e:0:result (e:i j+1):result)
        eif e:i:j:is_pure_ident and (e:i:(j+1) cast ColorRGB888)
          e add (instruction (the_function '. tag_ident' BrowserServerContext Ident) e:0:result (argument constant Ident (cast e:i:j:ident Ident)))
          e suckup (e:i j+1)
          e add (instruction (the_function '. tag_value' BrowserServerContext ColorRGB888) e:0:result (e:i j+1):result)
      e add (instruction (the_function '. tag_close' BrowserServerContext) e:0:result)
      i += 1
    else
      return
  e add (instruction (the_function '. tag_body' BrowserServerContext) e:0:result)
  e suckup (e e:size-1)
  e add (instruction (the_function '. tag_close' BrowserServerContext) e:0:result)
  e set_void_result


export '. style_copy' '. style_set' '. style'


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


meta '. window' e
  if e:size<>3 or not (e:0 cast BrowserServerContext) or not e:1:is_pure_ident or e:2:ident<>"{}"
    return
  e:2 compile ?
  e suckup e:0
  e add (instruction (the_function '. tag_open' BrowserServerContext Ident) e:0:result (argument constant Ident (cast "window" Ident)))
  e add (instruction (the_function '. tag_value' BrowserServerContext Str) e:0:result (argument constant Str e:1:ident))
  e add (instruction (the_function '. tag_body' BrowserServerContext) e:0:result)
  e suckup e:2
  e add (instruction (the_function '. tag_close2' BrowserServerContext) e:0:result)
  e set_void_result


method c section_open id inside memo
  arg_rw BrowserServerContext c ; arg Str id ; arg CBool inside ; arg_w Str memo
  memo := c current_section ; c current_section := id
  if inside
    c para_in
  else
    c para_out
  c:env_sem request
  var Link:BrowserServerSection section :> (c:env first "section "+id) map BrowserServerSection
  if not exists:section or (entry_type addressof:section)<>BrowserServerSection
    section :> new BrowserServerSection
    c:env insert "section "+id true addressof:section
  section inside := inside
  section env := var Dictionary empty_env
  c:env_sem release
  c:connection oraw open (cast "section" Ident) id body

method c section_close inside memo
  arg_rw BrowserServerContext c ; arg CBool inside ; arg Str memo
  if not inside
    c para_out
  c:connection oraw close
  c current_section := memo

function execute1 a f
  arg Address a ; arg Function f
  indirect

method c section_play id inside da
  arg_rw BrowserServerContext c ; arg Str id ; arg CBool inside ; arg DelayedAction da
  var Str memo := c current_section ; c current_section := id
  if inside
    c para_in
  else
    c para_out
  c:env_sem request
  var Link:BrowserServerSection section :> (c:env first "section "+id) map BrowserServerSection
  if not exists:section or (entry_type addressof:section)<>BrowserServerSection
    section :> new BrowserServerSection
    c:env insert "section "+id true addressof:section
  section inside := inside
  section env := var Dictionary empty_env
  section refresh := da
  c:env_sem release
  c:connection oraw open (cast "section" Ident) id body
  var Pointer:Type t :> entry_type da:parameter
  for (var Int i) 0 t:nb_fields-1
    if (t field i):name="context"
      (da:parameter translate Byte (t field i):offset) map Address := addressof c
  execute1 da:parameter da:function
  if not inside
    c para_out
  c:connection oraw close
  c current_section := memo

meta '. section' e
  if e:size<3 or not (e:0 cast BrowserServerContext) or not (e:1 cast Str)
    return
  var CBool dynamic := false
  var CBool inside := false
  var Int i := 2
  while i<e:size-1
    if e:i:ident="dynamic"
      dynamic := true
      i += 1
    eif e:i:ident="inside"
      inside := true
      i += 1
    else
      return
  if dynamic
    var Link:List expressions :> new List
    expressions append addressof:(e e:size-1)
    var Link:List byaddress :> new List
    byaddress append addressof:(new Ident (cast "context" Ident))
    var Pointer:Module module :> e module
    var Address mark := module mark
    var List functions ; var Link:Type type
    e freeze expressions byaddress functions type
    module rewind mark ?
    e suckup e:0
    e suckup e:1
    e add (instruction (the_function '. section_play' BrowserServerContext Str CBool DelayedAction) e:0:result e:1:result (argument constant CBool inside) (e e:size-1):result)
  else
    (e e:size-1) compile ?
    e suckup e:0 ; e suckup e:1
    var Link:Argument memo :> argument local Str
    e add (instruction (the_function '. section_open' BrowserServerContext Str CBool Str) e:0:result e:1:result (argument constant CBool inside) memo)
    e suckup (e e:size-1)
    e add (instruction (the_function '. section_close' BrowserServerContext CBool Str) e:0:result (argument constant CBool inside) memo)
  e set_void_result


method c section_replay id
  arg_rw BrowserServerContext c ; arg Str id
  c:env_sem request
  var Link:BrowserServerSection section :> (c:env first "section "+id) map BrowserServerSection
  if exists:section and (entry_type addressof:section)=BrowserServerSection and (exists section:refresh:function)
    section env := var Dictionary empty_env
    var DelayedAction da := section refresh
    c:env_sem release
    var Str memo_section := c current_section ; c current_section := id
    var Int memo_inside_para := c inside_para ; c inside_para := shunt section:inside 2 0
    c:connection oraw open (cast "section_overwrite" Ident) id body
    var Pointer:Type t :> entry_type da:parameter
    for (var Int i) 0 t:nb_fields-1
      if (t field i):name="context"
        (da:parameter translate Byte (t field i):offset) map Address := addressof c
    execute1 da:parameter da:function
    c para_out
    c:connection oraw close
    c current_section := memo_section
    c inside_para := memo_inside_para
  else
    c:env_sem release


method c section_reopen tag id memo1 memo2
  arg_rw BrowserServerContext c ; arg Str tag id ; arg_w Str memo1 ; arg_w Int memo2
  c:env_sem request
  var Link:BrowserServerSection section :> (c:env first "section "+id) map BrowserServerSection
  if exists:section and (entry_type addressof:section)=BrowserServerSection
    if tag="section_overwrite"
      section env := var Dictionary empty_env
    c:env_sem release
    memo1 := c current_section ; c current_section := id
    memo2 := c:inside_para ; c inside_para := shunt section:inside 2 0
    c:connection oraw open (cast tag Ident) id body
  else
    c:env_sem release
    memo2 := undefined

method c section_reclose memo1 memo2
  arg_rw BrowserServerContext c ; arg Str memo1 ; arg Int memo2
  if memo2<>undefined
    c para_out
    c:connection oraw close
    c current_section := memo1
    c inside_para := memo2

meta '. section_overwrite' e
  if e:size<>3 or not (e:0 cast BrowserServerContext) or not (e:1 cast Str) or e:2:ident<>"{}"
    return
  e:2 compile ?
  e suckup e:0 ; e suckup e:1
  var Link:Argument memo1 :> argument local Str
  var Link:Argument memo2 :> argument local Int
  e add (instruction (the_function '. section_reopen' BrowserServerContext Str Str Str Int) e:0:result (argument constant Str "section_overwrite") e:1:result memo1 memo2)
  e suckup e:2
  e add (instruction (the_function '. section_reclose' BrowserServerContext Str Int) e:0:result memo1 memo2)
  e set_void_result


meta '. section_head' e
  if e:size<>3 or not (e:0 cast BrowserServerContext) or not (e:1 cast Str) or e:2:ident<>"{}"
    return
  e:2 compile ?
  e suckup e:0 ; e suckup e:1
  var Link:Argument memo1 :> argument local Str
  var Link:Argument memo2 :> argument local Int
  e add (instruction (the_function '. section_reopen' BrowserServerContext Str Str Str Int) e:0:result (argument constant Str "section_head") e:1:result memo1 memo2)
  e suckup e:2
  e add (instruction (the_function '. section_reclose' BrowserServerContext Str Int) e:0:result memo1 memo2)
  e set_void_result


meta '. section_tail' e
  if e:size<>3 or not (e:0 cast BrowserServerContext) or not (e:1 cast Str) or e:2:ident<>"{}"
    return
  e:2 compile ?
  e suckup e:0 ; e suckup e:1
  var Link:Argument memo1 :> argument local Str
  var Link:Argument memo2 :> argument local Int
  e add (instruction (the_function '. section_reopen' BrowserServerContext Str Str Str Int) e:0:result (argument constant Str "section_tail") e:1:result memo1 memo2)
  e suckup e:2
  e add (instruction (the_function '. section_reclose' BrowserServerContext Str Int) e:0:result memo1 memo2)
  e set_void_result


meta '. section_before' e
  if e:size<>3 or not (e:0 cast BrowserServerContext) or not (e:1 cast Str) or e:2:ident<>"{}"
    return
  e:2 compile ?
  e suckup e:0 ; e suckup e:1
  var Link:Argument memo1 :> argument local Str
  var Link:Argument memo2 :> argument local Int
  e add (instruction (the_function '. section_reopen' BrowserServerContext Str Str Str Int) e:0:result (argument constant Str "section_before") e:1:result memo1 memo2)
  e suckup e:2
  e add (instruction (the_function '. section_reclose' BrowserServerContext Str Int) e:0:result memo1 memo2)
  e set_void_result


meta '. section_after' e
  if e:size<>3 or not (e:0 cast BrowserServerContext) or not (e:1 cast Str) or e:2:ident<>"{}"
    return
  e:2 compile ?
  e suckup e:0 ; e suckup e:1
  var Link:Argument memo1 :> argument local Str
  var Link:Argument memo2 :> argument local Int
  e add (instruction (the_function '. section_reopen' BrowserServerContext Str Str Str Int) e:0:result (argument constant Str "section_after") e:1:result memo1 memo2)
  e suckup e:2
  e add (instruction (the_function '. section_reclose' BrowserServerContext Str Int) e:0:result memo1 memo2)
  e set_void_result


method c section_delete name
  arg_rw BrowserServerContext c ; arg Str name
  c:connection otag "section_delete" name
  c:connection flush anytime


method c allowed name -> a
  arg_rw BrowserServerContext c ; arg Str name ; arg CBool a
  a := c:user_is_admin or (c:user_rights first name)<>null and name<>""


method c url_call url
  arg_rw BrowserServerContext c ; arg Str url
  c:connection otag "url_call" url
  c:connection flush anytime
  
method c url_return
  arg_rw BrowserServerContext c
  c:connection otag "url_return"
  c:connection flush anytime
  

method c browser_thread_start da
  arg_rw BrowserServerContext c ; arg DelayedAction da
  var Str id := generate_id
  var BrowserPendingThread p
  p action := da
  p env_sem :> c env_sem
  p env :> c env
  browser_thread_sem request
  browser_thread_dict insert id p
  browser_thread_sem release
  c:connection otag "thread_create" id
  
meta '. browser_thread' e
  if e:size<>2 or not (e:0 cast BrowserServerContext)
    return
  var Link:List expressions :> new List
  expressions append (addressof e:1)
  var Link:List byaddress :> new List
  byaddress append addressof:(new Ident (cast "context" Ident))
  var Pointer:Module module :> e module
  var Address mark := module mark
  var List functions ; var Link:Type type
  e freeze expressions byaddress functions type
  module rewind mark
  e suckup e:0
  e add (instruction (the_function '. browser_thread_start' BrowserServerContext DelayedAction) e:0:result e:1:result)
  e set_void_result


method c flush
  arg_rw BrowserServerContext c
  c:connection flush anytime


export '. window'
export '. section' '. section_replay' '. section_overwrite'
export '. section_head' '. section_tail' '. section_before' '. section_after'
export '. section_delete'
export '. url_call' '. url_return'
export '. browser_thread' '. flush'

export '. para_in' '. para_out'