Patch title: tag support for beautifier
Abstract:
add coloring and hyperlink support for the tags
created in the .style
File: /pliant/protocol/http/pli_filter.pli
Key:
    Removed line
    Added line
   
module "/pliant/language/compiler.pli"
module "/pliant/language/unsafe.pli"
module "/pliant/language/stream.pli"
module "/pliant/language/parser.pli"
module "/pliant/util/encoding/http.pli"
module "/pliant/util/encoding/html.pli"
module "/pliant/admin/file.pli"


implicit constant_effects
  insert "Type" "#C80096"
  insert "Str" "green"
  insert "Char" "green"
  insert "InlineText" "green"
  
implicit active_effects
module "/pliant/language/compiler.pli"
module "/pliant/language/unsafe.pli"
module "/pliant/language/stream.pli"
module "/pliant/language/parser.pli"
module "/pliant/util/encoding/http.pli"
module "/pliant/util/encoding/html.pli"
module "/pliant/admin/file.pli"


implicit constant_effects
  insert "Type" "#C80096"
  insert "Str" "green"
  insert "Char" "green"
  insert "InlineText" "green"
  
implicit active_effects
  insert "Function" "black"
  insert "Meta" "black"
  insert "GlobalVariable" "#FF0000"
  insert "LocalVariable"  "#C80032"

  insert "GlobalVariable" "#FF0000"
  insert "LocalVariable"  "#C80032"

method t 'get position' -> pos
  oarg Universal t; arg ListingPosition pos
  generic
  pos:=new ListingPosition
export '. get position'
type Tag
  field Char kind
  field Str key
  field Str link

function apply t s -> s2
  arg Tag t; arg Str s s2
  var Str ss:=s
  if t:kind="C"
    var Str color := "#006446"
type Tag
  field Char kind
  field Str key
  field Str link

