Patch title: tag support for beautifier
Abstract:
add coloring and hyperlink support for the tags
created in the .style
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"
module "/pliant/protocol/http/pli_filter.pli"



type HtmlTag



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 tag watch active list' append addressof:HtmlTag
  active_effects insert "HtmlTag" "000080"

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

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



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
#-----------------------------------------------------------
#  styling



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


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
        pliant_general_dictionary remove ". pliant style tag
        e suckup e:0
        e add (instruction (the_function '. record_tag_hook'
        e set_void_result


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