Patch title: Release 90 bulk changes
Abstract:
File: /protocol/http/style/common.pli
Key:
    Removed line
    Added line
   
module "/pliant/language/compiler.pli"
module "/pliant/language/context.pli"
module "/pliant/language/stream.pli"
module "/pliant/admin/file.pli"
module "/pliant/protocol/http/server.pli"
module "/pliant/admin/md5.pli"
submodule "/pliant/graphic/color/rgb888.pli"
submodule "/pliant/protocol/http/stack.pli"


public 
module "/pliant/language/compiler.pli"
module "/pliant/language/context.pli"
module "/pliant/language/stream.pli"
module "/pliant/admin/file.pli"
module "/pliant/protocol/http/server.pli"
module "/pliant/admin/md5.pli"
submodule "/pliant/graphic/color/rgb888.pli"
submodule "/pliant/protocol/http/stack.pli"


public 
  gvar Dictionary html_attr_dict
  gvar Sem html_attr_dict_sem
  gvar Dictionary tag_attr_dict
  gvar Sem tag_attr_dict_sem


type HtmlAttribute
type TagAttribute
  field Int index <- undefined ; field Link:Type type ; fiel
  field Str pliant_id ; field Str html_id
  field CBool encode <- false
  field uInt flag <- 0
  field Array:Str sequence

  field Int index <- undefined ; field Link:Type type ; fiel
  field Str pliant_id ; field Str html_id
  field CBool encode <- false
  field uInt flag <- 0
  field Array:Str sequence

type HtmlTag
type TagPrototype
  if pliant_debugging_level>=1
    field ListingPosition position
  field Int tag_open_index tag_close_index
  field Str pliant_id html_id
  field Dictionary attributes
  field Array:Str required
  field CBool subpage <- false ; field Int subpage_index ; f
  field CBool body <- false
  field CBool hidden <- false
  field CBool newline <- false

  if pliant_debugging_level>=1
    field ListingPosition position
  field Int tag_open_index tag_close_index
  field Str pliant_id html_id
  field Dictionary attributes
  field Array:Str required
  field CBool subpage <- false ; field Int subpage_index ; f
  field CBool body <- false
  field CBool hidden <- false
  field CBool newline <- false

export HtmlTag
export TagPrototype




  'pliant watch' HtmlTag true := "000080"
  'pliant watch' TagPrototype true := "000080"

  method ht 'get position' -> pos

  method ht 'get position' -> pos
    oarg HtmlTag ht; arg ListingPosition pos
    oarg TagPrototype ht; arg ListingPosition pos
    return ht:position


method p write_attributes
  arg_rw HtmlPage p
    return ht:position


method p write_attributes
  arg_rw HtmlPage p
  p:html_stack walk (var Str id) (var Str value)
  while (p:html_stack another id value)
  p:tag_stack walk (var Str id) (var Str value)
  while (p:tag_stack another id value)
    p write " "
    p write id
    p write "=[dq]"
    p write value
    p write "[dq]"


method p map_attribute index -> a
  arg HtmlPage p ; arg Int index ; arg Address a
    p write " "
    p write id
    p write "=[dq]"
    p write value
    p write "[dq]"


method p map_attribute index -> a
  arg HtmlPage p ; arg Int index ; arg Address a
  a := p:html_stack map index
  a := p:tag_stack map index

meta '' e
  if e:size=2 and e:1:is_pure_ident

