Patch title: Release 84 bulk changes
Abstract:
File: /pliant/protocol/http/style/default.style
Key:
    Removed line
    Added line
# Copyright  Hubert Tonneau  hubert.tonneau@pliant.cx
#
# This program is free software; you can redistribute it and/or
# modify it under the terms of the GNU General Public License version 2
# as published by the Free Software Foundation.
#
# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
# GNU General Public License for more details.
#
# You should have received a copy of the GNU General Public License
# version 2 along with this program; if not, write to the Free Software
# Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA  02111-1307, USA.

module "/pliant/language/compiler.pli"
module "/pliant/language/context.pli"
module "/pliant/language/parser.pli"
module "/pliant/language/parser/multiline.pli"
module "/pliant/protocol/http/server.pli"
module "/pliant/util/encoding/neutral.pli"
module "/pliant/admin/md5.pli"
module "common.pli"
submodule "common.style"


#---------------------------------------------------------------------------
#  style setup

function corner i round color ground -> s
  arg Int i ; arg Int round ; arg PixelRGB888 color ground ; arg Str s
  s := "<img src=[dq]/common/corner_"+string:i+"_size_"+string:round+"_color_"+string:(cast color:red Int)+"_"+string:(cast color:green Int)+"_"+string:(cast color:blue Int)+"_ground_"+string:(cast ground:red Int)+"_"+string:(cast ground:green Int)+"_"+string:(cast ground:blue Int)+".png[dq] height=[dq]"+string:round+"[dq] width=[dq]"+string:round+"[dq]>"

function round_rectangle_begin space rounded color ground table_extra cell_extra -> t
  arg Int space ; arg CBool rounded ; arg PixelRGB888 color ground ; arg Str table_extra cell_extra ; arg Str t
  if rounded
    t := "<table cellpadding=[dq]0[dq] cellspacing=[dq]0[dq] border=[dq]0[dq] bgcolor=[dq]"+color:html_encoding+"[dq]"+table_extra+">[lf]"
    t += "<tr><td>"+(corner 0 space color ground)+"</td><td></td><td>"+(corner 1 space color ground)+"</td></tr>[lf]"
    t += "<tr><td></td><td"+cell_extra+">"
  else
    t := "<table cellpadding=[dq]"+string:space+"[dq] border=[dq]0[dq] bgcolor=[dq]"+color:html_encoding+"[dq]"+table_extra+">[lf]"
    t += "<tr><td"+cell_extra+">"

function round_rectangle_end space rounded color ground -> t
  arg Int space ; arg CBool rounded ; arg PixelRGB888 color ground ; arg Str t
  if rounded
    t := "</td><td></td></tr>[lf]"
    t += "<tr><td>"+(corner 2 space color ground)+"</td><td></td><td>"+(corner 3 space color ground)+"</td></tr>[lf]"
    t += "</table>[lf]"
  else
    t := "</td></tr></table>[lf]"


function title round rounded color ground fontcolor fontsize options -> t
  arg Int round ; arg CBool rounded ; arg PixelRGB888 fontcolor color ground ; arg Int fontsize ; arg Str options ; arg Str t
  var CBool center := options option "center"
  var CBool bold := options option "bold"
  t := round_rectangle_begin round rounded color ground " width=[dq]100%[dq]" " width=[dq]100%[dq]"
  t += shunt center "<center>" ""
  t += "<font face=[dq]Helvetica[dq]"+(shunt fontsize>0 " size=[dq]+"+string:fontsize+"[dq]" fontsize<0 " size=[dq]"+string:fontsize+"[dq]" "")+" color=[dq]"+fontcolor:html_encoding+"[dq]>"
  t += shunt bold "<b>" ""
  t += shunt center "" "&nbsp;&nbsp;&nbsp;"
  t += tag_option "label" "" "" ""
  t += shunt bold "</b>" ""
  t += "</font>"
  t += shunt center "</center>" ""
  t += round_rectangle_end round rounded color ground