function apply t s -> s2
  arg Tag t; arg Str s s2
  var Str ss:=s
  if t:kind="C"
    var Str color := "#006446"
    var Link:Str eff :> constant_effects first t:key
    var Pointer:Str eff :> constant_effects first t:key
    if exists:eff
      color := eff
      ss := "<font color="+string:color+">"+ss+"</font>"
  eif t:kind="A"
    if exists:eff
      color := eff
      ss := "<font color="+string:color+">"+ss+"</font>"
  eif t:kind="A"
    var Link:Str eff :> active_effects first t:key
    var Pointer:Str eff :> active_effects first t:key
    if exists:eff
      color := eff
      ss := "<font color="+string:color+">"+ss+"</font>"
  eif t:kind=" "
    ss := replace (html_encode ss true) " " "&nbsp;"
  eif t:kind="#"
    if ss="#"+(repeat (max ss:len-1 3) "-")
      ss := "<hr>"
    else
      ss := "<em><font color='blue'>"+(replace (html_encode 
  if t:link<>""
    ss := "<a href="+t:link+"><b>"+ss+"</b></a>"
  s2 := ss
  
method position decode filename line column
  arg ListingPosition position; arg_w Str filename; arg_w In
  var Str s := cast position Str
  if not (s eparse any:filename _ any:(var Str remain))
    filename:=""; line:=0; column := 0
    return
  if not (remain parse line column)
    remain parse any:(var Str dummy) line column

    if exists:eff
      color := eff
      ss := "<font color="+string:color+">"+ss+"</font>"
  eif t:kind=" "
    ss := replace (html_encode ss true) " " "&nbsp;"
  eif t:kind="#"
    if ss="#"+(repeat (max ss:len-1 3) "-")
      ss := "<hr>"
    else
      ss := "<em><font color='blue'>"+(replace (html_encode 
  if t:link<>""
    ss := "<a href="+t:link+"><b>"+ss+"</b></a>"
  s2 := ss
  
method position decode filename line column
  arg ListingPosition position; arg_w Str filename; arg_w In
  var Str s := cast position Str
  if not (s eparse any:filename _ any:(var Str remain))
    filename:=""; line:=0; column := 0
    return
  if not (remain parse line column)
    remain parse any:(var Str dummy) line column

method fun 'get position' -> pos
  oarg Function fun; arg ListingPosition pos
  return fun:position
    
method met 'get position' -> pos
  oarg Meta met; arg ListingPosition pos
  var Link:Function fun :> addressof:met omap Function
  return fun:position

method gv 'get position' -> pos
  oarg GlobalVariable gv; arg ListingPosition pos
  return gv:position

function fill_tags tags m
  arg_rw Link:(Array (Dictionary Int Tag)) tags; arg Module 
  if addressof:m=null
    console "module not loaded" eol
    return
  var Link:Module mm :> m
  if addressof:(mm external)<>null
    mm :> mm external
  var Pointer:Arrow c :> m first "pliant tags list"+mm:name
  if c=null
    console "no tags for this module" eol
    return
  var Link:ListingTags lt :> c map ListingTags
  var ListingTag xt
  var Address a := lt first
  while a<>null
    xt := lt get a
    var Int line := xt line
    var Int column := xt:column-1
    c :> xt value
    a := lt next a
    var Tag t
    if c<>null and entry_type:c=TagMarker
      var Int s := tags:size
      tags := new Array:(Dictionary Int Tag)
      tags size := s
    eif line<tags:size
function fill_tags tags m
  arg_rw Link:(Array (Dictionary Int Tag)) tags; arg Module 
  if addressof:m=null
    console "module not loaded" eol
    return
  var Link:Module mm :> m
  if addressof:(mm external)<>null
    mm :> mm external
  var Pointer:Arrow c :> m first "pliant tags list"+mm:name
  if c=null
    console "no tags for this module" eol
    return
  var Link:ListingTags lt :> c map ListingTags
  var ListingTag xt
  var Address a := lt first
  while a<>null
    xt := lt get a
    var Int line := xt line
    var Int column := xt:column-1
    c :> xt value
    a := lt next a
    var Tag t
    if c<>null and entry_type:c=TagMarker
      var Int s := tags:size
      tags := new Array:(Dictionary Int Tag)
      tags size := s
    eif line<tags:size
      if c<>null and (entry_type:c=Function or entry_type:c=
        t:kind:="A"; t:key:=entry_type:c:name; t:link:=""
        if entry_type:c=Function or entry_type:c=Meta
          var Link:Function fun :> c map Function
          fun:position decode (var Str filename) (var Int li
          if filename<>""
            t link := filename+"#line"+string:lin
        eif entry_type:c=GlobalVariable
          var Link:GlobalVariable gv :> c map GlobalVariable
          gv:position decode (var Str filename) (var Int lin
          if filename<>""
            t link := filename+"#line"+string:lin
      if c<>null and exists:(active_effects first entry_type:c:name)
        t:kind:="A"; t:key:=entry_type:c:name
        var Link:Universal data :> c omap Universal
        data:'get position' decode (var Str filename) (var Int lin) (var Int col)
        if filename<>""
          t link := filename+"#line"+string:lin
        else
          t link := ""
        tags:line insert column t
      eif c<>null
        t:kind:="C"; t:key:=entry_type:c:name; t:link:=""
        if entry_type:c=Type
          var Link:Type typ :> c map Type
          typ:position decode (var Str filename) (var Int li
          if filename<>""
            t link := filename+"#line"+string:lin
        tags:line insert column t
      else
        t:kind:="C"; t:key:=""; t:link:=""
        tags:line insert column t


        tags:line insert column t
      eif c<>null
        t:kind:="C"; t:key:=entry_type:c:name; t:link:=""
        if entry_type:c=Type
          var Link:Type typ :> c map Type
          typ:position decode (var Str filename) (var Int li
          if filename<>""
            t link := filename+"#line"+string:lin
        tags:line insert column t
      else
        t:kind:="C"; t:key:=""; t:link:=""
        tags:line insert column t


function common_filter pgm outs filename module
  arg_rw List:Str pgm outs; arg Str filename; arg Module module
  var Arrow a
  var Link:(Array (Dictionary Int Tag)) tags :> new (Array (Dictionary Int Tag))
  tags size := pgm:size+1
  fill_tags tags module

  var Int l := 1
  outs := new List:Str
  outs += "<table column=3 border=0 cellpadding=0 cellspacing=0>"
  outs += "<tr><td colspan=3 bgcolor='#FFF0E6'><tt>&nbsp;</tt></td></tr>"
  outs += "<tr><td colspan=3 bgcolor='#FFF0E6'><tt><center><big>"+html_encode:filename+"</big></center></tt></td></tr>[lf]"
  outs += "<tr><td colspan=3 bgcolor='#FFF0E6'><tt>&nbsp;</tt></td></tr>"
  each line pgm
    outs += "<tr><td bgcolor='#FFF0E6'><tt>&nbsp;<a name=[dq]line"+string:l+"[dq]></a><small>"+string:l+"</small>&nbsp;</tt></td><td bgcolor='white'><tt>"
    var Link:ApplyStack as :> new ApplyStack
    var Int s := 0
    var Bool neutral:=false
    var Bool in_str := false
    while s<line:len
      var Pointer:Tag cur :> tags:l first s
      if exists:cur
        neutral := false
        as purge # purge the stack
        while exists:cur # should be only one
          as push cur
          cur :> tags:l next s cur
      if line:s="#"
        as purge # purge the stack
        var Tag t; t:kind:="#"; t key:=""; t:link:=""
        as push t
        as piece := (line s line:len)
        s := line:len
        as purge
      eif line:s="[dq]"
        as purge
        var Tag t; t:kind:="C"; t key:="Str"; t link:=""
        as push t
        t:kind:=" "
        as push t
        var Int length := 2+((line s+1 line:len) search "[dq]" line:len)
        as piece := (line s length)
        s+=length
        as purge
      else
         if not neutral
           var Tag t; t:kind:=" "; t key:=""; t:link:=""
           as push t
           neutral := true
         as piece += line:s
         s += 1
    as purge
    outs += as:piece+"</tt></td><td bgcolor='#FFF0E6'><tt>&nbsp;</tt></td></tr>"
    l+=1
  outs += "<tr><td colspan=3 bgcolor='#FFF0E6'><tt>&nbsp;</tt></td></tr>"
  outs += "</table></body></HTML>"

function my_pli_filter ins outs opt
  arg_rw Stream ins outs; arg_rw Str opt
  var Str filename := opt option "name" Str
  var Pointer:Arrow c :> pliant_module_dictionary first file
  common_filter ins outs filename (c map Module)
  opt += " mime [dq]text/html[dq]"


function my_pli_filter ins outs opt
  arg_rw Stream ins outs; arg_rw Str opt
  var Str filename := opt option "name" Str
  var Pointer:Arrow c :> pliant_module_dictionary first file
  common_filter ins outs filename (c map Module)
  opt += " mime [dq]text/html[dq]"


export my_pli_filter common_filter my_page_filter
export my_pli_filter common_filter my_page_filter constant_effects active_effects