/pliant/protocol/http/style/default.style
 
 1  # Copyright  Hubert Tonneau  hubert.tonneau@pliant.cx 
 2  # 
 3  # This program is free software; you can redistribute it and/or 
 4  # modify it under the terms of the GNU General Public License version 2 
 5  # as published by the Free Software Foundation. 
 6  # 
 7  # This program is distributed in the hope that it will be useful, 
 8  # but WITHOUT ANY WARRANTY; without even the implied warranty of 
 9  # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the 
 10  # GNU General Public License for more details. 
 11  # 
 12  # You should have received a copy of the GNU General Public License 
 13  # version 2 along with this program; if not, write to the Free Software 
 14  # Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA  02111-1307, USA. 
 15   
 16  module "/pliant/language/compiler.pli" 
 17  module "/pliant/language/context.pli" 
 18  module "/pliant/language/stream.pli" 
 19  module "/pliant/language/parser.pli" 
 20  module "/pliant/language/parser/multiline.pli" 
 21  submodule "/pliant/language/type/text/language.pli" 
 22  module "/pliant/protocol/http/server.pli" 
 23  module "/pliant/admin/md5.pli" 
 24  module "common.pli" 
 25  submodule "common.style" 
 26  submodule "/pliant/graphic/color/rgb888.pli" 
 27   
 28  constant smart_input false 
 29  constant common_path "/common/"+string:pliant_release_number+"/" 
 30   
 31   
 32 
 
 33  #  new Pliant instructions 
 34   
 35   
 36  public 
 37   
 38    tag_prototype common 
 39      attr bgcolor ColorRGB888 (color rgb 255 255 255) 
 40      attr body Str 
 41      attr url_icon Str 
 42      attr has_html4 CBool true 
 43      attr head Str 
 44      attr css Str 
 45      attr header Str 
 46      attr footer Str 
 47      hidden 
 48   
 49    tag_prototype page_header 
 50      void 
 51    tag_prototype page_footer 
 52      void 
 53   
 54    tag_prototype link label href 
 55      attr label Str encode 
 56      attr href Str 
 57      attr section Str 
 58      attr options Str 
 59      attr relative 
 60      attr no_extension 
 61      attr help Str encode 
 62   
 63    tag_prototype section name 
 64      attr name Str encode 
 65   
 66    tag_prototype note label 
 67      attr label Str 
 68      attr help Str encode 
 69      subpage target 
 70   
 71    tag_prototype image src -> img 
 72      attr src Str 
 73   
 74    tag_prototype how target 
 75      attr target Str 
 76      attr section Str 
 77      attr options Str 
 78      attr relative 
 79      attr no_extension 
 80   
 81    tag_prototype title label 
 82      attr label Str encode 
 83      attr logo Str 
 84      attr link Str 
 85      attr small 
 86      sequence font 
 87        attr face Str 
 88        attr size Float 36 
 89        attr ssr Bool false # 'ssr' stands for 'server side rendering' 
 90      attr color ColorRGB888 (color rgb 0 0 0) 
 91      attr button Str 
 92      sequence bsize 
 93        attr bsize_x Float undefined 
 94        attr bsize_y Float undefined 
 95      sequence margin 
 96        attr margin_left Float undefined 
 97        attr margin_top Float undefined 
 98        attr margin_right Float undefined 
 99        attr margin_bottom Float undefined 
 100      attr round Int 0 
 101      attr bgcolor ColorRGB888 (color rgb 255 255 255)  
 102   
 103    tag_prototype chapter label 
 104      attr label Str encode 
 105   
 106    tag_prototype header label 
 107      attr label Str encode 
 108      attr level Int 0 
 109      body 
 110      sequence font 
 111        attr face Str 
 112        attr size Float 36 
 113        attr ssr Bool false 
 114      sequence factor 
 115        attr factor1 Float 4/5 
 116        attr factor2 Float 3/5 
 117        attr factor3 Float 2/5 
 118      attr color ColorRGB888 (color rgb 0 0 0) 
 119      attr tabulation Int 3 
 120      sequence shade 
 121        attr shade1 Float 0 
 122        attr shade2 Float 0 
 123        attr shade3 Float 0 
 124      attr button Str 
 125      sequence bsize 
 126        attr bsize_x Float undefined 
 127        attr bsize_y Float undefined 
 128      sequence margin 
 129        attr margin_left Float undefined 
 130        attr margin_top Float undefined 
 131        attr margin_right Float undefined 
 132        attr margin_bottom Float undefined 
 133      attr round Int 0 
 134      attr bgcolor ColorRGB888 (color rgb 255 255 255)  
 135      sequence bgshade 
 136        attr bgshade1 Float 0 
 137        attr bgshade2 Float 0 
 138        attr bgshade3 Float 0 
 139   
 140    method p header h 
 141      arg_rw HtmlPage p ; arg Str h 
 142      header h 
 143        void 
 144   
 145    tag_prototype para -> p 
 146      body 
 147      newline 
 148   
 149    tag_prototype eol -> br 
 150      newline 
 151   
 152    tag_prototype center 
 153      body 
 154   
 155    tag_prototype bold -> b 
 156      body 
 157   
 158    tag_prototype italic -> i 
 159      body 
 160   
 161    tag_prototype big 
 162      body 
 163   
 164    tag_prototype small 
 165      body 
 166   
 167    tag_prototype fixed 
 168      body 
 169      attr is_active CBool false 
 170   
 171    tag_prototype font 
 172      sequence font 
 173        attr face Str 
 174        attr size Float 12 
 175        attr ssr Bool false 
 176      attr color ColorRGB888 (color rgb 0 0 0) 
 177      attr linebreak CBool true 
 178      body 
 179   
 180    tag_prototype highlight label 
 181      attr label Str encode 
 182      attr size Str "-2" 
 183      attr color ColorRGB888 (color rgb 255 0 0) 
 184   
 185    tag_prototype list -> ul 
 186      body 
 187      newline 
 188   
 189    tag_prototype item -> li 
 190      body 
 191      newline 
 192   
 193    tag_prototype table 
 194      attr columns Int undefined 
 195      attr padding Int 4 -> cellpadding 
 196      attr spacing Int 0 -> cellspacing 
 197      attr border Int 1 
 198      body 
 199      newline 
 200      attr cursor Int undefined 
 201   
 202    tag_prototype row -> tr 
 203      body 
 204      newline 
 205   
 206    tag_prototype cell -> td 
 207      attr header 
 208      attr color ColorRGB888 -> bgcolor 
 209      body 
 210      newline 
 211      attr header_color ColorRGB888 (color rgb 208 208 208) 
 212      attr header_shade Float -0.1 
 213   
 214    tag_prototype box 
 215      attr header Str encode 
 216      attr color ColorRGB888 (color rgb 255 255 255) 
 217      attr transparent 
 218      attr button Str 
 219      sequence bsize 
 220        attr bsize_x Float undefined 
 221        attr bsize_y Float undefined 
 222      sequence margin 
 223        attr margin_left Float undefined 
 224        attr margin_top Float undefined 
 225        attr margin_right Float undefined 
 226        attr margin_bottom Float undefined 
 227      attr round Int 0 
 228      attr width Str 
 229      attr left 
 230      attr right 
 231      sequence hfont 
 232        attr hface Str 
 233        attr hsize Float 36 
 234        attr hssr Bool false 
 235      attr hcolor ColorRGB888 (color rgb 0 0 0) 
 236      body 
 237      newline 
 238   
 239    tag_prototype button label 
 240      attr label Str encode 
 241      attr noeol 
 242      subpage target 
 243      sequence font 
 244        attr face Str 
 245        attr size Float 
 246        attr ssr Bool false 
 247      attr tcolor ColorRGB888 (color rgb 0 0 0) 
 248      attr extend Float undefined 
 249      attr center CBool true 
 250      attr button Str 
 251      sequence bsize 
 252        attr bsize_x Float undefined 
 253        attr bsize_y Float undefined 
 254      sequence margin 
 255        attr margin_left Float undefined 
 256        attr margin_top Float undefined 
 257        attr margin_right Float undefined 
 258        attr margin_bottom Float undefined 
 259      attr bcolor ColorRGB888 
 260   
 261    tag_prototype icon src 
 262      attr src Str 
 263      attr help Str encode 
 264      subpage target 
 265      sequence isize 
 266        attr isize_x Float undefined 
 267        attr isize_y Float undefined 
 268      attr dull Float undefined 
 269      attr button Str 
 270      sequence bsize 
 271        attr bsize_x Float undefined 
 272        attr bsize_y Float undefined 
 273      sequence margin 
 274        attr margin_left Float undefined 
 275        attr margin_top Float undefined 
 276        attr margin_right Float undefined 
 277        attr margin_bottom Float undefined 
 278      attr bcolor ColorRGB888 
 279   
 280   
 281    tag_prototype input 
 282      attr label Str encode 
 283      attr type Str 
 284      attr name Str 
 285      attr value Str encode 
 286      attr length Int undefined -> size 
 287      attr database 
 288      attr is_read_only CBool false 
 289   
 290    tag_prototype textarea 
 291      attr label Str encode 
 292      attr name Str 
 293      attr value Str 
 294      attr columns Int -> cols 
 295      attr rows Int 
 296      attr database 
 297   
 298    tag_prototype select_begin 
 299      attr label Str encode 
 300      attr name Str 
 301      attr value Str encode 
 302      attr database 
 303      attr is_active CBool false 
 304      attr selected_label Str 
 305    tag_prototype select_end 
 306      attr database 
 307   
 308    tag_prototype option label value 
 309      attr label Str encode 
 310      attr value Str encode 
 311   
 312    tag_prototype pdata 
 313      attr label Str encode 
 314      attr path Str 
 315      attr value Str encode 
 316      attr length Int 
 317      attr columns Int 
 318      attr rows Int 
 319   
 320    tag_prototype listing 
 321      body 
 322   
 323   
 324 
 
 325  #  style setup 
 326   
 327   
 328  method p standard_html_hook text 
 329    arg_rw HtmlPage p ; arg Str text 
 330    p:http_stream writechars text 
 331   
 332  method p standard_text_hook text 
 333    arg_rw HtmlPage p ; arg Str text 
 334    if (attribute font ssr) 
 335      var Str extra := " font [dq]"+(attribute font face)+"[dq] "+string:(attribute font size)+" color [dq]"+string:(attribute font color)+"[dq] bgcolor [dq]"+string:(attribute common bgcolor)+"[dq]" 
 336      var Str sentence := html_decode text 
 337      if not (attribute font linebreak) 
 338        p:http_stream writechars "<img src=[dq]"+common_path+(http_encode "text "+string:sentence+extra)+"[dq] border=[dq]0[dq] align=[dq]middle[dq]>" 
 339      else 
 340        while sentence<>"" 
 341          if (sentence 0 1)<>" " 
 342            var Int := sentence search " " sentence:len 
 343            p:http_stream writechars "<img src=[dq]"+common_path+(http_encode "text "+string:(sentence i)+extra)+"[dq] border=[dq]0[dq] align=[dq]middle[dq]>" 
 344            sentence := sentence sentence:len 
 345          else 
 346            p:http_stream writechars " " 
 347            sentence := sentence sentence:len 
 348    eif (attribute fixed is_active) 
 349      p:http_stream writechars (replace text " " "&nbsp;") 
 350    else 
 351      p:http_stream writechars text 
 352   
 353  method page standard_begin_hook 
 354    arg_rw HtmlPage page 
 355    implicit page 
 356      write "<!DOCTYPE HTML PUBLIC [dq]-//W3C//DTD HTML 4.01 Transitional//EN[dq]>[lf]" 
 357      write "<html>[lf]" 
 358      write "<head>[lf]" 
 359      if (attribute common url_icon)<>"" 
 360        write "<link rel=[dq]icon[dq] type=[dq]image/png[dq] href=[dq]"+(attribute common url_icon)+"[dq]>[lf]" 
 361      write "<script src=[dq]"+common_path+"pliant.js[dq] language=[dq]JavaScript[dq] type=[dq]text/javascript[dq]></script>[lf]" 
 362      if (attribute common head)<>"" 
 363        write (attribute common head) ; write "[lf]" 
 364      if (attribute common css)<>"" 
 365        write "<style type=[dq]text/css[dq]>[lf]" 
 366        write (attribute common css) ; write "[lf]" 
 367        write "</style>[lf]" 
 368      write "</head>[lf]" 
 369      write "<body" 
 370      write " onLoad=[dq]refresh(false)[dq]" 
 371      var ColorRGB888 bg := attribute common bgcolor 
 372      if bg:r<>255 or bg:g<>255 or bg:b<>255 
 373        write " bgcolor=[dq]"+(string bg "html")+"[dq]" 
 374      if (attribute common body)<>"" 
 375        write " "+(attribute common body) 
 376      write ">[lf]" 
 377      # write "<!-- "+http_request:query_first_line+" -->[lf]" 
 378      var Str enctype := "" 
 379      if browser="konqueror" 
 380        enctype := " enctype [dq]multipart/form-data[dq]" 
 381      write "<form name=[dq]pliant[dq] method=[dq]POST[dq]"+enctype+" onSubmit=[dq]return complete(this)[dq]>[lf]" 
 382      write "<input type=[dq]hidden[dq] name=[dq]_pliant_x[dq] value=[dq][dq]>[lf]" 
 383      write "<input type=[dq]hidden[dq] name=[dq]_pliant_y[dq] value=[dq][dq]>[lf]" 
 384      write "<input type=[dq]hidden[dq] name=[dq]_[dq] value=[dq][dq]>[lf]" 
 385      var Pointer:ColorRGB888 fc :> attribute font color 
 386      if (attribute font face)<>"" or fc:r<>or fc:g<>or fc:b<>0 
 387        write "<font face=[dq]"+(attribute font face)+"[dq] color=[dq]"+(string fc "html")+"[dq]>" 
 388      if (attribute common header)<>"" 
 389        write (attribute common header) ; write "[lf]"   
 390      page_header 
 391   
 392  method page standard_end_hook 
 393    arg_rw HtmlPage page 
 394    implicit page 
 395      if not request:answer_header_sent or request:answer_footer_sent 
 396        return 
 397      page_footer 
 398      if (attribute common footer)<>"" 
 399        write (attribute common footer) ; write "[lf]"    
 400      var Pointer:ColorRGB888 fc :> attribute font color 
 401      if (attribute font face)<>"" or fc:r<>or fc:g<>or fc:b<>0 
 402        write "</font>[lf]" 
 403      write "</form>[lf]" 
 404      write "</body>[lf]" 
 405      write "</html>[lf]" 
 406   
 407  function full_url target has_section section has_options options relative no_extension -> url 
 408    arg Str target section options ; arg CBool has_section has_options relative no_extension ; arg Str url 
 409    url := http_encode target 
 410    var Str without_path := url (url search_last "/" -1)+url:len 
 411    if not no_extension and without_path:len<>and (without_path search "." -1)=(-1) and (without_path search ":" -1)=(-1) 
 412      url += ".html" 
 413    if has_section 
 414      url += "#"+http_encode:section 
 415    if has_options 
 416      url += "?"+http_encode:options 
 417    if relative 
 418      url := replace url ":" "%3A" 
 419   
 420  style_setup 
 421    text_hook :> the_function '. standard_text_hook' HtmlPage Str 
 422    begin_hook :> the_function '. standard_begin_hook' HtmlPage 
 423    end_hook :> the_function '. standard_end_hook' HtmlPage 
 424     
 425    push input is_read_only false 
 426    tag_attributes_setup 
 427   
 428    tag_html page_header 
 429      void 
 430    tag_html page_footer 
 431      void 
 432   
 433    tag_html link 
 434      write "<a href=[dq]"+(full_url href has:section section has:options (attribute link options) has:relative has:no_extension)+"[dq]" # using 'attribute link options' instead of simply 'options' is required in order not to get page:options 
 435      if help<>"" 
 436        write " title=[dq]"+help+"[dq]" 
 437      write_attributes 
 438      write ">" 
 439      write label 
 440      write "</a>" 
 441   
 442    tag_html section 
 443      write "<a name=[dq]"+name+"[dq]></a>" 
 444   
 445    tag_html note 
 446      write "<a href=[dq]"+request:encoded_path+"?"+target+"[dq]" 
 447      if help<>"" 
 448        write " title=[dq]"+help+"[dq]" 
 449      write ">"+label+"</a>[lf]" 
 450   
 451    tag_html image 
 452      write "<img src=[dq]"+src+"[dq]" 
 453      write_attributes 
 454      write ">" 
 455   
 456    tag_html how 
 457      write "<a href=[dq]"+(full_url target has:section section has:options (attribute how options) has:relative has:no_extension)+"[dq]>" 
 458      write "<img src=[dq]"+common_path+"icon/how.png[dq] border=[dq]0[dq]>" 
 459      write "</a>" 
 460   
 461    tag_html title 
 462      head "<title>"+label+"</title>[lf]" 
 463      if has:logo 
 464        write "<table width=[dq]100%[dq]><tr><td width=[dq]100%[dq]>" 
 465      if button<>"" or round>0 
 466        box button button bsize bsize_x bsize_y margin margin_left margin_top margin_right margin_bottom round round color bgcolor width "100%" 
 467          center 
 468            font font face size ssr color color linebreak false 
 469              text html_decode:label 
 470      else 
 471        if ssr 
 472          var Str url := "text "+(string html_decode:label)+" font [dq]"+face+"[dq] "+string:size+" color [dq]"+string:color+"[dq] bgcolor [dq]"+string:(attribute common bgcolor)+"[dq]" 
 473          write "<center><img src=[dq]"+common_path+http_encode:url+"[dq]></center>" 
 474        else 
 475          write "<h1><center>"+label+"</center></h1>" 
 476      if has:logo 
 477        write "</td><td>" 
 478        if has:link 
 479          write "<a href=[dq]"+link+"[dq]>" 
 480        write "<img src=[dq]"+logo+"[dq]"+(shunt has:link " border=[dq]0[dq]" "")+">" 
 481        if has:link 
 482          write "</a>" 
 483        write "</td></tr></table>" 
 484      write "<br>[lf]" 
 485   
 486    tag_html chapter 
 487      write "<br><br>[lf]" 
 488      if (attribute header button)<>"" or (attribute header round)>0 
 489        box button (attribute header button) bsize (attribute header bsize_x) (attribute header bsize_y) margin (attribute header margin_left) (attribute header margin_top) (attribute header margin_right) (attribute header margin_bottom) round (attribute header round) color (attribute header bgcolor) width "100%" 
 490          font font (attribute header face) (attribute header size) (attribute header ssr) color (attribute header color) linebreak false 
 491            if (attribute header ssr) 
 492              text (repeat (attribute header tabulation) " ")+html_decode:label 
 493            else 
 494              fixed text:(repeat (attribute header tabulation) " ") ; text html_decode:label 
 495      else 
 496        if (attribute header ssr) 
 497          var Str url := "text "+(string html_decode:label)+" font [dq]"+(attribute header face)+"[dq] "+string:(attribute title size)+" color [dq]"+string:(attribute header color)+"[dq] bgcolor [dq]"+string:(attribute common bgcolor)+"[dq]" 
 498          write "<p><img src=[dq]"+common_path+http_encode:url+"[dq]></p>[lf]" 
 499        else 
 500          write "<h1>"+label+"</h1>[lf]" 
 501   
 502    tag_html_open header 
 503      write "<br>[lf]" 
 504      push level level+1 
 505      var Float := shunt level=1 factor1 level=2 factor2 factor3 
 506      if button<>"" or round>0 
 507        box button button bsize bsize_x*bsize_y*margin margin_left*margin_top*margin_right*margin_bottom*round (cast round*Int) color (shade bgcolor (shunt level=1 bgshade1 level=2 bgshade2 bgshade3)) width "100%" 
 508          font font face size*ssr color (shade color (shunt level=1 shade1 level=2 shade2 shade3)) linebreak false 
 509            if ssr 
 510              text (repeat tabulation " ")+html_decode:label 
 511            else 
 512              fixed text:(repeat tabulation " ") ; text html_decode:label 
 513      else 
 514        if ssr 
 515          var Str url := "text "+(string html_decode:label)+" font [dq]"+face+"[dq] "+(string size*f)+" color [dq]"+string:color+"[dq] bgcolor [dq]"+string:(attribute common bgcolor)+"[dq]" 
 516          write "<p><img src=[dq]"+common_path+http_encode:url+"[dq]></p>[lf]" 
 517        else 
 518          write "<h"+(string level+1)+">"+label+"</h"+(string level+1)+">[lf]" 
 519    tag_html_close header 
 520      void 
 521   
 522    tag_html_open big 
 523      write "<font size=[dq]+1[dq]>" 
 524    tag_html_close big 
 525      write "</font>" 
 526   
 527    tag_html small 
 528      write "<font size=[dq]-1[dq]>" 
 529    tag_html_close small 
 530      write "</font>" 
 531   
 532    tag_html_open fixed 
 533      write "<tt>" 
 534      push is_active true 
 535    tag_html_close fixed 
 536      write "</tt>" 
 537   
 538    tag_html_open font 
 539      if (attribute common has_html4) 
 540        var Str st := "" 
 541        if has:face 
 542          st += "font-family: "+face+"; " 
 543        if has:size 
 544          st += "font-size: "+(string size "fixed 0")+"pt; " 
 545        if has:color 
 546          st += "color: "+(string color "html")+"; " 
 547        write "<span style=[dq]" 
 548        write (st 0 (max st:len-2 0)) 
 549        write "[dq]>" 
 550      else 
 551        write "<font" 
 552        if has:face 
 553          write " face=[dq]"+face+"[dq]" 
 554        if has:size 
 555          write " size=[dq]"+(string size "fixed 0")+"pt[dq]" 
 556        if has:color 
 557          write " color=[dq]"+(string color "html")+"[dq]" 
 558        write_attributes 
 559        write ">" 
 560      # if (attributes option "bold") 
 561      #   write "<b>" 
 562    tag_html_close font 
 563      # if (attributes option "bold") 
 564      #   write "</b>" 
 565      if (attribute common has_html4) 
 566        write "</span>" 
 567      else 
 568        write "</font>" 
 569   
 570    tag_html highlight 
 571      write "<tt> </tt>" 
 572      write "<font size=[dq]"+size+"[dq] color=[dq]"+(string color "html")+"[dq]><b>" 
 573      write label 
 574      write "</b></font>" 
 575   
 576    tag_html_open table 
 577      push cursor (shunt has:columns (cast 0 Int) undefined) 
 578      write "<table border=[dq]"+string:border+"[dq] cellpadding=[dq]"+string:padding+"[dq] cellspacing=[dq]"+string:spacing+"[dq]" 
 579      write_attributes 
 580      write ">[lf]" 
 581    tag_html_close table 
 582      write "</table>[lf]" 
 583   
 584    tag_html_open cell 
 585      if (attribute table cursor)<>undefined and (attribute table cursor)%(attribute table columns)=0 
 586        write "<tr>[lf]" 
 587      write "<td" 
 588      if has:color 
 589        write " bgcolor=[dq]"+(string color "html")+"[dq]" 
 590        push common bgcolor color 
 591      eif has:header 
 592        # write " bgcolor=[dq]"+(string header_color "html")+"[dq]" 
 593        write " bgcolor=[dq]"+(string (shade (attribute common bgcolor) header_shade) "html")+"[dq]" 
 594      write_attributes 
 595      write ">" 
 596      var Pointer:ColorRGB888 fc :> attribute font color 
 597      if (attribute font face)<>"" or fc:r<>or fc:g<>or fc:b<>0 
 598        write "<font face=[dq]"+(attribute font face)+"[dq] color=[dq]"+(string fc "html")+"[dq]>" 
 599    tag_html_close cell 
 600      var Pointer:ColorRGB888 fc :> attribute font color 
 601      if (attribute font face)<>"" or fc:r<>or fc:g<>or fc:b<>0 
 602        write "</font>" 
 603      write "</td>[lf]" 
 604      if (attribute table cursor)<>undefined 
 605        attribute table cursor += 1 
 606        if (attribute table cursor)%(attribute table columns)=0 
 607          write "</tr>[lf]" 
 608   
 609    tag_html_open box 
 610      var ColorRGB888 := color 
 611      var ColorRGB888 c2 := shade 0.5 
 612      if not has:header 
 613        c2 := c 
 614      var CBool colored := not has:transparent and (button<>"" or round>or (memory_different addressof:color ColorRGB888:size addressof:(attribute common bgcolor) ColorRGB888:size)) 
 615      write "<table cellspacing=[dq]0[dq] cellpadding=[dq]"+string:(shunt button<>"" or round>0 (cast 0 Int) (attribute table padding))+"[dq]" 
 616      if has:width 
 617        write " width=[dq]"+width+"[dq]" 
 618      if has:left 
 619        write " align=[dq]left[dq]" 
 620      if has:right 
 621        write " align=[dq]right[dq]" 
 622      # write_attributes 
 623      write "><tr>[lf]" 
 624      if button<>"" 
 625        var Str opt := " button [dq]"+button+"[dq]"+(shunt bsize_x=defined " bsize "+string:bsize_x+" "+string:bsize_y "")+(shunt margin_left=defined " margin "+string:margin_left+" "+string:margin_top+" "+string:margin_right+" "+string:margin_bottom "")+" color [dq]"+string:c+"[dq] bgcolor [dq]"+string:(attribute common bgcolor)+"[dq]" 
 626        write "<td><img src=[dq]"+common_path+"border%200"+http_encode:opt+"[dq]></td>[lf]" 
 627        write "<td background=[dq]"+common_path+"border%201"+http_encode:opt+"[dq]></td>[lf]" 
 628        write "<td><img src=[dq]"+common_path+"border%202"+http_encode:opt+"[dq]></td>[lf]" 
 629        write "</tr><tr>[lf]" 
 630        if has:header 
 631          write "<td background=[dq]"+common_path+"border%203"+http_encode:opt+"[dq]></td>[lf]" 
 632          write "<td bgcolor=[dq]#"+string:c+"[dq]><center>" 
 633          if hssr 
 634            var Str url := "text "+(string html_decode:header)+" font [dq]"+hface+"[dq] "+string:hsize+" color [dq]"+string:hcolor+"[dq] bgcolor [dq]"+string:c+"[dq]" 
 635            write "<img src=[dq]"+common_path+http_encode:url+"[dq]>" 
 636          else 
 637            write header 
 638          write "</center></td>[lf]" 
 639          write "<td background=[dq]"+common_path+"border%205"+http_encode:opt+"[dq]></td>[lf]" 
 640          write "</tr><tr>[lf]" 
 641          write "<td><img src=[dq]"+common_path+"border%203"+http_encode:opt+"[dq]></td>[lf]" 
 642          write "<td bgcolor=[dq]#"+string:c+"[dq]></td>[lf]" 
 643          write "<td><img src=[dq]"+common_path+"border%205"+http_encode:opt+"[dq]></td>[lf]" 
 644          write "</tr><tr>[lf]" 
 645          var Str opt := " button [dq]"+button+"[dq]"+(shunt bsize_x=defined " bsize "+string:bsize_x+" "+string:bsize_y "")+(shunt margin_left=defined " margin "+string:margin_left+" "+string:margin_top+" "+string:margin_right+" "+string:margin_bottom "")+" color [dq]"+string:c2+"[dq] bgcolor [dq]"+string:(attribute common bgcolor)+"[dq]" 
 646          write "<td><img src=[dq]"+common_path+"border%203"+http_encode:opt+"[dq]></td>[lf]" 
 647          write "<td bgcolor=[dq]#"+string:c2+"[dq]></td>[lf]" 
 648          write "<td><img src=[dq]"+common_path+"border%205"+http_encode:opt+"[dq]></td>[lf]" 
 649        write "</tr><tr>[lf]" 
 650        write "<td background=[dq]"+common_path+"border%203"+http_encode:opt+"[dq]></td>[lf]" 
 651      eif round>0 
 652        var Str opt := " size "+string:round+" "+string:round+" color [dq]"+string:c+"[dq] bgcolor [dq]"+string:(attribute common bgcolor)+"[dq]" 
 653        write "<td><img src=[dq]"+common_path+"corner%200"+http_encode:opt+"[dq]></td>[lf]" 
 654        write "<td bgcolor=[dq]#"+string:c+"[dq]></td>[lf]" 
 655        write "<td><img src=[dq]"+common_path+"corner%201"+http_encode:opt+"[dq]></td>[lf]" 
 656        write "</tr><tr>[lf]" 
 657        if has:header 
 658          write "<td bgcolor=[dq]#"+string:c+"[dq]></td>[lf]" 
 659          write "<td bgcolor=[dq]#"+string:c+"[dq]><center>" 
 660          if hssr 
 661            var Str url := "text "+(string html_decode:header)+" font [dq]"+hface+"[dq] "+string:hsize+" color [dq]"+string:hcolor+"[dq] bgcolor [dq]"+string:c+"[dq]" 
 662            write "<img src=[dq]"+common_path+http_encode:url+"[dq]>" 
 663          else 
 664            write header 
 665          write "</center></td>[lf]" 
 666          write "<td bgcolor=[dq]#"+string:c+"[dq]></td>[lf]" 
 667          write "</tr><tr>[lf]" 
 668          write "<td colspan=[dq]3[dq] height=[dq]"+string:round+"[dq] bgcolor=[dq]#"+string:c+"[dq]></td>[lf]" 
 669          write "</tr><tr>[lf]" 
 670          write "<td colspan=[dq]3[dq] height=[dq]"+string:round+"[dq] bgcolor=[dq]#"+string:c2+"[dq]></td>[lf]" 
 671          write "</tr><tr>[lf]" 
 672        write "<td bgcolor=[dq]#"+string:c2+"[dq]></td>[lf]" 
 673      else 
 674        if has:header 
 675          write "<td"+(shunt colored " bgcolor=[dq]#"+string:c+"[dq]" "")+"><center>" 
 676          if hssr 
 677            var Str url := "text "+(string html_decode:header)+" font [dq]"+hface+"[dq] "+string:hsize+" color [dq]"+string:hcolor+"[dq] bgcolor [dq]"+string:c+"[dq]" 
 678            write "<img src=[dq]"+common_path+http_encode:url+"[dq]>" 
 679          else 
 680            write header 
 681          write "</center></td>[lf]" 
 682          write "</tr><tr>[lf]" 
 683      write "<td width=[dq]100%[dq] height=[dq]100%[dq]" 
 684      if colored 
 685        write " bgcolor=[dq]#"+string:c2+"[dq]" 
 686      write ">" 
 687      tag_stack mark 
 688      if colored 
 689        push common bgcolor c2 
 690    tag_html_close box 
 691      tag_stack rewind 
 692      write "</td>[lf]" 
 693      var ColorRGB888 := color 
 694      var ColorRGB888 c2 := shade 0.5 
 695      if not has:header 
 696        c2 := c 
 697      if button<>"" 
 698        var Str opt := " button [dq]"+button+"[dq]"+(shunt bsize_x=defined " bsize "+string:bsize_x+" "+string:bsize_y "")+(shunt margin_left=defined " margin "+string:margin_left+" "+string:margin_top+" "+string:margin_right+" "+string:margin_bottom "")+" color [dq]"+string:c2+"[dq] bgcolor [dq]"+string:(attribute common bgcolor)+"[dq]" 
 699        write "<td background=[dq]"+common_path+"border%205"+http_encode:opt+"[dq]></td>[lf]" 
 700        write "</tr><tr>[lf]" 
 701        write "<td><img src=[dq]"+common_path+"border%206"+http_encode:opt+"[dq]></td>[lf]" 
 702        write "<td background=[dq]"+common_path+"border%207"+http_encode:opt+"[dq]></td>[lf]" 
 703        write "<td><img src=[dq]"+common_path+"border%208"+http_encode:opt+"[dq]></td>[lf]" 
 704      eif round>0 
 705        var Str opt := " size "+string:round+" color [dq]"+string:c2+"[dq] bgcolor [dq]"+string:(attribute common bgcolor)+"[dq]" 
 706        write "<td bgcolor=[dq]#"+string:c2+"[dq]></td>[lf]" 
 707        write "</tr><tr>[lf]" 
 708        write "<td><img src=[dq]"+common_path+"corner%202"+http_encode:opt+"[dq]></td>[lf]" 
 709        write "<td bgcolor=[dq]#"+string:c2+"[dq]></td>[lf]" 
 710        write "<td><img src=[dq]"+common_path+"corner%203"+http_encode:opt+"[dq]></td>[lf]" 
 711      write "</tr></table>[lf]" 
 712   
 713    tag_html input 
 714      write label 
 715      write "<input type=[dq]"+type+"[dq] name=[dq]"+name+"[dq] value=[dq]"+value+"[dq]" 
 716      if length=defined 
 717        write " size=[dq]"+string:length+"[dq]" 
 718      if has:database 
 719        write (shunt browser="konqueror" " onFocus=[dq]textin(this)[dq] onBlur=[dq]textout(this)[dq]" " onChange=[dq]change(this)[dq]") 
 720      write_attributes 
 721      if smart_input and (bgcolor:r<>255 or bgcolor:g<>255 or bgcolor:b<>255) 
 722        write " style=[dq]border: 0; background-color: #"+string:(shade bgcolor 0.25)+"[dq]" 
 723      write ">[lf]" 
 724   
 725    tag_html textarea 
 726      write label 
 727      write "<textarea name=[dq]"+name+"[dq] cols=[dq]"+string:columns+"[dq] rows=[dq]"+string:rows+"[dq] wrap=[dq]off[dq]" 
 728      if has:database 
 729        write (shunt browser="konqueror" " onFocus=[dq]textin(this)[dq] onBlur=[dq]textout(this)[dq]" " onChange=[dq]change(this)[dq]") 
 730      if smart_input and (bgcolor:r<>255 or bgcolor:g<>255 or bgcolor:b<>255) 
 731        write " style=[dq]border: 0; background-color: #"+string:(shade bgcolor 0.25)+"[dq]" 
 732      write_attributes 
 733      write ">" 
 734      write value 
 735      write "</textarea>[lf]" 
 736   
 737    tag_html select_begin 
 738      write label 
 739      write "<select name=[dq]"+name+"[dq]" 
 740      if has:database 
 741        write (shunt browser="konqueror" " onFocus=[dq]textin(this)[dq] onBlur=[dq]textout(this)[dq]" " onChange=[dq]change(this)[dq]") 
 742      if smart_input and (bgcolor:r<>255 or bgcolor:g<>255 or bgcolor:b<>255) 
 743        write " style=[dq]border-width: 0; background-color: #"+string:(shade bgcolor 0.25)+"[dq]" 
 744      write ">[lf]" 
 745    tag_html select_end 
 746      write "</select>[lf]" 
 747   
 748    tag_html option 
 749      if (attribute select_begin is_active) 
 750        write "<option" 
 751        if value=(attribute select_begin value) 
 752          write " selected" 
 753        write " value=[dq]"+value+"[dq]" 
 754        write ">" 
 755        write label 
 756        write "</option>[lf]" 
 757      else 
 758        if value=(attribute select_begin value) 
 759          attribute select_begin selected_label := label 
 760        
 761    tag_html pdata 
 762      if has:rows 
 763        write label+"[lf]" 
 764        write "<table><tr><td><pre>[lf]" 
 765      else 
 766        write label+"<tt>[lf]" 
 767      write "<pdata path=[dq]"+path+"[dq]>"+value+"</pdata>[lf]" 
 768      if has:rows 
 769        write "</pre></td></tr></table>[lf]" 
 770      else 
 771        write "</tt>[lf]" 
 772   
 773   
 774    tag_html button 
 775      if button="" 
 776        write "<input type=[dq]submit[dq] name=[dq]"+target+"[dq] value=[dq]"+label+"[dq]>[lf]" 
 777      else 
 778        var Str action := "[dq]button_pressed('"+target+"')[dq]" 
 779        var Str event := shunt browser="netscape" "onMouseUp" "onClick" 
 780        var Str url := common_path+"button"+(http_encode " [dq]"+html_decode:label+"[dq] font [dq]"+face+"[dq] "+string:size+(shunt extend=defined " extend "+string:extend "")+(shunt center " center" "")+" tcolor [dq]"+string:tcolor+"[dq] button [dq]"+button+"[dq]"+(shunt bsize_x=defined " bsize "+string:bsize_x+" "+string:bsize_y "")+(shunt margin_left=defined " margin "+string:margin_left+" "+string:margin_top+" "+string:margin_right+" "+string:margin_bottom "")+" bcolor [dq]"+string:bcolor+"[dq] bgcolor [dq]"+string:(attribute common bgcolor)+"[dq]") 
 781        write "<img src=[dq]"+url+"[dq] align=[dq]middle[dq] "+event+"="+action+">" 
 782      if not has:noeol 
 783        write "<br>[lf]" 
 784   
 785    tag_html icon 
 786      var Str action := "[dq]button_pressed('"+target+"')[dq]" 
 787      var Str event := shunt browser="netscape" "onMouseUp" "onClick" 
 788      var Str url := src 
 789      if button<>"" 
 790        url := common_path+"icon"+(http_encode " [dq]"+src+"[dq]"+(shunt isize_x=defined " isize "+string:isize_x+" "+string:isize_y "")+(shunt dull=defined " dull "+string:dull "")+" button [dq]"+button+"[dq]"+(shunt bsize_x=defined " bsize "+string:bsize_x+" "+string:bsize_y "")+(shunt margin_left=defined " margin "+string:margin_left+" "+string:margin_top+" "+string:margin_right+" "+string:margin_bottom "")+" bcolor [dq]"+string:bcolor+"[dq] bgcolor [dq]"+string:(attribute common bgcolor)+"[dq]") 
 791      write "<img src=[dq]"+url+"[dq] align=[dq]middle[dq] title=[dq]"+help+"[dq] "+event+"="+action+">" 
 792   
 793    tag_html_open listing 
 794      write "<p>[lf]<tt>[lf]" 
 795      push fixed is_active true 
 796    tag_html_close listing 
 797      write "</tt>[lf]</p>[lf]" 
 798   
 799   
 800 
 
 801  # input fields 
 802     
 803   
 804  method p set_read_only c 
 805    arg_rw HtmlPage p ; arg CBool c 
 806    if c 
 807      attribute input is_read_only := true 
 808   
 809  method p read_only_begin 
 810    arg_rw HtmlPage p 
 811    p:tag_stack mark 
 812    push input is_read_only true 
 813   
 814  method p read_only_begin c 
 815    arg_rw HtmlPage p ; arg CBool c 
 816    p:tag_stack mark 
 817    if c 
 818      push input is_read_only true 
 819   
 820  method p read_only_end 
 821    arg_rw HtmlPage p 
 822    p:tag_stack rewind 
 823   
 824  meta '. read_only' e 
 825    if e:size<or not (e:cast HtmlPage) 
 826      return 
 827    if e:(e:size-1):ident="{}" 
 828      if e:size=2 
 829        e:(e:size-1) compile ? 
 830        suckup e:0 
 831        add (instruction (the_function '. read_only_begin' HtmlPage) e:0:result) 
 832        suckup e:(e:size-1) 
 833        add (instruction (the_function '. read_only_end' HtmlPage) e:0:result) 
 834        set_void_result 
 835      eif e:size=and (e:cast CBool) 
 836        e:(e:size-1) compile ? 
 837        suckup e:0 
 838        suckup e:1 
 839        add (instruction (the_function '. read_only_begin' HtmlPage CBool) e:0:result e:1:result) 
 840        suckup e:(e:size-1) 
 841        add (instruction (the_function '. read_only_end' HtmlPage) e:0:result) 
 842        set_void_result 
 843    eif e:size=and (e:cast CBool) 
 844      suckup e:0 
 845      suckup e:1 
 846      add (instruction (the_function '. set_read_only' HtmlPage CBool) e:0:result e:1:result) 
 847      set_void_result 
 848   
 849  method p is_read_only -> c 
 850    arg_rw HtmlPage p ; arg CBool c 
 851    := attribute input is_read_only 
 852   
 853  export '. read_only' '. is_read_only' 
 854   
 855   
 856  constant to_index (the_function '. to string' Universal Str -> Str):generic_index 
 857   
 858  function to_string data options function -> string 
 859    arg Universal data ; arg Str options ; arg Function function ; arg Str string 
 860    indirect 
 861   
 862  method p html_input ident data fun label length flags 
 863    arg_rw HtmlPage p ; arg Str ident ; arg Universal data ; arg Function fun ; arg Str label ; arg Int length ; arg uInt flags 
 864    input label label type (shunt (flags .and. 2)="text" "password") name ident value (to_string data "raw" fun) length length 
 865    if (flags .and. 1)<>0 
 866      eol 
 867   
 868  if database 
 869   
 870    method p data_input d label length flags 
 871      arg_rw HtmlPage p ; arg Data_ d ; arg Str label ; arg Int length ; arg uInt flags 
 872      if (d:interface get addressof:(var Str value) Str)=failure 
 873        value := "" 
 874      if (attribute input is_read_only) 
 875        pdata label label path d:path value value 
 876      else 
 877        var Str dpath := replace (replace d:path "&#" "("";" ")" 
 878        input label label type (shunt (flags .and. 2)="text" "password") name "/"+(p:request generate_signature d:path)+dpath value value length length database 
 879      if (flags .and. 1)<>0 
 880        eol 
 881   
 882  meta '. input' e 
 883    if e:size<or not (e:cast HtmlPage) or not (e:cast Str) 
 884      return 
 885    e:2:compile ? 
 886    var CBool data := database and e:2:is_data 
 887    if not data 
 888      var Str name := shunt e:2:size=e:2:ident e:2:(e:2:size-1):ident 
 889      if name="" 
 890        return 
 891      var Link:Type type :> e:2:result:type:real_data_type 
 892      if not (e:cast type) 
 893        return 
 894      var Pointer:Function function :> type get_generic_method to_index 
 895      if addressof:function=null or addressof:function=addressof:(the_function '. to string' Universal Str -> Str) 
 896        return 
 897      notify_editable_variable e:2     
 898    var uInt flags := 1 
 899    var Link:Argument length :> argument constant Int undefined 
 900    var Int := 3 
 901    while i<e:size 
 902      if e:i:ident="noeol" 
 903        flags := flags .and. .not. 1 
 904        += 1 
 905      eif e:i:ident="password" 
 906        flags := flags .or. 2 
 907        += 1 
 908      eif e:i:ident="length" and i+1<e:size and (e:(i+1) cast Int) 
 909        suckup e:(i+1) 
 910        length :> e:(i+1) result 
 911        += 2 
 912      else 
 913        return 
 914    suckup e:0 ; suckup e:1 ; suckup e:2 
 915    if database and data 
 916      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)) 
 917    else 
 918      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)) 
 919    set_void_result 
 920   
 921   
 922  method p html_text_input label ident value nx ny 
 923    arg_rw HtmlPage p ; arg Str label ident value ; arg Int nx ny 
 924    textarea label label name ident columns nx rows ny value value 
 925   
 926  if database 
 927   
 928    method p data_text_input label d nx ny 
 929      arg_rw HtmlPage p ; arg Str label ; arg Data_ d ; arg Int nx ny 
 930      if (d:interface get addressof:(var Str value) Str)=failure 
 931        value := "" 
 932      if (attribute input is_read_only) 
 933        pdata label label path d:path value value columns nx rows ny 
 934      else 
 935        var Str dpath := replace (replace d:path "&#" "("";" ")" 
 936        textarea label label name "/"+(p:request generate_signature d:path)+dpath value value columns nx rows ny database 
 937   
 938  meta '. text_input' e 
 939    if e:size<or not (e:cast HtmlPage) or not (e:cast Str) 
 940      return 
 941    e:2:compile ? 
 942    var CBool data := database and e:2:is_data 
 943    if not data 
 944      var Str name := shunt e:2:size=e:2:ident e:2:(e:2:size-1):ident 
 945      if name="" 
 946        return 
 947      if not (e:cast Str) 
 948        return 
 949      notify_editable_variable e:2 
 950    var Bool eol := true 
 951    var Link:Argument cols :> argument constant Int undefined 
 952    var Link:Argument rows :> argument constant Int undefined 
 953    var Int := 3 
 954    while i<e:size 
 955      if e:i:ident="noeol" 
 956        eol := false 
 957        += 1 
 958      eif e:i:ident="columns" and i+1<e:size and (e:(i+1) cast Int) 
 959        suckup e:(i+1) 
 960        cols :> e:(i+1) result 
 961        += 2 
 962      eif e:i:ident="rows" and i+1<e:size and (e:(i+1) cast Int) 
 963        suckup e:(i+1) 
 964        rows :> e:(i+1) result 
 965        += 2 
 966      else 
 967        return 
 968    suckup e:0 ; suckup e:1 ; suckup e:2 
 969    if database and data 
 970      add (instruction (the_function '. data_text_input' HtmlPage Str Data_ Int Int) e:0:result e:1:result e:2:result cols rows) 
 971    else 
 972      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) 
 973    if eol 
 974      add (instruction (the_function '. text' HtmlPage Str) e:0:result (argument constant Str "[lf]")) 
 975    set_void_result 
 976   
 977   
 978  method p html_select_begin label ident data fun 
 979    arg_rw HtmlPage p ; arg Str label ; arg Str ident ; arg Universal data ; arg Function fun 
 980    p:tag_stack mark 
 981    push select_begin value html_encode:(to_string data "raw" fun) 
 982    push select_begin is_active true 
 983    select_begin label label name ident 
 984   
 985  method p html_select_end 
 986    arg_rw HtmlPage p 
 987    select_end 
 988    p:tag_stack rewind 
 989    
 990  if database 
 991   
 992    method p data_select_begin label d 
 993      arg_rw HtmlPage p ; arg Str label ; arg Data_ d 
 994      if (d:interface get addressof:(var Str value) Str)=failure 
 995        value := "" 
 996      p:tag_stack mark 
 997      push select_begin value html_encode:value 
 998      if (attribute input is_read_only) 
 999        push select_begin is_active false 
 1000        push select_begin label html_encode:label 
 1001        push pdata path d:path 
 1002        push select_begin selected_label "" 
 1003      else 
 1004        push select_begin is_active true 
 1005        var Str dpath := replace (replace d:path "&#" "("";" ")" 
 1006        select_begin label label name "/"+(p:request generate_signature d:path)+dpath value value database 
 1007     
 1008    method p data_select_end 
 1009      arg_rw HtmlPage p 
 1010      if (attribute input is_read_only) 
 1011        pdata label html_decode:(attribute select_begin label) path (attribute pdata path) value html_decode:(attribute select_begin selected_label) 
 1012      else 
 1013        select_end database 
 1014      p:tag_stack rewind 
 1015      
 1016  meta '. select' e 
 1017    if e:size<or not (e:cast HtmlPage) or not (e:cast Str) 
 1018      return 
 1019    e:2:compile ? 
 1020    var CBool data := database and e:2:is_data 
 1021    if not data 
 1022      var Str name := shunt e:2:size=e:2:ident e:2:(e:2:size-1):ident 
 1023      if name="" 
 1024        return 
 1025      var Link:Type type :> e:2:result:type:real_data_type 
 1026      if not (e:cast type) 
 1027        return 
 1028      var Pointer:Function function :> type get_generic_method to_index 
 1029      if addressof:function=null or addressof:function=addressof:(the_function '. to string' Universal Str -> Str) 
 1030        return 
 1031      notify_editable_variable e:2 
 1032    var Bool eol := true 
 1033    var Int := 3 
 1034    while i<e:size-1 
 1035      if e:i:ident="noeol" 
 1036        eol := false 
 1037        += 1 
 1038      else 
 1039        return 
 1040    (e:size-1) compile ? 
 1041    suckup e:0 ; suckup e:1 ; suckup e:2 
 1042    if database and data 
 1043      add (instruction (the_function '. data_select_begin' HtmlPage Str Data_) e:0:result e:1:result e:2:result) 
 1044    else 
 1045      add (instruction (the_function '. html_select_begin' HtmlPage Str Str Universal Function) e:0:result e:1:result (argument constant Str name) e:2:result (argument mapped_constant Function function)) 
 1046    suckup (e:size-1) 
 1047    if database and data 
 1048      add (instruction (the_function '. data_select_end' HtmlPage) e:0:result) 
 1049    else 
 1050      add (instruction (the_function '. html_select_end' HtmlPage) e:0:result) 
 1051    if eol 
 1052      add (instruction (the_function '. text' HtmlPage Str) e:0:result (argument constant Str "[lf]")) 
 1053    set_void_result 
 1054   
 1055   
 1056  method p html_file_upload label ident 
 1057    arg_rw HtmlPage p ; arg Str label ident 
 1058    input label label type "file" name "file upload "+ident 
 1059   
 1060  meta '. file_upload' e 
 1061    if e:size<or not (e:cast HtmlPage) or not (e:cast Str) or not (e:cast Str) 
 1062      return 
 1063    var Str name := shunt e:2:size=e:2:ident e:2:(e:2:size-1):ident 
 1064    if name="" 
 1065      return 
 1066    var Bool eol := true 
 1067    var Int := 3 
 1068    while i<e:size 
 1069      if e:i:ident="noeol" 
 1070        eol := false 
 1071        += 1 
 1072      else 
 1073        return 
 1074    suckup e:0 ; suckup e:1 ; suckup e:2 
 1075    add (instruction (the_function '. html_file_upload' HtmlPage Str Str) e:0:result e:1:result (argument constant Str name)) 
 1076    if eol 
 1077      add (instruction (the_function '. text' HtmlPage Str) e:0:result (argument constant Str "[lf]")) 
 1078    set_void_result 
 1079    notify_editable_variable e:2 
 1080   
 1081  export '. input' '. text_input' '. select' '. option' '. file_upload' 
 1082   
 1083   
 1084 
 
 1085  #  listing 
 1086   
 1087   
 1088  method p listing_text1 l 
 1089    arg_rw HtmlPage p ; arg Str l 
 1090    if { var Int := search "`" -1 ; i>=0 } 
 1091      var Int := i+1 
 1092      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="_" ) 
 1093        += 1 
 1094      if j=i+1 
 1095        := i+2 
 1096      text (i) ; italic (text (i+j-i-1)) ; listing_text1 (l:len) 
 1097    else 
 1098      text l 
 1099   
 1100  method p listing_text2 l 
 1101    arg_rw HtmlPage p ; arg Str l 
 1102    if { var Int := search "¤" -1 ; i>=0 } 
 1103      var Int := i+1 
 1104      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="_" ) 
 1105        += 1 
 1106      if j=i+1 
 1107        := i+2 
 1108      listing_text1 (i) ; bold (text (i+j-i-1)) ; listing_text2 (l:len) 
 1109    else 
 1110      listing_text1 l 
 1111   
 1112  method p listing list 
 1113    arg_rw HtmlPage p ; arg List:Str list 
 1114    strong_definition 
 1115    listing 
 1116      var Pointer:Str :> list first 
 1117      while exists:l 
 1118        if { var Int := option_position "#" -1 ; i<>-1 } 
 1119          listing_text2 (i) 
 1120          font color (color hsl 200 75 50) 
 1121            italic 
 1122              text (l:len) 
 1123        else 
 1124          listing_text2 l 
 1125        eol 
 1126        :> list next l 
 1127   
 1128  multiline_keyword listing 
 1129  export '. listing' 
 1130   
 1131   
 1132   
 1133   
 1134   
 1135   
 1136   
 1137   
 1138   
 1139