style_setup
  var Str browser := http_request browser_model
  var Float hue := options option "hue" Float 
  var CBool print := page:options option "print"
  var Float hue := options option "hue" Float
  if hue=undefined
    hue := 130
  var Float saturation := options option "staturation" Float 
  if saturation=undefined
    saturation := 32
  var Float ground_light := 80
  var Float ground_saturation := saturation/24
  var PixelRGB888 ground := lsh_pixel ground_light ground_saturation hue
  var CBool rounded := browser<>"" and browser<>"netscape"

  # tag_style "doctype" "<!DOCTYPE HTML PUBLIC [dq]-//W3C//DTD HTML 3.2 Final//EN[dq]>[lf]"
  tag_style "doctype" "<!DOCTYPE HTML PUBLIC [dq]-//W3C//DTD HTML 4.01 Transitional//EN[dq]>[lf]"
  var Str icon := "" # "<link REL=[dq]icon[dq] HREF=[dq]/common/pliant16.png[dq] TYPE=[dq]image/png[dq]>[lf]"
  tag_style "head" "<head>[lf]"+icon+"<script src=[dq]/common/pliant.js[dq] language=[dq]JavaScript[dq] type=[dq]text/javascript[dq]></script>[lf]"
  tag_style "stylesheet" ""
  tag_style "script" ""
  var Str form_encoding := ""
  if http_request:browser_model="konqueror"
    form_encoding := " enctype [dq]multipart/form-data[dq]"
  # tag_style "body" "<body bgcolor=[dq]"+ground:html_encoding+"[dq] onLoad=[dq]refresh()[dq]>[lf]<form name=[dq]pliant[dq] method=[dq]POST[dq]"+form_encoding+(tag_option "url" " action=[dq]" "?submit[dq]" "")+" onSubmit=[dq]return complete(this)[dq]>[lf]<input type=[dq]hidden[dq] name=[dq]_pliant_x[dq] value=[dq][dq]>[lf]<input type=[dq]hidden[dq] name=[dq]_pliant_y[dq] value=[dq][dq]>[lf]<input type=[dq]hidden[dq] name=[dq]_pliant_reload[dq] value=[dq]false[dq]>[lf]<input type=[dq]hidden[dq] name=[dq]_[dq] value=[dq][dq]>[lf]"
  tag_style "body" "<body bgcolor=[dq]"+ground:html_encoding+"[dq] onLoad=[dq]refresh()[dq]>[lf]<form name=[dq]pliant[dq] method=[dq]POST[dq]"+form_encoding+(tag_option "url" " action=[dq]" "?submit[dq]" "")+" onSubmit=[dq]return complete(this)[dq]>[lf]<input type=[dq]hidden[dq] name=[dq]_pliant_x[dq] value=[dq][dq]>[lf]<input type=[dq]hidden[dq] name=[dq]_pliant_y[dq] value=[dq][dq]>[lf]<input type=[dq]hidden[dq] name=[dq]_[dq] value=[dq][dq]>[lf]"
  tag_style "body" "<body"+(shunt print "" " bgcolor=[dq]"+ground:html_encoding+"[dq]")+" onLoad=[dq]refresh()[dq]>[lf]<form name=[dq]pliant[dq] method=[dq]POST[dq]"+form_encoding+(tag_option "url" " action=[dq]" "?submit[dq]" "")+" onSubmit=[dq]return complete(this)[dq]>[lf]<input type=[dq]hidden[dq] name=[dq]_pliant_x[dq] value=[dq][dq]>[lf]<input type=[dq]hidden[dq] name=[dq]_pliant_y[dq] value=[dq][dq]>[lf]<input type=[dq]hidden[dq] name=[dq]_[dq] value=[dq][dq]>[lf]"
  tag_style "page_top" ""
  tag_style "page_bottom" ""
  tag_style "/body" "</form>[lf]</body>[lf]"

  tag_style "eol" "<br"+slash+">[lf]"

  tag_style "link" "<a"+(tag_option "url" " href=[dq]" "[dq]" "")+">"+(tag_option "label" "" "" "")+"</a>[lf]"
  tag_style "section" "<a"+(tag_option "name" " name=[dq]" "[dq]" "")+"></a>"
  tag_style "image" "<img"+(tag_option "url" " src=[dq]" "[dq]" "")+slash+">"

  var Float title_light := 64
  var Float title_saturation := saturation/3
  var PixelRGB888 titleground := lsh_pixel title_light title_saturation hue
  var PixelRGB888 fontcolor := lsh_pixel 15 20 hue
  var Str logo_head := tag_flag "logo" "<table border=[dq]0[dq] width=[dq]100%[dq]>[lf]<tr><td width=[dq]100%[dq]>" ""
  var Str logo_tail := (tag_flag "logo" "</td><td>" "")+(tag_option "url" "<a href=[dq]" "[dq]>" "")+(tag_option "logo" "<img src=[dq]" "[dq] border=[dq]0[dq]>" "")+(tag_flag "url" "</a>" "")+(tag_flag "logo" "</td></tr>[lf]</table>[lf]" "")
  tag_style "title" "<title>"+(tag_option "label" "" "" "")+"</title>[lf]<p>[lf]"+logo_head+(title 10 rounded titleground ground fontcolor 3 "center bold")+logo_tail+"</p>[lf]<br>[lf]"
  if print
    tag_style "title" "<title>"+(tag_option "label" "" "" "")+"</title>[lf]<h1><center>"+(tag_option "label" "" "" "")+"</center></h1><br>[lf]"
  else
    var Float title_light := 64
    var Float title_saturation := saturation/3
    var PixelRGB888 titleground := lsh_pixel title_light title_saturation hue
    var PixelRGB888 fontcolor := lsh_pixel 15 20 hue
    var Str logo_head := tag_flag "logo" "<table border=[dq]0[dq] width=[dq]100%[dq]>[lf]<tr><td width=[dq]100%[dq]>" ""
    var Str logo_tail := (tag_flag "logo" "</td><td>" "")+(tag_option "url" "<a href=[dq]" "[dq]>" "")+(tag_option "logo" "<img src=[dq]" "[dq] border=[dq]0[dq]>" "")+(tag_flag "url" "</a>" "")+(tag_flag "logo" "</td></tr>[lf]</table>[lf]" "")
    tag_style "title" "<title>"+(tag_option "label" "" "" "")+"</title>[lf]<p>[lf]"+logo_head+(title 10 rounded titleground ground fontcolor 3 "center bold")+logo_tail+"</p>[lf]<br>[lf]"

  tag_style "chapter" "<br>[lf]<br>[lf]<p>[lf]"+(title 10 rounded titleground ground fontcolor 3 "bold")+"</p>[lf]"
  if print
    tag_style "chapter" "<h1>"+(tag_option "label" "" "" "")+"</h1>[lf]"
  else
    tag_style "chapter" "<br>[lf]<br>[lf]<p>[lf]"+(title 10 rounded titleground ground fontcolor 3 "bold")+"</p>[lf]"

  titleground := lsh_pixel title_light*0.67+ground_light*0.33 title_saturation*0.67+ground_saturation*0.33 hue
  fontcolor := lsh_pixel 30 25 hue
  tag_style "header1" "<br>[lf]<p>[lf]"+(title 5 rounded titleground ground fontcolor 2 "bold")+"</p>[lf]"
  if print
    tag_style "header1" "<h2>"+(tag_option "label" "" "" "")+"</h2>[lf]"
  else
    titleground := lsh_pixel title_light*0.67+ground_light*0.33 title_saturation*0.67+ground_saturation*0.33 hue
    fontcolor := lsh_pixel 30 25 hue
    tag_style "header1" "<br>[lf]<p>[lf]"+(title 5 rounded titleground ground fontcolor 2 "bold")+"</p>[lf]"

  titleground := lsh_pixel title_light*0.33+ground_light*0.67 title_saturation*0.33+ground_saturation*0.67 hue
  fontcolor := lsh_pixel 40 30 hue
  tag_style "header2" "<p>[lf]"+(title 5 rounded titleground ground fontcolor 0 "")+"</p>[lf]"
  if print
    tag_style "header1" "<h3>"+(tag_option "label" "" "" "")+"</h3>[lf]"
  else
    titleground := lsh_pixel title_light*0.33+ground_light*0.67 title_saturation*0.33+ground_saturation*0.67 hue
    fontcolor := lsh_pixel 40 30 hue
    tag_style "header2" "<p>[lf]"+(title 5 rounded titleground ground fontcolor 0 "")+"</p>[lf]"

  titleground := lsh_pixel title_light*0.17+ground_light*0.83 title_saturation*0.17+ground_saturation*0.83 hue
  fontcolor := lsh_pixel 50 25 hue
  tag_style "header3" "<p>[lf]"+(title 3 rounded titleground ground fontcolor -1 "")+"</p>[lf]"
  if print
    tag_style "header1" "<h4>"+(tag_option "label" "" "" "")+"</h4>[lf]"
  else
    titleground := lsh_pixel title_light*0.17+ground_light*0.83 title_saturation*0.17+ground_saturation*0.83 hue
    fontcolor := lsh_pixel 50 25 hue
    tag_style "header3" "<p>[lf]"+(title 3 rounded titleground ground fontcolor -1 "")+"</p>[lf]"

  if false
    var PixelRGB888 buttonground := lsh_pixel 60 20 220
    var PixelRGB888 fontcolor := lsh_pixel 100 0 0
    var Str event := shunt browser="netscape" "onMouseUp" "onClick"
    var Str event := tag_option "id" " "+event+"=[dq]button_pressed('" "')[dq]" ""
    var Str t := "<table cellpadding=[dq]1[dq] cellspacing=[dq]0[dq] border=[dq]0[dq]><tr><td"+event+">"
    t += round_rectangle_begin 3 true buttonground ground "" ""
    t += "<font face=[dq]Helvetica[dq] size=[dq]-1[dq] color=[dq]"+fontcolor:html_encoding+"[dq]>"+(tag_option "label" "" "" "")+"</font>"
    t += round_rectangle_end 3 true buttonground ground
    t += "</td></tr></table>[lf]"
    tag_style "button" t
  tag_style "button" "<input type=[dq]submit[dq]"+(tag_option "id" " name=[dq]" "[dq]" "")+(tag_option "label" " value=[dq]" "[dq]" "")+">[lf]"

  tag_style "para" "<p>[lf]"+(tag_option "header" "<b>" "</b>[lf]<br>[lf]" "")+(tag_option "what" "<i>" ": </i>[lf]" "")
  tag_style "/para" "</p>[lf]"
  tag_style "center" "<center>"
  tag_style "/center" "</center>"
  tag_style "bold" "<b>"
  tag_style "/bold" "</b>"
  tag_style "italic" "<i>"
  tag_style "/italic" "</i>"
  tag_style "big" "<font size=[dq]+1[dq]>"
  tag_style "/big" "</font>"
  tag_style "small" "<font size=[dq]-1[dq]>"
  tag_style "/small" "</font>"
  tag_style "fixed" "<tt>"
  tag_style "/fixed" "</tt>"
  tag_style "color" "<font"+(tag_option "color" " color=[dq]" "[dq]" "")+"[dq]>"
  tag_style "/color" "</font>"
  tag_style "highlight" "<tt> </tt><font size=[dq]-2[dq] color=[dq]"+(lsh_pixel 75 100 0):html_encoding+"[dq]><b>"
  tag_style "/highlight" "</b></font>[lf]"

  tag_style "list" "<ul>[lf]"
  tag_style "/list" "</ul>[lf]"
  tag_style "item" "<li>[lf]"
  tag_style "/item" "</li>[lf]"

  tag_style "table" "<p>[lf]<table"+(tag_option "id" " id=[dq]" "[dq]" "")+(tag_option "padding" " cellpadding=[dq]" "[dq]" "")+(tag_option "spacing" " cellspacing=[dq]" "[dq]" "")+(tag_option "border" " border=[dq]" "[dq]" "")+">"
  tag_style "/table" "</table>[lf]</p>[lf]"
  tag_style "row" "<tr>[lf]"
  tag_style "/row" "</tr>[lf]"
  var PixelRGB888 cellheaderground := lsh_pixel ground_light*0.83+title_light*0.17 saturation/6 hue
  tag_style "cell" "<td"+(tag_option "id" " id=[dq]" "[dq]" "")+(tag_option "ground" " bgcolor=[dq]" "[dq]" "")+(tag_flag "header" " bgcolor=[dq]"+cellheaderground:html_encoding+"[dq]" "")+">"
  tag_style "/cell" "</td>[lf]"

  var Str db_events := shunt browser="konqueror" " onFocus=[dq]textin(this)[dq] onBlur=[dq]textout(this)[dq]" " onChange=[dq]change(this)[dq]"
  tag_style "input" (tag_option "label" "" "" "")+"<input"+(tag_option "type" " type=[dq]" "[dq]" "")+(tag_option "name" " name=[dq]" "[dq]" "")+(tag_option "value" " value=[dq]" "[dq]" " value=[dq][dq]")+(tag_option "length" " size=[dq]" "[dq]" "")+(tag_flag "database" db_events "")+(tag_option "events" "" "" "")+">[lf]"
  tag_style "textarea" (tag_option "label" "" "" "")+"<textarea"+(tag_option "name" " name=[dq]" "[dq]" "")+(tag_option "cols" " cols=[dq]" "[dq]" "")+(tag_option "rows" " rows=[dq]" "[dq]" "")+" wrap=[dq]off[dq]"+(tag_flag "database" db_events "")+">"+(tag_option "value" "" "" "")+"</textarea>[lf]"
  tag_style "pdata" (tag_option "label" "" "" "")+"<tt>[lf]<pdata"+(tag_option "path" " path=[dq]" "[dq]" "")+">"+(tag_option "value" "" "" "")+"</pdata>[lf]</tt>[lf]"
  var Str db_events := shunt browser="konqueror" " onFocus=[dq]selectin(this)[dq] onBlur=[dq]selectout(this)[dq]" " onChange=[dq]change(this)[dq]"
  tag_style "select" (tag_option "label" "" "" "")+"<select"+(tag_option "name" " name=[dq]" "[dq]" "")+(tag_flag "database" db_events "")+">[lf]"
  tag_style "/select" "</select>[lf]"
  tag_style "option" "<option"+(tag_flag "selected" " selected" "")+(tag_option "value" " value=[dq]" "[dq]" " value=[dq][dq]")+">"+(tag_option "label" "" "" "")+"</option>[lf]"

  var PixelRGB888 right_note_ground := lsh_pixel 85 20 60
  tag_style "note_right" "<table cellpadding=[dq]10[dq] cellspacing=[dq]0[dq] border=[dq]0[dq]"+(tag_option "width" " width=[dq]" "%[dq] align=right" "")+"><tr><td>"+(round_rectangle_begin 10 rounded right_note_ground ground "" "")
  tag_style "/note_right" (round_rectangle_end 10 rounded right_note_ground ground)+"</td></tr></table>[lf]"
  var PixelRGB888 inline_note_ground := lsh_pixel 90 0 0
  tag_style "note_inline" (round_rectangle_begin 10 rounded inline_note_ground ground "" "")
  tag_style "/note_inline" (round_rectangle_end 10 rounded inline_note_ground ground)
  tag_style "note_link" "<a"+(tag_option "url" " href=[dq]" "[dq]" "")+">"+(tag_option "label" "" "" "")+"</a>[lf]"

  var PixelRGB888 listingground := lsh_pixel 90 0 0
  tag_style "listing" (round_rectangle_begin 5 false listingground ground "" "")+"<tt>"
  # tag_style "listing" "<p>[lf]<tt>[lf]"
  tag_style "/listing" "</tt>"+(round_rectangle_end 5 false listingground ground)
  # tag_style "/listing" "</tt>[lf]</p>[lf]"


