Patch title: Release 87 bulk changes
Abstract:
File: /pliant/protocol/http/style/common.pli
Key:
    Removed line
    Added line
   
module "/pliant/language/compiler.pli"
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"

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
  constant database true
  
if database
  submodule "/pliant/appli/database.pli"
  module "/pliant/language/data/string_cast.pli"



type HtmlTag
public
  constant database true
  
if database
  submodule "/pliant/appli/database.pli"
  module "/pliant/language/data/string_cast.pli"



type HtmlTag
  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


  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


  'pliant watch' HtmlTag true := "000080"

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

#-----------------------------------------------------------
#  styling


method p request -> r
  arg HtmlPage p ; arg_C HttpRequest r
  r :> p http_request
 
method p server -> s
  arg HtmlPage p ; arg_C HttpServer s
  s :> p:http_request server
  
method p browser -> b
  arg HtmlPage p ; arg_C Str b
  b :> p:http_request browser_model
  
method p variable name -> value
  arg HtmlPage p ; arg Str name value
#-----------------------------------------------------------
#  styling


method p request -> r
  arg HtmlPage p ; arg_C HttpRequest r
  r :> p http_request
 
method p server -> s
  arg HtmlPage p ; arg_C HttpServer s
  s :> p:http_request server
  
method p browser -> b
  arg HtmlPage p ; arg_C Str b
  b :> p:http_request browser_model
  
method p variable name -> value
  arg HtmlPage p ; arg Str name value
  if ("&"+p:request:form+"&"+p:request:url_options+"&" parse
  if ("&"+p:request:form+"&"+p:request:encoded_options+"&" parse any (pattern "&"+name+"=") any:value "&" any)
    value := replace http_decode:value "[cr][lf]" "[lf]"
  else
    value := ""


function style_tag_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 "
    while c<>null and entry_type:c<>HtmlTag
      c :>  pliant_general_dictionary next ". "+e:1:ident c
    if c<>null and entry_type:c=HtmlTag
      var Link:HtmlTag t :> c map HtmlTag
      var Address mark := e:module mark
      e:module define "pliant current tag" addressof:t
      var Link:Expression ee :> expression duplicate style_t
      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
    value := replace http_decode:value "[cr][lf]" "[lf]"
  else
    value := ""


function style_tag_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 "
    while c<>null and entry_type:c<>HtmlTag
      c :>  pliant_general_dictionary next ". "+e:1:ident c
    if c<>null and entry_type:c=HtmlTag
      var Link:HtmlTag t :> c map HtmlTag
      var Address mark := e:module mark
      e:module define "pliant current tag" addressof:t
      var Link:Expression ee :> expression duplicate style_t
      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 "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


function new_button_id e -> id
  arg Str id ; arg_rw Expression e
  if false
    var Pointer:Arrow c :> pliant_general_dictionary first "
    part get_function
      if c=null or entry_type:c<>Function
        return ""
      var Link:Function current_function :> c map Function
      if (current_function:name parse word:"frozen" word:"ex
        c :> pliant_general_dictionary next "pliant function
        restart get_function
    var Pointer:Int counter :> current_function:properties k
  var Pointer:Int counter :> e:module:properties kmap "plian
  counter += 1
  var Str name := replace e:module:name " (internals)" ""
  var Str filename := replace name ".html" ".page"
  var Str timestamp := string (file_query filename standard)
  timestamp := replace timestamp " " ""
  timestamp := replace timestamp "/" ""
  timestamp := replace timestamp ":" ""
  timestamp := replace timestamp "?" ""
        pliant_general_dictionary remove ". pliant style tag
        e suckup e:0
        e add (instruction (the_function '. record_tag_hook'
        e set_void_result


function new_button_id e -> id
  arg Str id ; arg_rw Expression e
  if false
    var Pointer:Arrow c :> pliant_general_dictionary first "
    part get_function
      if c=null or entry_type:c<>Function
        return ""
      var Link:Function current_function :> c map Function
      if (current_function:name parse word:"frozen" word:"ex
        c :> pliant_general_dictionary next "pliant function
        restart get_function
    var Pointer:Int counter :> current_function:properties k
  var Pointer:Int counter :> e:module:properties kmap "plian
  counter += 1
  var Str name := replace e:module:name " (internals)" ""
  var Str filename := replace name ".html" ".page"
  var Str timestamp := string (file_query filename standard)
  timestamp := replace timestamp " " ""
  timestamp := replace timestamp "/" ""
  timestamp := replace timestamp ":" ""
  timestamp := replace timestamp "?" ""
  id := name+"|"+timestamp+"|"+string:counter
  id := name+"/"+timestamp+"/"+string:counter



method p set_subpage index id context
  arg_rw HtmlPage p ; arg Int index ; arg Str id context



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
  var Str url := "button-0-0-"+id+"-"+(p:request cipher context)+"-"+(p:request generate_signature id+" "+context)
  p:html_stack push index addressof:url Str


meta html_tag e
  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
    c :>  pliant_general_dictionary next ". "+e:0:ident c
  var Link:HtmlTag t
  if c<>null
    t :> c map HtmlTag
  else
    t :> new HtmlTag
  p:html_stack push index addressof:url Str


meta html_tag e
  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
    c :>  pliant_general_dictionary next ". "+e:0:ident c
  var Link:HtmlTag t
  if c<>null
    t :> c map HtmlTag
  else
    t :> new HtmlTag
  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 
    else
      var Pointer:Function f :> the_function '. default_tag_
      t tag_open_index := html_stack_slot Pointer:Function (
      t tag_close_index := undefined
    if t:subpage
      t subpage_index := html_stack_slot Str null
    e define ". "+e:0:ident addressof:t e:module:actual
  e set_void_result


  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 
    else
      var Pointer:Function f :> the_function '. default_tag_
      t tag_open_index := html_stack_slot Pointer:Function (
      t tag_close_index := undefined
    if t:subpage
      t subpage_index := html_stack_slot Str null
    e define ". "+e:0:ident addressof:t e:module:actual
  e set_void_result