Patch title: Release 84 bulk changes
Abstract:
File: /pliant/protocol/http/style/common.pli
Key:
    Removed line
    Added line
module "/pliant/language/compiler.pli"
module "/pliant/admin/file.pli"
module "/pliant/protocol/http/server.pli"
module "/pliant/util/encoding/neutral.pli"
module "/pliant/admin/md5.pli"


public
  constant html32 false
  constant database true
  constant slash "" # change it with " /" if you want XML files
  
if database
  submodule "/pliant/appli/database.pli"
  module "/pliant/language/data/string_cast.pli"


#---------------------------------------------------------------------------
#  context


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 variable name -> value
  arg HtmlPage p ; arg Str name value
  if ("&"+p:request:form+"&"+p:request:url_options+"&" parse any (pattern "&"+name+"=") any:value "&" any)
    value := replace http_decode:value "[cr][lf]" "[lf]"
  else
    value := ""

export '. request' '. server' '. variable'



#---------------------------------------------------------------------------
#  new tags helper


function simple_bloc_tag_meta e tag
  arg_rw Expression e ; arg Str tag
  if e:size<>2 or not (e:0 cast HtmlPage)
    return
  e:1 compile ?
  e suckup e:0
  e add (instruction (the_function '. tag' HtmlPage Str Str) e:0:result (argument constant Str tag) (argument constant Str ""))
  e suckup e:1
  e add (instruction (the_function '. tag' HtmlPage Str Str) e:0:result (argument constant Str "/"+tag) (argument constant Str ""))
  e set_void_result

named_expression simple_bloc_tag_prototype
  meta id e
   simple_bloc_tag_meta e tag
  export id

meta simple_bloc_tag e
  if e:size<>1 or not e:0:is_pure_ident
    return
  e compile_as (expression duplicate simple_bloc_tag_prototype substitute id (expression ident ". "+e:0:ident near e:0) substitute tag (expression constant e:0:ident near e:0))


function new_button_id e -> id
  arg Str id ; arg_rw Expression e
  if false
    var Pointer:Arrow c :> pliant_general_dictionary first "pliant function"
    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:"expression" any)
        c :> pliant_general_dictionary next "pliant function" c
        restart get_function
    var Pointer:Int counter :> current_function:properties kmap "pliant style standard button counter" Int 0
  var Pointer:Int counter :> e:module:properties kmap "pliant style standard button counter" Int 0
  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):datetime
  timestamp := replace timestamp " " ""
  timestamp := replace timestamp "/" ""
  timestamp := replace timestamp ":" ""
  timestamp := replace timestamp "?" ""
  id := name+"|"+timestamp+"|"+string:counter


function update_button_types
  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
  var Link:List buttons :> current_function:properties kmap "pliant button types" List
  c :> buttons first
  while c<>null
    if entry_type:c=Type
      var Pointer:Type type :> c map Type
      for (var Int i) 0 type:nb_fields-1
        var Pointer:TypeField tf :> type field i
        if tf:name<>"page"
          if ((current_function:properties kmap "pliant editable variables" Dictionary) first tf:name)<>null
            tf:properties kmap "pliant editable" CBool := true
    c :> buttons next c

function notify_button_type t
  arg_rw Type t
  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
  var Link:List buttons :> current_function:properties kmap "pliant button types" List
  buttons append addressof:t  
  update_button_types   

function notify_editable_variable e
  arg_rw Expression 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:result:name<>""
    (current_function:properties kmap "pliant editable variables" Dictionary) kmap e:result:name CBool := true
    update_button_types   


function html_reset_context context
  arg_w Str context
  context := ""
    
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

function html_add_to_context context ident data fun
  arg_rw Str context ; arg Str ident ; arg Universal data ; arg Function fun
  context += "&"+ident+"="+http_encode:(to_string data "raw" fun)

if database

  function data_add_to_context context ident data
    arg_rw Str context ; arg Str ident ; arg Data_ data
    context += "&"+ident+"="+(http_encode data:path)

named_expression button_framework
  body
    