#---------------------------------------------------------------------------
#  basic


method p eol
  arg_rw HtmlPage p
  p tag "eol" ""

export '. eol'


#---------------------------------------------------------------------------
#  links and images


method p hyperlink html_encoded_label target autoext section options
  arg_rw HtmlPage p ; arg Str html_encoded_label target ; arg CBool autoext ; arg Str section options
  var Str without_path := target (target search_last "/" -1)+1 target:len
  var Str url := target
  if autoext and without_path:len<>0 and (without_path search "." -1)=(-1) and (without_path search ":" -1)=(-1)
    url += ".html"
  if options<>""
    url += "?"+http_encode:options
  if section<>""
    url += "#"+http_encode:section
  p tag "link" "label "+string:html_encoded_label+" url [dq]"+url+"[dq]"

method p text_hyperlink label target autoext section options
  arg_rw HtmlPage p ; arg Str label target ; arg CBool autoext ; arg Str section options
  p hyperlink html_encode:label target autoext section options

meta '. link' e
  if e:size<3 or not (e:0 cast HtmlPage) or not (e:1 cast Str) or not (e:2 cast Str)
    return
  e suckup e:0 ; e suckup e:1 ; e suckup e:2
  var Link:Argument autoext :> argument constant CBool true
  var Link:Argument section :> argument constant Str ""
  var Link:Argument options :> argument constant Str ""
  var Int i := 3
  while i<e:size
    if e:i:ident="no_extension"
      autoext :> argument constant CBool false
      i += 1
    eif e:i:ident="section" and i+1<e:size and (e:(i+1) cast Str)
      e suckup e:(i+1)
      section :> e:(i+1):result
      i += 2
    eif e:i:ident="options" and i+1<e:size and (e:(i+1) cast Str)
      e suckup e:(i+1)
      options :> e:(i+1):result
      i += 2
    else
      return
  e add (instruction (the_function '. text_hyperlink' HtmlPage Str Str CBool Str Str) e:0:result e:1:result e:2:result autoext section options)
  e set_void_result