meta '' e
  if e:size=2 and e:1:is_pure_ident
    var Link:HtmlTag t :> (pliant_general_dictionary first "
    if exists:t and (entry_type addressof:t)=HtmlTag
      var Link:HtmlAttribute a :> (t:attributes first e:1:id
    var Link:TagPrototype t :> (pliant_general_dictionary first "pliant current tag") map TagPrototype
    if exists:t and (entry_type addressof:t)=TagPrototype
      var Link:TagAttribute a :> (t:attributes first e:1:ident) map TagAttribute
      if exists:a and (exists a:type) and (e:0 cast HtmlPage
        e suckup e:0
        var Link:Argument r :> argument local (pointerto a:t
        e add (instruction (the_function '. map_attribute' H
        e set_result r access_read+access_write
      eif t:subpage and e:1:ident=t:subpage_id and (e:0 cast
        e suckup e:0
        var Link:Argument r :> argument local Pointer:Str
        e add (instruction (the_function '. map_attribute' H
        e set_result r access_read+access_write

meta '. attribute' e
  if e:size=3 and e:1:is_pure_ident and e:2:is_pure_ident
    var Pointer:Arrow c :> e:module first ". "+e:1:ident
      if exists:a and (exists a:type) and (e:0 cast HtmlPage
        e suckup e:0
        var Link:Argument r :> argument local (pointerto a:t
        e add (instruction (the_function '. map_attribute' H
        e set_result r access_read+access_write
      eif t:subpage and e:1:ident=t:subpage_id and (e:0 cast
        e suckup e:0
        var Link:Argument r :> argument local Pointer:Str
        e add (instruction (the_function '. map_attribute' H
        e set_result r access_read+access_write

meta '. attribute' e
  if e:size=3 and e:1:is_pure_ident and e:2:is_pure_ident
    var Pointer:Arrow c :> e:module first ". "+e:1:ident
    while c<>null and entry_type:c<>HtmlTag
    while c<>null and entry_type:c<>TagPrototype
      c :> e:module next ". "+e:1:ident c
    if c<>null
      c :> e:module next ". "+e:1:ident c
    if c<>null
      var Link:HtmlTag t :> c map HtmlTag
      var Link:HtmlAttribute a :> (t:attributes first e:2:id
      var Link:TagPrototype t :> c map TagPrototype
      var Link:TagAttribute a :> (t:attributes first e:2:ident) map TagAttribute
      if exists:a and (exists a:type) and (e:0 cast HtmlPage
        e suckup e:0
        var Link:Argument r :> argument local (pointerto a:t
        e add (instruction (the_function '. map_attribute' H
        e set_result r access_read+access_write
      eif t:subpage and e:2:ident=t:subpage_id and (e:0 cast
        e suckup e:0
        var Link:Argument r :> argument local Pointer:Str
        e add (instruction (the_function '. map_attribute' H
        e set_result r access_read+access_write

method p push_attribute index value type
  arg_rw HtmlPage p ; arg Int index ; arg Universal value ; 
      if exists:a and (exists a:type) and (e:0 cast HtmlPage
        e suckup e:0
        var Link:Argument r :> argument local (pointerto a:t
        e add (instruction (the_function '. map_attribute' H
        e set_result r access_read+access_write
      eif t:subpage and e:2:ident=t:subpage_id and (e:0 cast
        e suckup e:0
        var Link:Argument r :> argument local Pointer:Str
        e add (instruction (the_function '. map_attribute' H
        e set_result r access_read+access_write

method p push_attribute index value type
  arg_rw HtmlPage p ; arg Int index ; arg Universal value ; 
  p:html_stack push index addressof:value type
  p:tag_stack push index addressof:value type

meta '. push' e
  if e:size=3 and e:1:is_pure_ident

meta '. push' e
  if e:size=3 and e:1:is_pure_ident
    var Link:HtmlTag t :> (pliant_general_dictionary first "
    if exists:t and (entry_type addressof:t)=HtmlTag
      var Link:HtmlAttribute a :> (t:attributes first e:1:id
    var Link:TagPrototype t :> (pliant_general_dictionary first "pliant current tag") map TagPrototype
    if exists:t and (entry_type addressof:t)=TagPrototype
      var Link:TagAttribute a :> (t:attributes first e:1:ident) map TagAttribute
      if exists:a and (exists a:type) and (e:0 cast HtmlPage
        e suckup e:0
        e suckup e:2
        e add (instruction (the_function '. push_attribute' 
        e set_void_result
  eif e:size=4 and e:1:is_pure_ident and e:2:is_pure_ident
    var Pointer:Arrow c :> e:module first ". "+e:1:ident
      if exists:a and (exists a:type) and (e:0 cast HtmlPage
        e suckup e:0
        e suckup e:2
        e add (instruction (the_function '. push_attribute' 
        e set_void_result
  eif e:size=4 and e:1:is_pure_ident and e:2:is_pure_ident
    var Pointer:Arrow c :> e:module first ". "+e:1:ident
    while c<>null and entry_type:c<>HtmlTag
    while c<>null and entry_type:c<>TagPrototype
      c :> e:module next ". "+e:1:ident c
    if c<>null
      c :> e:module next ". "+e:1:ident c
    if c<>null
      var Link:HtmlTag t :> c map HtmlTag
      var Link:HtmlAttribute a :> (t:attributes first e:2:id
      var Link:TagPrototype t :> c map TagPrototype
      var Link:TagAttribute a :> (t:attributes first e:2:ident) map TagAttribute
      if exists:a and (exists a:type) and (e:0 cast HtmlPage
        e suckup e:0
        e suckup e:3
        e add (instruction (the_function '. push_attribute' 
        e set_void_result

meta has e
  if e:size=1 and e:0:is_pure_ident
      if exists:a and (exists a:type) and (e:0 cast HtmlPage
        e suckup e:0
        e suckup e:3
        e add (instruction (the_function '. push_attribute' 
        e set_void_result

meta has e
  if e:size=1 and e:0:is_pure_ident
    var Link:HtmlTag t :> (pliant_general_dictionary first "
    if exists:t and (entry_type addressof:t)=HtmlTag
      var Link:HtmlAttribute a :> (t:attributes first e:0:id
    var Link:TagPrototype t :> (pliant_general_dictionary first "pliant current tag") map TagPrototype
    if exists:t and (entry_type addressof:t)=TagPrototype
      var Link:TagAttribute a :> (t:attributes first e:0:ident) map TagAttribute
      if exists:a and a:flag<>0
        e compile_as (expression immediat (flags .and. flag)
 
export '. attribute' '' '. push' has


method p tag_hook_prototype tag flags fun
      if exists:a and a:flag<>0
        e compile_as (expression immediat (flags .and. flag)
 
export '. attribute' '' '. push' has


method p tag_hook_prototype tag flags fun
  arg_rw HtmlPage p ; arg HtmlTag tag ; arg uInt flags ; arg
  arg_rw HtmlPage p ; arg TagPrototype tag ; arg uInt flags ; arg Function fun
  indirect

method p record_tag_hook index hook
  arg_rw HtmlPage p ; arg Int index ; arg Function hook
  var Pointer:Function ptr :> hook
  indirect

method p record_tag_hook index hook
  arg_rw HtmlPage p ; arg Int index ; arg Function hook
  var Pointer:Function ptr :> hook
  p:html_stack push index (addressof Pointer:Function ptr) L
  p:tag_stack push index (addressof Pointer:Function ptr) Link:Function


named_expression style_tag_prototype
named_expression tag_html_prototype
  method page 'pliant style tag function' tag flags
  method page 'pliant style tag function' tag flags
    arg_rw HtmlPage page ; arg HtmlTag tag ; arg uInt flags
    arg_rw HtmlPage page ; arg TagPrototype tag ; arg uInt flags
    body

    body

function style_tag_meta e open
function tag_html_meta e open
  arg_rw Expression e ; arg CBool open
  if e:size=3 and (e:0 cast HtmlPage) and e:1:is_pure_ident 
    var Pointer:Arrow c :> pliant_general_dictionary first "
  arg_rw Expression e ; arg CBool open
  if e:size=3 and (e:0 cast HtmlPage) and e:1:is_pure_ident 
    var Pointer:Arrow c :> pliant_general_dictionary first "
    while c<>null and entry_type:c<>HtmlTag
    while c<>null and entry_type:c<>TagPrototype
      c :>  pliant_general_dictionary next ". "+e:1:ident c
      c :>  pliant_general_dictionary next ". "+e:1:ident c
    if c<>null and entry_type:c=HtmlTag
      var Link:HtmlTag t :> c map HtmlTag
    if c<>null and entry_type:c=TagPrototype
      var Link:TagPrototype t :> c map TagPrototype
      var Address mark := e:module mark
      e:module define "pliant current tag" addressof:t
      var Address mark := e:module mark
      e:module define "pliant current tag" addressof:t
      var Link:Expression ee :> expression duplicate style_t
      var Link:Expression ee :> expression duplicate tag_html_prototype substitute body e:2 near e
      error_push_record (var ErrorRecord er) error_filter_al
      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 firs
      e:module rewind mark
      if exists:f
        var Link:Expression body :> null map Expression
      error_push_record (var ErrorRecord er) error_filter_al
      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 firs
      e:module rewind mark
      if exists:f
        var Link:Expression body :> null map Expression
        var Bool ok := track_expression style_tag_prototype 
        var Bool ok := track_expression tag_html_prototype "body" ee body
        check ok
        copy_properties body e:2
        pliant_general_dictionary remove ". pliant style tag
        e suckup e:0
        e add (instruction (the_function '. record_tag_hook'
        e set_void_result

        check ok
        copy_properties body e:2
        pliant_general_dictionary remove ". pliant style tag
        e suckup e:0
        e add (instruction (the_function '. record_tag_hook'
        e set_void_result

meta '. style_tag' e
  style_tag_meta e true
meta '. tag_html' e
  tag_html_meta e true


meta '. style_open' e
  style_tag_meta e true
meta '. tag_html_open' e
  tag_html_meta e true


meta '. style_close' e
  style_tag_meta e false
meta '. tag_html_close' e
  tag_html_meta e false


export '. style_tag' '. style_open' '. style_close'
export '. tag_html' '. tag_html_open' '. tag_html_close'



method p tag_begin
  arg_rw HtmlPage p



method p tag_begin
  arg_rw HtmlPage p
  p:html_stack mark
  p:tag_stack mark

method p set_attribute index value type
  arg_rw HtmlPage p ; arg Int index ; arg Universal value ; 

method p set_attribute index value type
  arg_rw HtmlPage p ; arg Int index ; arg Universal value ; 
  p:html_stack push index addressof:value type
  p:tag_stack push index addressof:value type

method p encode_attribute index value
  arg_rw HtmlPage p ; arg Int index ; arg Str value
  var Str encoded := html_encode value

method p encode_attribute index value
  arg_rw HtmlPage p ; arg Int index ; arg Str value
  var Str encoded := html_encode value
  p:html_stack push index addressof:encoded Str
  p:tag_stack push index addressof:encoded Str

method p set_extra id value
  arg_rw HtmlPage p ; arg Str id value

method p set_extra id value
  arg_rw HtmlPage p ; arg Str id value
  p:html_stack set id value
  p:tag_stack set id value

method p set_extra id u f
  arg_rw HtmlPage p ; arg Str id ; arg Universal u ; arg Fun

method p set_extra id u f
  arg_rw HtmlPage p ; arg Str id ; arg Universal u ; arg Fun
  p:html_stack set id (to_string u "html" f)
  p:tag_stack set id (to_string u "html" f)

method p set_subpage index id context
  arg_rw HtmlPage p ; arg Int index ; arg Str id context
  var Str url := "button*0*0*"+id+"*"+(p:request cipher cont

method p set_subpage index id context
  arg_rw HtmlPage p ; arg Int index ; arg Str id context
  var Str url := "button*0*0*"+id+"*"+(p:request cipher cont
  p:html_stack push index addressof:url Str
  p:tag_stack push index addressof:url Str

method p tag_open tag flags

method p tag_open tag flags
  arg_rw HtmlPage p ; arg HtmlTag tag ; arg uInt flags
  p tag_hook_prototype tag flags ((p:html_stack map tag:tag_
  arg_rw HtmlPage p ; arg TagPrototype tag ; arg uInt flags
  p tag_hook_prototype tag flags ((p:tag_stack map tag:tag_open_index) map Pointer:Function)

method p tag_close tag flags

method p tag_close tag flags
  arg_rw HtmlPage p ; arg HtmlTag tag ; arg uInt flags
  p tag_hook_prototype tag flags ((p:html_stack map tag:tag_
  p:html_stack rewind
  arg_rw HtmlPage p ; arg TagPrototype tag ; arg uInt flags
  p tag_hook_prototype tag flags ((p:tag_stack map tag:tag_close_index) map Pointer:Function)
  p:tag_stack rewind

method p tag_end
  arg_rw HtmlPage p

method p tag_end
  arg_rw HtmlPage p
  p:html_stack rewind
  p:tag_stack rewind

function active_type t access e

function active_type t access e
  arg HtmlTag t ; arg Int access ; arg_rw Expression e
  arg TagPrototype t ; arg Int access ; arg_rw Expression e
  if t:hidden
    return
  if e:size<1 or not (e:0 cast HtmlPage)
    return
  e suckup e:0
  e add (instruction (the_function '. tag_begin' HtmlPage) e
  var uInt flags := 0
  var Int i := 1 ; var Int stop := e:size-(shunt t:body or t
  for (var Int j) 0 t:required:size-1
  if t:hidden
    return
  if e:size<1 or not (e:0 cast HtmlPage)
    return
  e suckup e:0
  e add (instruction (the_function '. tag_begin' HtmlPage) e
  var uInt flags := 0
  var Int i := 1 ; var Int stop := e:size-(shunt t:body or t
  for (var Int j) 0 t:required:size-1
    var Link:HtmlAttribute a :> (t:attributes first t:requir
    var Link:TagAttribute a :> (t:attributes first t:required:j) map TagAttribute
    if (exists a:type)
      if i>=stop or not (e:i cast a:type)
        return
      e suckup e:i
      if a:encode
        if a:type=Str
          e add (instruction (the_function '. encode_attribu
        else
          return
      else
        e add (instruction (the_function '. set_attribute' H
    eif i>=stop or e:i:ident<>a:pliant_id
      return
    flags += a flag
    i += 1
  while i<stop
    if e:i:is_pure_ident
    if (exists a:type)
      if i>=stop or not (e:i cast a:type)
        return
      e suckup e:i
      if a:encode
        if a:type=Str
          e add (instruction (the_function '. encode_attribu
        else
          return
      else
        e add (instruction (the_function '. set_attribute' H
    eif i>=stop or e:i:ident<>a:pliant_id
      return
    flags += a flag
    i += 1
  while i<stop
    if e:i:is_pure_ident
      var Link:HtmlAttribute a :> (t:attributes first e:i:id
      var Link:TagAttribute a :> (t:attributes first e:i:ident) map TagAttribute
      if exists:a
        if a:sequence:size>0
          for (var Int j) 0 a:sequence:size-1
      if exists:a
        if a:sequence:size>0
          for (var Int j) 0 a:sequence:size-1
            var Link:HtmlAttribute b :> (t:attributes first 
            var Link:TagAttribute b :> (t:attributes first a:sequence:j) map TagAttribute
            if not exists:b or not (exists b:type)
              return
            i += 1
            if i>=stop or not (e:i cast b:type)
              return
            e suckup e:i
            if b:encode
              if b:type=Str
                e add (instruction (the_function '. encode_a
              else
                return
            else
              e add (instruction (the_function '. set_attrib
            flags += b flag
        eif (exists a:type)
          i += 1
          if i>=stop or not (e:i cast a:type)
            return
          e suckup e:i
          if a:encode
            if a:type=Str
              e add (instruction (the_function '. encode_att
            else
              return
          else
            e add (instruction (the_function '. set_attribut
        flags += a flag
      else
        i += 1
        if i>=stop
          return
        e:i compile ?
        var Pointer:Type rt :> e:i:result:type:real_data_typ
        e:i cast rt ?
        e suckup e:i
        if rt<>Str
          var Link:Function function :> rt get_generic_metho
          if addressof:function=null or addressof:function=a
            return
          e add (instruction (the_function '. set_extra' Htm
        else
          e add (instruction (the_function '. set_extra' Htm
    eif e:i:ident="style" and e:i:size>=3 and e:i:0:is_pure_
      var Pointer:Arrow c :> e:module first ". "+e:i:0:ident
            if not exists:b or not (exists b:type)
              return
            i += 1
            if i>=stop or not (e:i cast b:type)
              return
            e suckup e:i
            if b:encode
              if b:type=Str
                e add (instruction (the_function '. encode_a
              else
                return
            else
              e add (instruction (the_function '. set_attrib
            flags += b flag
        eif (exists a:type)
          i += 1
          if i>=stop or not (e:i cast a:type)
            return
          e suckup e:i
          if a:encode
            if a:type=Str
              e add (instruction (the_function '. encode_att
            else
              return
          else
            e add (instruction (the_function '. set_attribut
        flags += a flag
      else
        i += 1
        if i>=stop
          return
        e:i compile ?
        var Pointer:Type rt :> e:i:result:type:real_data_typ
        e:i cast rt ?
        e suckup e:i
        if rt<>Str
          var Link:Function function :> rt get_generic_metho
          if addressof:function=null or addressof:function=a
            return
          e add (instruction (the_function '. set_extra' Htm
        else
          e add (instruction (the_function '. set_extra' Htm
    eif e:i:ident="style" and e:i:size>=3 and e:i:0:is_pure_
      var Pointer:Arrow c :> e:module first ". "+e:i:0:ident
      while c<>null and entry_type:c<>HtmlTag
      while c<>null and entry_type:c<>TagPrototype
        c :> e:module next ". "+e:i:0:ident c
      if c=null
        return
      var Int j := 1
      while j<e:i:size
        c :> e:module next ". "+e:i:0:ident c
      if c=null
        return
      var Int j := 1
      while j<e:i:size
        var Link:HtmlAttribute a :> ((c map HtmlTag):attribu
        var Link:TagAttribute a :> ((c map TagPrototype):attributes first e:i:j:ident) map TagAttribute
        if not exists:a
          return
        if a:sequence:size>0
          for (var Int k) 0 a:sequence:size-1
        if not exists:a
          return
        if a:sequence:size>0
          for (var Int k) 0 a:sequence:size-1
            var Link:HtmlAttribute b :> ((c map HtmlTag):att
            var Link:TagAttribute b :> ((c map TagPrototype):attributes first a:sequence:k) map TagAttribute
            if not exists:b or not (exists b:type)
              return
            j += 1
            if j>=e:i:size or not (e:i:j cast b:type)
              return
            e suckup e:i:j
            if b:encode
              if b:type=Str
                e add (instruction (the_function '. encode_a
              else
                return
            else
              e add (instruction (the_function '. set_attrib
        eif (exists a:type)
          j += 1
          if j>=e:i:size or not (e:i:j cast a:type)
            return
          e suckup e:i:j
          if a:encode
            if a:type=Str
              e add (instruction (the_function '. encode_att
            else
              return
          else
            e add (instruction (the_function '. set_attribut
        else
          return
        j += 1
    else
      return
    i += 1
  if i<>stop
    return
  if t:subpage
    if not (button_expression e "" (var Str button_id) (var 
      return
    e add (instruction (the_function '. set_subpage' HtmlPag
            if not exists:b or not (exists b:type)
              return
            j += 1
            if j>=e:i:size or not (e:i:j cast b:type)
              return
            e suckup e:i:j
            if b:encode
              if b:type=Str
                e add (instruction (the_function '. encode_a
              else
                return
            else
              e add (instruction (the_function '. set_attrib
        eif (exists a:type)
          j += 1
          if j>=e:i:size or not (e:i:j cast a:type)
            return
          e suckup e:i:j
          if a:encode
            if a:type=Str
              e add (instruction (the_function '. encode_att
            else
              return
          else
            e add (instruction (the_function '. set_attribut
        else
          return
        j += 1
    else
      return
    i += 1
  if i<>stop
    return
  if t:subpage
    if not (button_expression e "" (var Str button_id) (var 
      return
    e add (instruction (the_function '. set_subpage' HtmlPag
  e add (instruction (the_function '. tag_open' HtmlPage Htm
  e add (instruction (the_function '. tag_open' HtmlPage TagPrototype uInt) e:0:result (argument mapped_constant TagPrototype t) (argument constant uInt flags))
  if t:body
    e:i compile ?
    e suckup e:i
  if t:tag_close_index<>undefined
  if t:body
    e:i compile ?
    e suckup e:i
  if t:tag_close_index<>undefined
    e add (instruction (the_function '. tag_close' HtmlPage 
    e add (instruction (the_function '. tag_close' HtmlPage TagPrototype uInt) e:0:result (argument mapped_constant TagPrototype t) (argument constant uInt flags))
  else
    e add (instruction (the_function '. tag_end' HtmlPage) e
  e set_void_result


function the_tag e -> t
  else
    e add (instruction (the_function '. tag_end' HtmlPage) e
  e set_void_result


function the_tag e -> t
  arg Expression e ; arg_C HtmlTag t
  arg Expression e ; arg_C TagPrototype t
  var Pointer:Arrow c :> pliant_general_dictionary first "pl
  var Pointer:Arrow c :> pliant_general_dictionary first "pl
  if c<>null and entry_type:c=HtmlTag
    t :> c map HtmlTag
  if c<>null and entry_type:c=TagPrototype
    t :> c map TagPrototype
  else
  else
    t :> null map HtmlTag
    t :> null map TagPrototype

meta sequence e
  if e:size<>2 or not e:0:is_pure_ident
    return

meta sequence e
  if e:size<>2 or not e:0:is_pure_ident
    return
  var Link:HtmlTag t :> the_tag e
  var Link:TagPrototype t :> the_tag e
  if not exists:t
    return
  if e:size<1 or not e:0:is_pure_ident
    return
  var Address mark := e:module mark
  if not exists:t
    return
  if e:size<1 or not e:0:is_pure_ident
    return
  var Address mark := e:module mark
  var Link:HtmlAttribute a :> new HtmlAttribute
  var Link:TagAttribute a :> new TagAttribute
  a pliant_id := e:0 ident ; a html_id := a pliant_id
  e:module define "pliant current html sequence" addressof:a
  e:1 compile
  e:module rewind mark ?
  if (t:attributes first a:pliant_id)=null
    a flag := 2^t:attributes:count
    t:attributes insert a:pliant_id true addressof:a
  e set_void_result

meta attr e
  a pliant_id := e:0 ident ; a html_id := a pliant_id
  e:module define "pliant current html sequence" addressof:a
  e:1 compile
  e:module rewind mark ?
  if (t:attributes first a:pliant_id)=null
    a flag := 2^t:attributes:count
    t:attributes insert a:pliant_id true addressof:a
  e set_void_result

meta attr e
  var Link:HtmlTag t :> the_tag e
  var Link:TagPrototype t :> the_tag e
  if not exists:t
    return
  if e:size<1 or not e:0:is_pure_ident
    return
  if not exists:t
    return
  if e:size<1 or not e:0:is_pure_ident
    return
  var Link:HtmlAttribute a :> new HtmlAttribute
  var Link:TagAttribute a :> new TagAttribute
  a pliant_id := e:0 ident ; a html_id := a pliant_id
  var Int i := 1
  while i<e:size
    if (exists a:type) and a:type=Str and e:i:ident="encode"
      a encode := true ; i += 1
    eif e:i:ident="->" and i+1<e:size and e:(i+1):ident<>""
      a html_id := e:(i+1) ident ; i += 2
    eif (e:i constant Type)<>null
      a type :> (e:i constant Type) map Type ; i += 1
    eif (exists a:type) and (e:i constant a:type)<>null
      a default := entry_new a:type
      a:type copy_instance (e:i constant a:type) a:default
      i += 1
    else
      return
  if (t:attributes first a:pliant_id)=null
    a flag := 2^t:attributes:count
    t:attributes insert a:pliant_id true addressof:a
    var Pointer:Arrow c :> pliant_general_dictionary first "
  a pliant_id := e:0 ident ; a html_id := a pliant_id
  var Int i := 1
  while i<e:size
    if (exists a:type) and a:type=Str and e:i:ident="encode"
      a encode := true ; i += 1
    eif e:i:ident="->" and i+1<e:size and e:(i+1):ident<>""
      a html_id := e:(i+1) ident ; i += 2
    eif (e:i constant Type)<>null
      a type :> (e:i constant Type) map Type ; i += 1
    eif (exists a:type) and (e:i constant a:type)<>null
      a default := entry_new a:type
      a:type copy_instance (e:i constant a:type) a:default
      i += 1
    else
      return
  if (t:attributes first a:pliant_id)=null
    a flag := 2^t:attributes:count
    t:attributes insert a:pliant_id true addressof:a
    var Pointer:Arrow c :> pliant_general_dictionary first "
    if c<>null and entry_type:c=HtmlAttribute
      (c map HtmlAttribute) sequence += a pliant_id
    if c<>null and entry_type:c=TagAttribute
      (c map TagAttribute) sequence += a pliant_id
  e set_void_result

meta subpage e
  e set_void_result

meta subpage e
  var Link:HtmlTag t :> the_tag:e
  var Link:TagPrototype t :> the_tag:e
  if exists:t and e:size=1 and e:0:ident<>""
    t subpage := true
    t subpage_id := e:0 ident
    e set_void_result

meta body e
  if exists:t and e:size=1 and e:0:ident<>""
    t subpage := true
    t subpage_id := e:0 ident
    e set_void_result

meta body e
  var Link:HtmlTag t :> the_tag:e
  var Link:TagPrototype t :> the_tag:e
  if exists:t and e:size=0
    t body := true
    e set_void_result

meta newline e
  if exists:t and e:size=0
    t body := true
    e set_void_result

meta newline e
  var Link:HtmlTag t :> the_tag:e
  var Link:TagPrototype t :> the_tag:e
  if exists:t and e:size=0
    t newline := true
    e set_void_result

meta hidden e
  if exists:t and e:size=0
    t newline := true
    e set_void_result

meta hidden e
  var Link:HtmlTag t :> the_tag:e
  var Link:TagPrototype t :> the_tag:e
  if exists:t and e:size=0
    t hidden := true
    e set_void_result

method p default_tag_hook t flags
  if exists:t and e:size=0
    t hidden := true
    e set_void_result

method p default_tag_hook t flags
  arg_rw HtmlPage p ; arg HtmlTag t ; arg uInt flags
  arg_rw HtmlPage p ; arg TagPrototype t ; arg uInt flags
  p write "<"
  p write t:html_id
  p write_attributes
  if t:newline
    p write ">[lf]"
  else
    p write ">"

method p default_tag_open_hook t flags
  p write "<"
  p write t:html_id
  p write_attributes
  if t:newline
    p write ">[lf]"
  else
    p write ">"

method p default_tag_open_hook t flags
  arg_rw HtmlPage p ; arg HtmlTag t ; arg uInt flags
  arg_rw HtmlPage p ; arg TagPrototype t ; arg uInt flags
  p write "<"
  p write t:html_id
  p write_attributes
  p write ">"

method p default_tag_close_hook t flags
  p write "<"
  p write t:html_id
  p write_attributes
  p write ">"

method p default_tag_close_hook t flags
  arg_rw HtmlPage p ; arg HtmlTag t ; arg uInt flags
  arg_rw HtmlPage p ; arg TagPrototype t ; arg uInt flags
  p write "</"
  p write t:html_id
  # p write_attributes
  if t:newline
    p write ">[lf]"
  else
    p write ">"

method t record_attributes
  p write "</"
  p write t:html_id
  # p write_attributes
  if t:newline
    p write ">[lf]"
  else
    p write ">"

method t record_attributes
  arg_rw HtmlTag t
  each a t:attributes type HtmlAttribute
  arg_rw TagPrototype t
  each a t:attributes type TagAttribute
    if a:index=undefined
      if (exists a:type)
    if a:index=undefined
      if (exists a:type)
        a index := html_stack_slot a:type a:default
        a index := tag_stack_slot a:type a:default
      else
        a index := -1
      else
        a index := -1
    html_attr_dict_sem request
    html_attr_dict insert t:pliant_id+"/"+a:pliant_id true a
    html_attr_dict_sem release
    tag_attr_dict_sem request
    tag_attr_dict insert t:pliant_id+"/"+a:pliant_id true addressof:a
    tag_attr_dict_sem release




meta html_tag e
meta tag_prototype e
  if e:size<2 or not e:0:is_pure_ident
    return
  var Pointer:Arrow c :> pliant_general_dictionary first ". 
  if e:size<2 or not e:0:is_pure_ident
    return
  var Pointer:Arrow c :> pliant_general_dictionary first ". 
  while c<>null and entry_type:c<>HtmlTag
  while c<>null and entry_type:c<>TagPrototype
    c :>  pliant_general_dictionary next ". "+e:0:ident c
    c :>  pliant_general_dictionary next ". "+e:0:ident c
  var Link:HtmlTag t
  var Link:TagPrototype t
  if c<>null
  if c<>null
    t :> c map HtmlTag
    t :> c map TagPrototype
  else
  else
    t :> new HtmlTag
    t :> new TagPrototype
  if pliant_debugging_level>=1
    t position := e:position
  t pliant_id := e:0 ident ; t html_id := t pliant_id
  var Int i := 1
  while i<e:size-1
    if e:i:ident="->"
      if i+1<e:size and e:(i+1):ident<>""
        t html_id := e:(i+1) ident
        i += 2
      else
        return
    eif e:i:is_pure_ident
      if c=null
        t required += e:i:ident
      i += 1
    else
      return
  var Address mark := e:module mark
  e:module define "pliant current html tag" addressof:t
  e:(e:size-1):compile ?
  e:module rewind mark
  for (var Int j) 0 t:required:size-1
    if (t:attributes first t:required:j)=null
      return
  t record_attributes
  if c=null
    if t:body
  if pliant_debugging_level>=1
    t position := e:position
  t pliant_id := e:0 ident ; t html_id := t pliant_id
  var Int i := 1
  while i<e:size-1
    if e:i:ident="->"
      if i+1<e:size and e:(i+1):ident<>""
        t html_id := e:(i+1) ident
        i += 2
      else
        return
    eif e:i:is_pure_ident
      if c=null
        t required += e:i:ident
      i += 1
    else
      return
  var Address mark := e:module mark
  e:module define "pliant current html tag" addressof:t
  e:(e:size-1):compile ?
  e:module rewind mark
  for (var Int j) 0 t:required:size-1
    if (t:attributes first t:required:j)=null
      return
  t record_attributes
  if c=null
    if t:body
      var Pointer:Function f :> the_function '. default_tag_
      t tag_open_index := html_stack_slot Pointer:Function (
      var Pointer:Function f :> the_function '. default_tag_
      t tag_close_index := html_stack_slot Pointer:Function 
      var Pointer:Function f :> the_function '. default_tag_open_hook' HtmlPage TagPrototype uInt
      t tag_open_index := tag_stack_slot Pointer:Function (addressof Pointer:Function f)
      var Pointer:Function f :> the_function '. default_tag_close_hook' HtmlPage TagPrototype uInt
      t tag_close_index := tag_stack_slot Pointer:Function (addressof Pointer:Function f)
    else
    else
      var Pointer:Function f :> the_function '. default_tag_
      t tag_open_index := html_stack_slot Pointer:Function (
      var Pointer:Function f :> the_function '. default_tag_hook' HtmlPage TagPrototype uInt
      t tag_open_index := tag_stack_slot Pointer:Function (addressof Pointer:Function f)
      t tag_close_index := undefined
    if t:subpage
      t tag_close_index := undefined
    if t:subpage
      t subpage_index := html_stack_slot Str null
      t subpage_index := tag_stack_slot Str null
    e define ". "+e:0:ident addressof:t e:module:actual
  e set_void_result

    e define ". "+e:0:ident addressof:t e:module:actual
  e set_void_result

export html_tag sequence attr subpage body newline hidden
export tag_prototype sequence attr subpage body newline hidden



method page parse_parameter values a attr_id tag_id -> statu



method page parse_parameter values a attr_id tag_id -> statu
  arg_rw HtmlPage page ; arg_rw Str values ; arg HtmlAttribu
  arg_rw HtmlPage page ; arg_rw Str values ; arg TagAttribute a ; arg Str attr_id tag_id ; arg ExtendedStatus status
  if not exists:a
    return (failure "Unknown attribute '"+attr_id+"' in tag 
  if a:sequence:size>0
    for (var Int k) 0 a:sequence:size-1
  if not exists:a
    return (failure "Unknown attribute '"+attr_id+"' in tag 
  if a:sequence:size>0
    for (var Int k) 0 a:sequence:size-1
      var Link:HtmlAttribute b :> (html_attr_dict first tag_
      var Link:TagAttribute b :> (tag_attr_dict first tag_id+"/"+a:sequence:k) map TagAttribute
      status := page parse_parameter values b attr_id tag_id
      if status=failure
        return
    return
  if not (exists a:type)
    return (failure "Unsupported attribute '"+attr_id+"' in 
  var Pointer:Function fun :> a:type get_generic_method from
  if not exists:fun or fun=(the_function '. from string' Uni
    return (failure "Don't know how to parse attribute '"+at
  if (values parse "(" any:(var Str value) ")" any:(var Str 
    value := string value
    status := page parse_parameter value a attr_id tag_id
    values := remain
    return
  var Arrow obj := entry_new a:type
  status := from_string (obj map Universal) values "" true (
  if status=failure
    var Status retry := from_string (obj map Universal) valu
    if retry=success and ((values skiped offset-skiped) sear
      status := success
  if status=success
      status := page parse_parameter values b attr_id tag_id
      if status=failure
        return
    return
  if not (exists a:type)
    return (failure "Unsupported attribute '"+attr_id+"' in 
  var Pointer:Function fun :> a:type get_generic_method from
  if not exists:fun or fun=(the_function '. from string' Uni
    return (failure "Don't know how to parse attribute '"+at
  if (values parse "(" any:(var Str value) ")" any:(var Str 
    value := string value
    status := page parse_parameter value a attr_id tag_id
    values := remain
    return
  var Arrow obj := entry_new a:type
  status := from_string (obj map Universal) values "" true (
  if status=failure
    var Status retry := from_string (obj map Universal) valu
    if retry=success and ((values skiped offset-skiped) sear
      status := success
  if status=success
    page:html_stack push a:index obj a:type
    page:tag_stack push a:index obj a:type
    values := values offset values:len
  else
    status := failure "Incorrect value provided for attribut

    values := values offset values:len
  else
    status := failure "Incorrect value provided for attribut

method page html_attributes_setup
method page tag_attributes_setup
  arg_rw HtmlPage page
  var ExtendedStatus status := success
  arg_rw HtmlPage page
  var ExtendedStatus status := success
  html_attr_dict_sem rd_request
  tag_attr_dict_sem rd_request
  part parse
    var Pointer:Str opt :> page:http_request:style_options
    var Int i := 0
    while { while (opt i 1)=" " { i += 1 } ; i<opt:len }
      var Int j := i+((opt i opt:len) search "[lf]" opt:len-
      if opt:i<>"#" and ((opt i j-i) parse any:(var Str tag_
        while { while (all 0 1)=" " { all := all 1 all:len }
          if (all parse any:(var Str attr_id) _ any:(var Str
  part parse
    var Pointer:Str opt :> page:http_request:style_options
    var Int i := 0
    while { while (opt i 1)=" " { i += 1 } ; i<opt:len }
      var Int j := i+((opt i opt:len) search "[lf]" opt:len-
      if opt:i<>"#" and ((opt i j-i) parse any:(var Str tag_
        while { while (all 0 1)=" " { all := all 1 all:len }
          if (all parse any:(var Str attr_id) _ any:(var Str
            var Link:HtmlAttribute a :> (html_attr_dict firs
            var Link:TagAttribute a :> (tag_attr_dict first tag_id+"/"+attr_id) map TagAttribute
            status := page parse_parameter values a attr_id 
          else
            status := failure "No attribute provided for tag
          if status=failure
            leave parse
          all := values
      i := j+1
            status := page parse_parameter values a attr_id 
          else
            status := failure "No attribute provided for tag
          if status=failure
            leave parse
          all := values
      i := j+1
  html_attr_dict_sem rd_release
  tag_attr_dict_sem rd_release
  page:http_request style_options := shunt status=success ""
  if status=failure
    console status:message eol

  page:http_request style_options := shunt status=success ""
  if status=failure
    console status:message eol

export '. html_attributes_setup'
export '. tag_attributes_setup'