function button_expression e options button_id ctx -> ok
  arg_rw Expression e ; arg Str options ; arg_w Str button_id ; arg_w Link:Argument ctx ; arg CBool ok
  ok := false
  var Link:Function current_function
  var Pointer:Arrow c :> pliant_general_dictionary first "pliant function"
  if c<>null and entry_type:c=Function
    current_function :> c map Function
  else
    current_function :> new Function
  var Int index := options option "index" Int e:size-1
  var Link:Expression body :> expression duplicate button_framework substitute body e:index near e:index
  var List expressions byaddress ; var List functions ; var Link:Type type
  expressions append addressof:body
  byaddress append addressof:(new Ident (cast "page" Ident))
  body freeze expressions byaddress functions type ?
  copy_properties body:0 e:index
  var CBool stay := false
  for (var Int i) 0 body:size-1
    if body:i:is_pure_ident and (body:i:ident="reload_page" or body:i:ident="goto_backward" or body:i:ident="close")
      stay := true
  if (stay or (options option "stay")) and not (options option "nostay")
    type:properties kmap "http stay" Void := void
  ctx :> argument local Str
  e add (instruction (the_function html_reset_context Str) ctx)
  for (var Int i) 0 type:nb_fields-1
    var Pointer:TypeField tf :> type field i
    if tf:name<>"page"
      var Link:Expression id :> expression ident tf:name near body
      id compile ?
      var CBool data := database and id:is_data
      if database and data
        e suckup id
        e add (instruction (the_function data_add_to_context Str Str Data_) ctx (argument constant Str tf:name) id:result)
      eif ((current_function:properties kmap "pliant editable variables" Dictionary) first tf:name)=null
        var Pointer:Type t :> id:result:type real_data_type
        if not (id cast t)
          error error_id_compile "Cannot cast '"+tf:name+"' to a real data that could be passed back when the button is pressed."
          return
        var Pointer:Function function :> t get_generic_method to_index
        if not exists:function or function=(the_function '. to string' Universal Str -> Str)
          error error_id_compile "Cannot convert '"+tf:name+"' to a string that could be passed back when the button is pressed."
          return
        e suckup id
        e add (instruction (the_function html_add_to_context Str Str Universal Function) ctx (argument constant Str tf:name) id:result (argument mapped_constant Function function))
  button_id := new_button_id e
  var Link:Function sub_function :> functions:first map Function
  # var Pointer:Arrow c :> current_function:properties first "style"
  # while c<>null
  #   if entry_type:c=Str
  #     sub_function:properties insert "style" false c
  #   c :> current_function:properties next "style" c
  http_record_dynamic_page button_id e:position sub_function type
  notify_button_type type
  ok := true

export simple_bloc_tag simple_bloc_tag_meta
export new_button_id notify_editable_variable notify_button_type button_expression


#---------------------------------------------------------------------------
#  colors


type PixelRGB888
  field uInt8 red green blue

function rgb_pixel r g b -> p
  arg Int r g b ; arg PixelRGB888 p
  p red := r ; p green := g ; p blue := b

function lsh_pixel l s h -> p
  arg Float l s h ; arg PixelRGB888 p
  check h>=0 and h<360
  for (var Int i) 0 2
    var Float hi := h-120*i
    while hi<(-180)
      hi += 360
    while hi>=180
      hi -= 360
    var Float f := shunt hi<0 (1/60)*hi+2 -(1/60)*hi+2
    f := shunt f<=0 0 f>=1 1 f
    f :=  f*s/100 + l/100*(1-s/100)
    (addressof:p translate uInt8 i) map uInt8 := cast f*255 uInt

function component255 i -> c
  arg Int i ; arg Str c
  check i>=0 and i<256
  c := right (string i "radix 16") 2 "0"

method p html_encoding -> c
  arg PixelRGB888 p ; arg Str c
  c := "#"+(component255 p:red)+(component255 p:green)+(component255 p:blue)

export PixelRGB888 '. red' '. green' '. blue'
export lsh_pixel rgb_pixel '. html_encoding'