method p section name
  arg_rw HtmlPage p ; arg Str name
  p tag "section" "name [dq]"+http_encode:name+"[dq]"


method p image img
  arg_rw HtmlPage p ; arg Str img
  var Str link
  p tag "image" "url [dq]"+img+"[dq]"


method p image_hyperlink img target autoext section options
  arg_rw HtmlPage p ; arg Str img target ; arg CBool autoext ; arg Str section options
  p hyperlink "<img src=[dq]"+img+"[dq] border=[dq]0[dq]"+slash+">" target autoext section options

meta '. image' e
  if e:size<3 or not (e:0 cast HtmlPage) or not (e:1 cast Str) or not (e:2 cast Str)
    return
  e suckup e:0 ; e suckup e:1 ; e suckup e:2
  var Link:Argument autoext :> argument constant CBool true
  var Link:Argument section :> argument constant Str ""
  var Link:Argument options :> argument constant Str ""
  var Int i := 3
  while i<e:size
    if e:i:ident="no_extension"
      autoext :> argument constant CBool false
      i += 1
    eif e:i:ident="section" and i+1<e:size and (e:(i+1) cast Str)
      e suckup e:(i+1)
      section :> e:(i+1):result
      i += 2
    eif e:i:ident="options" and i+1<e:size and (e:(i+1) cast Str)
      e suckup e:(i+1)
      options :> e:(i+1):result
      i += 2
    else
      return
  e add (instruction (the_function '. image_hyperlink' HtmlPage Str Str CBool Str Str) e:0:result e:1:result e:2:result autoext section options)
  e set_void_result


named_expression left_image
  table columns 2 border 0
    cell
      image filename options
    cell
      body

named_expression right_image
  table columns 2 border 0
    cell
      body
    cell
      image filename options

meta '. image' e
  if e:size>=4 and (e:0 cast HtmlPage) and (e:1 cast Str) and (e e:size-2):is_pure_ident and (e e:size-1):ident="{}"
    if (e e:size-2):ident="left"
      e compile_as (expression duplicate left_image substitute page e:0 substitute filename e:1 substitute options (e 2 e:size-4) substitute body (e e:size-1))
    eif (e e:size-2):ident="right"
      e compile_as (expression duplicate right_image substitute page e:0 substitute filename e:1 substitute options (e 2 e:size-4) substitute body (e e:size-1))


meta '. how' e
  if e:size>=2 and (e:0 cast HtmlPage) and (e:1 cast Str)
    e compile_as (expression immediat (page image "/common/how.png" target options) substitute page e:0 substitute target e:1 substitute options (e 2 e:size-2))

export '. link' '. section' '. image' '. how'


#---------------------------------------------------------------------------
#  title and headers


method p html_title label logo url small
  arg_rw HtmlPage p ; arg Str label logo url ; arg CBool small
  p tag "title" "label [dq]"+(html_encode label true)+"[dq] logo [dq]"+logo+"[dq] url [dq]"+url+"[dq]"+(shunt small " small" "")
  if small
    var Pointer:Int h :> p:env kmap "default header level" Int 0
    h += 1

meta '. title' e
  if e:size<2 or not (e:0 cast HtmlPage) or not (e:1 cast Str)
    return
  var Link:Argument logo :> argument constant Str ""
  var Link:Argument url :> argument constant Str ""
  var Link:Argument small :> argument constant CBool false
  var Int n := e:size
  if n>2 and e:(n-1):is_pure_ident and e:(n-1):ident="small"
    small :> argument constant CBool true
    n -= 1
  if n>4
    return
  e suckup e:0 ; e suckup e:1
  if n>2
    if not (e:2 cast Str)
      return
    e suckup e:2
    logo :> e:2 result
  if n>3
    if not (e:3 cast Str)
      return
    e suckup e:3
    url :> e:3 result
  e add (instruction (the_function '. html_title' HtmlPage Str Str Str CBool) e:0:result e:1:result logo url small)
  e set_void_result
  


method p chapter label
  arg_rw HtmlPage p ; arg Str label
  p tag "chapter" "label [dq]"+(html_encode label true)+"[dq]"

method p html_header_begin label
  arg_rw HtmlPage p ; arg Str label
  var Pointer:Int h :> p:env kmap "default header level" Int 0
  h += 1
  p tag "header"+string:h "label [dq]"+(html_encode label true)+"[dq]"

method p html_header_end
  arg_rw HtmlPage p
  p:env kmap "default header level" Int -= 1

meta '. header' e
  if e:size<2 or e:size>3 or not (e:0 cast HtmlPage) or not (e:1 cast Str)
    return
  e suckup e:0 ; e suckup e:1
  e add (instruction (the_function '. html_header_begin' HtmlPage Str) e:0:result e:1:result)
  if e:size>=3
    e:2 compile ?
    e suckup e:2
  e add (instruction (the_function '. html_header_end' HtmlPage) e:0:result)
  e set_void_result

method p small_headers
  arg_rw HtmlPage p
  var Pointer:Int h :> p:env kmap "default header level" Int 0
  h += 1


simple_bloc_tag para

method p html_para_begin header what
  arg_rw HtmlPage p ; arg Str header what
  p tag "para" "header [dq]"+(html_encode header true)+"[dq] what [dq]"+(html_encode what true)+"[dq]"

method p html_para_end
  arg_rw HtmlPage p
  p tag "/para" ""
  

meta '. para' e
  if e:size<3 or not (e:0 cast HtmlPage)
    return
  var Link:Argument h :> argument constant Str ""
  var Link:Argument w :> argument constant Str ""
  var Link:Argument w0 :> w
  e suckup e:0
  var Int i := 1
  while i<e:size-1
    if e:i:ident="header" and i+1<e:size-1 and (e:(i+1) cast Str)
      e suckup e:(i+1)
      h :> e:(i+1):result
      i += 2
    eif (e:i cast Str) and addressof:w=addressof:w0
      e suckup e:i
      w :> e:i:result
      i += 1
    else
      return
  e add (instruction (the_function '. html_para_begin' HtmlPage Str Str) e:0:result h w)
  e:(e:size-1) compile ?
  e suckup e:(e:size-1)
  e add (instruction (the_function '. html_para_end' HtmlPage) e:0:result)
  e set_void_result


export '. title' '. chapter' '. header' '. small_headers' '. para'


#---------------------------------------------------------------------------
#  text attributs


simple_bloc_tag center
simple_bloc_tag bold
simple_bloc_tag italic
simple_bloc_tag big
simple_bloc_tag small


method p html_fixed_begin m
  arg_rw HtmlPage p ; arg_w Int m
  p tag "fixed" ""
  m := p do_not_use_Int
  p do_not_use_Int := p:do_not_use_Int .or. 1

method p html_fixed_end m
  arg_rw HtmlPage p ; arg Int m
  p tag "/fixed" ""
  p do_not_use_Int := m

meta '. fixed' e
  if e:size<>2 or not (e:0 cast HtmlPage)
    return
  eif (entry_type e:1:value)=Str
    return
  e suckup e:0
  var Link:Argument m :> argument local Int
  e add (instruction (the_function '. html_fixed_begin' HtmlPage Int) e:0:result m)
  e:1 compile ?
  e suckup e:1
  e add (instruction (the_function '. html_fixed_end' HtmlPage Int) e:0:result m)
  e set_void_result


method p html_lsh_color_begin l s h
  arg_rw HtmlPage p ; arg Float l s h
  p tag "color" "color "+(string (lsh_pixel l s h):html_encoding)

method p html_rgb_color_begin r g b
  arg_rw HtmlPage p ; arg Int r g b
  p tag "color" "color [dq]"+(rgb_pixel r g b):html_encoding+"[dq]"

method p html_color_end
  arg_rw HtmlPage p
  p tag "/color" ""

meta '. color' e
  if e:size<2 or not (e:0 cast HtmlPage)
    return
  e suckup e:0
  var Link:Function f
  if e:1:ident="lsh" and e:size=6 and (e:2 cast Float) and (e:3 cast Float) and (e:4 cast Float)
    f :> the_function '. html_lsh_color_begin' HtmlPage Float Float Float
  eif e:1:ident="rgb" and e:size=6 and (e:2 cast Int) and (e:3 cast Int) and (e:4 cast Int)
    f :> the_function '. html_rgb_color_begin' HtmlPage Int Int Int
  else
    return
  for (var Int i) 2 e:size-2
    e suckup e:i
  if e:size=6
    e add (instruction f e:0:result e:2:result e:3:result e:4:result)
  else
    e add (instruction f e:0:result e:2:result)
  e:(e:size-1) compile ? ; e suckup e:(e:size-1)
  e add (instruction (the_function '. html_color_end' HtmlPage) e:0:result)
  e set_void_result

method p highlight msg
  arg_rw HtmlPage p ; arg Str msg
  p tag "highlight" ""
  p text msg
  p tag "/highlight" ""
  
export '. center' '. bold' '. italic' '. big' '. small' '. fixed' '. color' '. highlight'


#---------------------------------------------------------------------------
# lists


simple_bloc_tag list
simple_bloc_tag item

export '. list' '. item'


#---------------------------------------------------------------------------
# tables


method p html_table_begin columns padding spacing border m1 m2
  arg_rw HtmlPage p ; arg Int columns padding spacing border ; arg_w Int m1 m2
  var Pointer:Int nb :> p:env kmap "default table columns" Int
  var Pointer:Int cur :> p:env kmap "default table cursor" Int
  if (p:do_not_use_Int .and. 2)<>0
    var Str tid := generate_id
    var (Pointer List:Str) ids :> p:env kmap "default id" List:Str
    ids += tid
  m1 := nb
  m2 := cur
  p tag "table" "id [dq]"+tid+"[dq] padding [dq]"+string:padding+"[dq] spacing [dq]"+string:spacing+"[dq] border [dq]"+string:border+"[dq]"
  nb := columns
  cur := 0

method p html_table_end m1 m2
  arg_rw HtmlPage p ; arg Int m1 m2
  p tag "/table" ""
  p:env kmap "default table columns" Int := m1
  p:env kmap "default table cursor" Int := m2
  if (p:do_not_use_Int .and. 2)<>0
    var (Pointer List:Str) ids :> p:env kmap "default id" List:Str
    ids remove ids:last

meta '. table' e
  if e:size<2 or not (e:0 cast HtmlPage)
    return
  var Int i := 1
  var Pointer:Argument columns :> argument constant Int 2
  var Pointer:Argument padding :> argument constant Int 4
  var Pointer:Argument spacing :> argument constant Int 1
  var Pointer:Argument border :> argument constant Int 1
  var Pointer:Argument m1 :> argument local Int
  var Pointer:Argument m2 :> argument local Int
  while i<e:size-1
    if e:i:ident="columns" and i+1<e:size-1 and (e:(i+1) cast Int)
      e suckup e:(i+1)
      columns :> e:(i+1) result
      i += 2
    eif (e:i:ident="padding" or e:i:ident="enlarge") and i+1<e:size-1 and (e:(i+1) cast Int)
      e suckup e:(i+1)
      padding :> e:(i+1) result
      i += 2
    eif e:i:ident="spacing" and i+1<e:size-1 and (e:(i+1) cast Int)
      e suckup e:(i+1)
      spacing :> e:(i+1) result
      i += 2
    eif e:i:ident="border" and i+1<e:size-1 and (e:(i+1) cast Int)
      e suckup e:(i+1)
      border :> e:(i+1) result
      i += 2
    else
      return
  e suckup e:0
  e add (instruction (the_function '. html_table_begin' HtmlPage Int Int Int Int Int Int) e:0:result columns padding spacing border m1 m2)
  e:(e:size-1) compile ?
  e suckup e:(e:size-1)
  e add (instruction (the_function '. html_table_end' HtmlPage Int Int) e:0:result m1 m2)
  e set_void_result


method p cell_id -> options
  arg_rw HtmlPage p ; arg Str options
  if (p:do_not_use_Int .and. 2)<>0
    var Str cid := generate_id
    var (Pointer List:Str) ids :> p:env kmap "default id" List:Str
    ids += cid
    options := "id [dq]"+cid+"[dq] "
  else
    options := ""

method p html_cell_begin
  arg_rw HtmlPage p
  var Pointer:Int cur :> p:env kmap "default table cursor" Int
  if cur=0
    p tag "row" ""
  p tag "cell" p:cell_id

method p html_header_cell_begin
  arg_rw HtmlPage p
  var Pointer:Int cur :> p:env kmap "default table cursor" Int
  if cur=0
    p tag "row" ""
  p tag "cell" p:cell_id+"header"

method p html_lsh_cell_begin l s h
  arg_rw HtmlPage p ; arg Float l s h
  if l=undefined or s=undefined or h=undefined
    p html_cell_begin
    return
  var Pointer:Int cur :> p:env kmap "default table cursor" Int
  if cur=0
    p tag "row" ""
  p tag "cell" p:cell_id+"ground [dq]"+(lsh_pixel l s h):html_encoding+"[dq]"

method p html_rgb_cell_begin r g b
  arg_rw HtmlPage p ; arg Int r g b
  if r<0 or r>=256 or g<0 or g>=256 or b<0 or b>=256
    p html_cell_begin
    return
  var Pointer:Int cur :> p:env kmap "default table cursor" Int
  if cur=0
    p tag "row" ""
  p tag "cell" p:cell_id+"ground [dq]"+(rgb_pixel r g b):html_encoding+"[dq]"

method p html_cell_end
  arg_rw HtmlPage p
  p tag "/cell" ""
  var Pointer:Int nb :> p:env kmap "default table columns" Int
  var Pointer:Int cur :> p:env kmap "default table cursor" Int
  cur += 1
  if cur=nb
    p tag "/row" ""
    cur := 0
  if (p:do_not_use_Int .and. 2)<>0
    var (Pointer List:Str) ids :> p:env kmap "default id" List:Str
    ids remove ids:last

meta '. cell' e
  if e:size<2 or not (e:0 cast HtmlPage)
    return
  var Int i := 1
  var Int lsh_color := undefined
  var Int rgb_color := undefined
  var CBool header := false
  while i<e:size-1
    if e:i:ident="color" and i+4<e:size-1 and e:(i+1):ident="lsh" and (e:(i+2) cast Float) and (e:(i+3) cast Float) and (e:(i+4) cast Float)
      lsh_color := i+2
      i += 5
    eif e:i:ident="color" and i+4<e:size-1 and e:(i+1):ident="rgb" and (e:(i+2) cast Int) and (e:(i+3) cast Int) and (e:(i+4) cast Int)
      rgb_color := i+2
      i += 5
    eif e:i:ident="header"
      header := true
      i += 1
    else
      return
  e suckup e:0
  if lsh_color=defined
    e suckup e:lsh_color
    e suckup e:(lsh_color+1)
    e suckup e:(lsh_color+2)
    e add (instruction (the_function '. html_lsh_cell_begin' HtmlPage Float Float Float) e:0:result e:lsh_color:result e:(lsh_color+1):result e:(lsh_color+2):result)
  eif rgb_color=defined
    e suckup e:rgb_color
    e suckup e:(rgb_color+1)
    e suckup e:(rgb_color+2)
    e add (instruction (the_function '. html_rgb_cell_begin' HtmlPage Int Int Int) e:0:result e:rgb_color:result e:(rgb_color+1):result e:(rgb_color+2):result)
  eif header
    e add (instruction (the_function '. html_header_cell_begin' HtmlPage) e:0:result)
  else
    e add (instruction (the_function '. html_cell_begin' HtmlPage) e:0:result)
  e:(e:size-1) compile ?
  e suckup e:(e:size-1)
  e add (instruction (the_function '. html_cell_end' HtmlPage) e:0:result)
  e set_void_result

export '. table' '. cell'


#---------------------------------------------------------------------------
# input fields
  

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

method p html_input ident data fun label length flags
  arg_rw HtmlPage p ; arg Str ident ; arg Universal data ; arg Function fun ; arg Str label ; arg Int length ; arg uInt flags
  p tag "input" "label [dq]"+html_encode:label+"[dq] type [dq]"+(shunt (flags .and. 2)=0 "text" "password")+"[dq] name [dq]"+ident+"[dq] value [dq]"+html_encode:(to_string data "raw" fun)+"[dq]"+(shunt length=defined " length [dq]"+string:length+"[dq]" "")
  if (flags .and. 1)<>0
    p eol

if database

  method p data_input d label length flags
    arg_rw HtmlPage p ; arg Data_ d ; arg Str label ; arg Int length ; arg uInt flags
    if (d:interface get d addressof:(var Str value) Str)=failure
      value := ""
    p text label
    if p:read_only_mode
      p tag "pdata" "path [dq]"+d:path+"[dq] value [dq]"+html_encode:value+"[dq]"
    else
      var Str dpath := replace (replace d:path "&#" "(") ";" ")"
      p tag "input" "type [dq]"+(shunt (flags .and. 2)=0 "text" "password")+"[dq] name [dq]|"+dpath+"|"+(p:request generate_signature d:path)+"[dq] value [dq]"+html_encode:value+"[dq]"+(shunt length=defined " length [dq]"+string:length+"[dq]" "")+" database"
    if (flags .and. 1)<>0
      p eol

meta '. input' e
  if e:size<3 or not (e:0 cast HtmlPage) or not (e:1 cast Str)
    return
  e:2:compile ?
  var CBool data := database and e:2:is_data
  if not data
    var Str name := shunt e:2:size=0 e:2:ident e:2:(e:2:size-1):ident
    if name=""
      return
    var Link:Type type :> e:2:result:type:real_data_type
    if not (e:2 cast type)
      return
    var Pointer:Function function :> type get_generic_method to_index
    if addressof:function=null or addressof:function=addressof:(the_function '. to string' Universal Str -> Str)
      return
    notify_editable_variable e:2    
  var uInt flags := 1
  var Link:Argument length :> argument constant Int undefined
  var Int i := 3
  while i<e:size
    if e:i:ident="noeol"
      flags := flags .and. .not. 1
      i += 1
    eif e:i:ident="password"
      flags := flags .or. 2
      i += 1
    eif e:i:ident="length" and i+1<e:size and (e:(i+1) cast Int)
      e suckup e:(i+1)
      length :> e:(i+1) result
      i += 2
    else
      return
  e suckup e:0 ; e suckup e:1 ; e suckup e:2
  if database and data
    e add (instruction (the_function '. data_input' HtmlPage Data_ Str Int uInt) e:0:result e:2:result e:1:result length (argument constant uInt flags))
  else
    e add (instruction (the_function '. html_input' HtmlPage Str Universal Function Str Int uInt) e:0:result (argument constant Str name) e:2:result (argument mapped_constant Function function) e:1:result length (argument constant uInt flags))
  e set_void_result


method p html_text_input label ident value nx ny
  arg_rw HtmlPage p ; arg Str label ident value ; arg Int nx ny
  p tag "textarea" "label [dq]"+html_encode:label+"[dq] name [dq]"+ident+"[dq]"+(shunt nx=defined " cols [dq]"+string:nx+"[dq]" "")+(shunt ny=defined " rows [dq]"+string:ny+"[dq]" "")+" value [dq]"+html_encode:value+"[dq]"

if database

  method p data_text_input d label nx ny
    arg_rw HtmlPage p ; arg Data_ d ; arg Str label ; arg Int nx ny
    if (d:interface get d addressof:(var Str value) Str)=failure
      value := ""
    if p:read_only_mode
      p table columns 1 border 0
        p cell
          p fixed
            p tag "pdata" "label [dq]"+html_encode:label+"[dq] path [dq]"+d:path+"[dq] value [dq]"+html_encode:value+"[dq]"
            # p text value
    else
      var Str dpath := replace (replace d:path "&#" "(") ";" ")"
      p tag "textarea" "label [dq]"+html_encode:label+"[dq] name [dq]|"+dpath+"|"+(p:request generate_signature d:path)+"[dq]"+(shunt nx=defined " cols [dq]"+string:nx+"[dq]" "")+(shunt ny=defined " rows [dq]"+string:ny+"[dq]" "")+" value [dq]"+html_encode:value+"[dq] database"

meta '. text_input' e
  if e:size<3 or not (e:0 cast HtmlPage) or not (e:1 cast Str)
    return
  e:2:compile ?
  var CBool data := database and e:2:is_data
  if not data
    var Str name := shunt e:2:size=0 e:2:ident e:2:(e:2:size-1):ident
    if name=""
      return
    if not (e:2 cast Str)
      return
    notify_editable_variable e:2
  var Bool eol := true
  var Link:Argument cols :> argument constant Int undefined
  var Link:Argument rows :> argument constant Int undefined
  var Int i := 3
  while i<e:size
    if e:i:ident="noeol"
      eol := false
      i += 1
    eif e:i:ident="columns" and i+1<e:size and (e:(i+1) cast Int)
      e suckup e:(i+1)
      cols :> e:(i+1) result
      i += 2
    eif e:i:ident="rows" and i+1<e:size and (e:(i+1) cast Int)
      e suckup e:(i+1)
      rows :> e:(i+1) result
      i += 2
    else
      return
  e suckup e:0 ; e suckup e:1 ; e suckup e:2
  if database and data
    e add (instruction (the_function '. data_text_input' HtmlPage Data_ Str Int Int) e:0:result e:2:result e:1:result cols rows)
  else
    e add (instruction (the_function '. html_text_input' HtmlPage Str Str Str Int Int) e:0:result e:1:result (argument constant Str name) e:2:result cols rows)
  if eol
    e add (instruction (the_function '. text' HtmlPage Str) e:0:result (argument constant Str "[lf]"))
  e set_void_result


method p html_select_begin ident data fun label
  arg_rw HtmlPage p ; arg Str ident ; arg Universal data ; arg Function fun ; arg Str label
  p tag "select" "label [dq]"+html_encode:label+"[dq] name [dq]"+ident+"[dq]"
  p:env kmap "default select active" Bool := true
  p:env kmap "default select value" Str := to_string data "raw" fun

method p html_select_end
  arg_rw HtmlPage p
  p tag "/select" ""
  p:env kmap "default select active" Bool := false
 
if database

  method p data_select_begin d label
    arg_rw HtmlPage p ; arg Data_ d ; arg Str label
    if (d:interface get d addressof:(var Str value) Str)=failure
      value := ""
    if p:read_only_mode
      p tag "pdata" "label [dq]"+html_encode:label+"[dq] path [dq]"+d:path+"[dq] value "+html_encode:value+"[dq]"
    else
      var Str dpath := replace (replace d:path "&#" "(") ";" ")"
      p tag "select" "label [dq]"+html_encode:label+"[dq] name [dq]|"+dpath+"|"+(p:request generate_signature d:path)+"[dq] database"
    p:env kmap "default select active" Bool := not p:read_only_mode
    p:env kmap "default select value" Str := value
  
  method p data_select_end
    arg_rw HtmlPage p
    if not p:read_only_mode
      p tag "/select" ""
    p:env kmap "default select active" Bool := false
   
meta '. select' e
  if e:size<4 or not (e:0 cast HtmlPage) or not (e:1 cast Str)
    return
  e:2:compile ?
  var CBool data := database and e:2:is_data
  if not data
    var Str name := shunt e:2:size=0 e:2:ident e:2:(e:2:size-1):ident
    if name=""
      return
    var Link:Type type :> e:2:result:type:real_data_type
    if not (e:2 cast type)
      return
    var Pointer:Function function :> type get_generic_method to_index
    if addressof:function=null or addressof:function=addressof:(the_function '. to string' Universal Str -> Str)
      return
    notify_editable_variable e:2
  var Bool eol := true
  var Int i := 3
  while i<e:size-1
    if e:i:ident="noeol"
      eol := false
      i += 1
    else
      return
  (e e:size-1) compile ?
  e suckup e:0 ; e suckup e:1 ; e suckup e:2
  if database and data
    e add (instruction (the_function '. data_select_begin' HtmlPage Data_ Str) e:0:result e:2:result e:1:result)
  else
    e add (instruction (the_function '. html_select_begin' HtmlPage Str Universal Function Str) e:0:result (argument constant Str name) e:2:result (argument mapped_constant Function function) e:1:result)
  e suckup (e e:size-1)
  if database and data
    e add (instruction (the_function '. data_select_end' HtmlPage) e:0:result)
  else
    e add (instruction (the_function '. html_select_end' HtmlPage) e:0:result)
  if eol
    e add (instruction (the_function '. text' HtmlPage Str) e:0:result (argument constant Str "[lf]"))
  e set_void_result


method p option label value
  arg_rw HtmlPage p; arg Str label value
  var CBool selected := value=(p:env kmap "default select value" Str)
  if (p:env kmap "default select active" Bool)
    p tag "option" (shunt selected "selected " "")+"label [dq]"+html_encode:label+"[dq] value [dq]"+html_encode:value+"[dq]"
  eif selected
    p fixed
      p text label


method p html_file_upload label ident
  arg_rw HtmlPage p ; arg Str label ident
  p tag "input" "label [dq]"+html_encode:label+"[dq] type [dq]file[dq] name [dq]file upload "+ident+"[dq]"

meta '. file_upload' e
  if e:size<3 or not (e:0 cast HtmlPage) or not (e:1 cast Str) or not (e:2 cast Str)
    return
  var Str name := shunt e:2:size=0 e:2:ident e:2:(e:2:size-1):ident
  if name=""
    return
  var Bool eol := true
  var Int i := 3
  while i<e:size
    if e:i:ident="noeol"
      eol := false
      i += 1
    else
      return
  e suckup e:0 ; e suckup e:1 ; e suckup e:2
  e add (instruction (the_function '. html_file_upload' HtmlPage Str Str) e:0:result e:1:result (argument constant Str name))
  if eol
    e add (instruction (the_function '. text' HtmlPage Str) e:0:result (argument constant Str "[lf]"))
  e set_void_result
  notify_editable_variable e:2

export '. input' '. text_input' '. select' '. option' '. file_upload'


#---------------------------------------------------------------------------
# buttons


method p html_button label id context
  arg_rw HtmlPage p ; arg Str label id context
  p tag "button" "id [dq]"+"button 0 0 "+id+" "+(p:request cipher (context 1 context:len))+" "+(p:request generate_signature id+" "+(context 1 context:len))+"[dq] label [dq]"+html_encode:label+"[dq]"

meta '. button' e
  if e:size<3 or not (e:0 cast HtmlPage) or not (e:1 cast Str)
    return
  var CBool eol := true
  var Str options := ""
  var Int i := 2
  while i<e:size-1
    if e:i:ident="noeol"
      eol := false
      i += 1
    eif e:i:ident="stay"
      options += " stay"
      i += 1
    eif e:i:ident="nostay"
      options += " nostay"
      i += 1
    else
      return
  if not (button_expression e options (var Str button_id) (var Link:Argument ctx))
    return
  e suckup e:0 ; e suckup e:1
  e add (instruction (the_function '. html_button' HtmlPage Str Str Str) e:0:result e:1:result (argument constant Str button_id) ctx)
  if eol
    e add (instruction (the_function '. text' HtmlPage Str) e:0:result (argument constant Str "[lf]"))
  e set_void_result


method p html_icon url help id context
  arg_rw HtmlPage p ; arg Str url help id context
  var Str action := "[dq]button_pressed('button 0 0 "+id+" "+(p:request cipher (context 1 context:len))+" "+(p:request generate_signature id+" "+(context 1 context:len))+"')[dq]"
  var Str event := " onClick="+action
  if p:http_request:browser_model="netscape"
    event += " onMouseUp="+action
  p html "<img src=[dq]"+html_encode:url+"[dq] alt=[dq]"+html_encode:help+"[dq]"+event+slash+">"

meta '. icon' e
  if e:size<3 or not (e:0 cast HtmlPage) or not (e:1 cast Str)
    return
  var Link:Argument help :> argument constant Str ""
  var Str options := ""
  var Int i := 2
  while i<e:size-1
    if e:i:ident="help" and i+1<e:size-1 and (e:(i+1) cast Str)
      e suckup e:(i+1)
      help :> e:(i+1) result
      i += 2
    eif e:i:ident="stay"
      options += " stay"
      i += 1
    eif e:i:ident="nostay"
      options += " nostay"
      i += 1
    else
      return
  if not (button_expression e options (var Str button_id) (var Link:Argument ctx))
    return
  e suckup e:0 ; e suckup e:1
  e add (instruction (the_function '. html_icon' HtmlPage Str Str Str Str) e:0:result e:1:result help (argument constant Str button_id) ctx)
  e set_void_result


method p html_popup url help size_x size_y id context
  arg_rw HtmlPage p ; arg Str url help ; arg Int size_x size_y ; arg Str id context
  var Str event := shunt p:http_request:browser_model="netscape" "onMouseUp" "onClick"
  p html "<img src=[dq]"+html_encode:url+"[dq] alt=[dq]"+html_encode:help+"[dq] "+event+"=[dq]window.open('"+p:request:url_path+"?button+0+0+"+http_encode:id+"+"+(p:request cipher context)+"+"+(p:request generate_signature id+" "+context)+"','popup','width="+string:size_x+",height="+string:size_y+",scrollbars')[dq]"+slash+">"

meta '. popup' e
  if e:size<3 or not (e:0 cast HtmlPage) or not (e:1 cast Str)
    return
  var Link:Argument help :> argument constant Str ""
  var Link:Argument size_x :> argument constant Int 512
  var Link:Argument size_y :> argument constant Int 256
  var Str options := ""
  var Int i := 2
  while i<e:size-1
    if e:i:ident="help" and i+1<e:size-1 and (e:(i+1) cast Str)
      e suckup e:(i+1)
      help :> e:(i+1) result
      i += 2
    eif e:i:ident="size" and i+2<e:size-1 and (e:(i+1) cast Int) and (e:(i+2) cast Int)
      e suckup e:(i+1) ; e suckup e:(i+2)
      size_x :> e:(i+1) result ; size_y :> e:(i+2) result
      i += 3
    eif e:i:ident="stay"
      options += " stay"
      i += 1
    eif e:i:ident="nostay"
      options += " nostay"
      i += 1
    else
      return
  if not (button_expression e options (var Str button_id) (var Link:Argument ctx))
    return
  e suckup e:0 ; e suckup e:1
  e add (instruction (the_function '. html_popup' HtmlPage Str Str Int Int Str Str) e:0:result e:1:result help size_x size_y (argument constant Str button_id) ctx)
  e set_void_result

method page close
  arg_rw HtmlPage page
  if (page:env first "default dynamic")=null
    page:http_request answer_is_dynamic := true
  page html "<script language=[dq]JavaScript[dq]>[lf]"
  page html "  window.opener.location.reload(true)[lf]"
  page html "  window.close()[lf]"
  page html "</script>[lf]"
  page:env insert "default backward" true entry_new:Void


method p html_note label id context
  arg_rw HtmlPage p ; arg Str label id context
  p tag "note_link" "url [dq]"+p:request:url_path+"?button+0+0+"+http_encode:id+"+"+(p:request cipher context)+"+"+(p:request generate_signature id+" "+context)+"[dq] label [dq]"+html_encode:label+"[dq]"

meta '. note' e
  if e:size<>3 or not (e:0 cast HtmlPage) or not (e:1 cast Str)
    return
  if not (button_expression e "" (var Str button_id) (var Link:Argument ctx))
    return
  e suckup e:0 ; e suckup e:1
  e add (instruction (the_function '. html_note' HtmlPage Str Str Str) e:0:result e:1:result (argument constant Str button_id) ctx)
  e set_void_result

method p html_note_begin width
  arg_rw HtmlPage p ; arg Float width
  p tag "note_right" "width [dq]"+string:(cast width*100 Int)+"[dq]"

method p html_note_end
  arg_rw HtmlPage p
  p tag "/note_right" ""
  
meta '. note' e
  if e:size=4 and (e:0 cast HtmlPage) and e:1:ident="right" and (e:2 cast Float)
    e:3 compile ?
    e suckup e:0 ; e suckup e:2
    e add (instruction (the_function '. html_note_begin' HtmlPage Float) e:0:result e:2:result)
    e suckup e:3
    e add (instruction (the_function '. html_note_end' HtmlPage) e:0:result)
    e set_void_result
  eif e:size=3 and (e:0 cast HtmlPage) and e:1:ident="inline"
    e:2 compile ?
    e suckup e:0
    e add (instruction (the_function '. tag' HtmlPage Str Str) e:0:result (argument constant Str "note_inline") (argument constant Str ""))
    e suckup e:2
    e add (instruction (the_function '. tag' HtmlPage Str Str) e:0:result (argument constant Str "/note_inline") (argument constant Str ""))
    e set_void_result

export '. button' '. icon' '. popup' '. close' '. note'


#---------------------------------------------------------------------------
#  listing


method p listing_text1 l
  arg_rw HtmlPage p ; arg Str l
  if { var Int i := l search "`" -1 ; i>=0 }
    var Int j := i+1
    while j<l:len and ( (l:j>="a" and l:j<="z") or  (l:j>="A" and l:j<="Z") or (l:j>="0" and l:j<="9") or l:j="_" )
      j += 1
    if j=i+1
      j := i+2
    p text (l 0 i) ; p italic (p text (l i+1 j-i-1)) ; p listing_text1 (l j l:len)
  else
    p text l

method p listing_text2 l
  arg_rw HtmlPage p ; arg Str l
  if { var Int i := l search "¤" -1 ; i>=0 }
    var Int j := i+1
    while j<l:len and ( (l:j>="a" and l:j<="z") or  (l:j>="A" and l:j<="Z") or (l:j>="0" and l:j<="9") or l:j="_" )
      j += 1
    if j=i+1
      j := i+2
    p listing_text1 (l 0 i) ; p bold (p text (l i+1 j-i-1)) ; p listing_text2 (l j l:len)
  else
    p listing_text1 l

method p listing list
  arg_rw HtmlPage p ; arg List:Str list
  p tag "listing" ""
  p do_not_use_Int := p:do_not_use_Int .or. 1
  var Pointer:Str l :> list first
  while exists:l
    if { var Int i := l option_position "#" -1 ; i<>-1 }
      p listing_text2 (l 0 i)
      p color lsh 0 75 200
        p italic
          p text (l i l:len)
    else
      p listing_text2 l
    p eol
    l :> list next l
  p do_not_use_Int := p:do_not_use_Int .and. .not. 1
  p tag "/listing" ""

multiline_keyword listing
export '. listing'