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

module "/pliant/language/stream.pli"
module "/pliant/language/stream/filesystembase.pli"
module "/pliant/language/compiler.pli"
module "/pliant/language/parser.pli"
module "/pliant/admin/file.pli"
module "/pliant/protocol/http/server.pli"
# Copyright  Hubert Tonneau  hubert.tonneau@pliant.cx
#
# This program is free software; you can redistribute it and
# modify it under the terms of the GNU General Public Licens
# as published by the Free Software Foundation.
#
# This program is distributed in the hope that it will be us
# but WITHOUT ANY WARRANTY; without even the implied warrant
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See 
# GNU General Public License for more details.
#
# You should have received a copy of the GNU General Public 
# version 2 along with this program; if not, write to the Fr
# Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 

module "/pliant/language/stream.pli"
module "/pliant/language/stream/filesystembase.pli"
module "/pliant/language/compiler.pli"
module "/pliant/language/parser.pli"
module "/pliant/admin/file.pli"
module "/pliant/protocol/http/server.pli"
module "common.pli"
module "/pliant/protocol/common/mime.pli"
module "/pliant/protocol/common/mime.pli"
module "common.pli"


#-----------------------------------------------------------


#-----------------------------------------------------------
#  page status
#  basic




method p read_only_begin m
  arg_rw HtmlPage p ; arg_w CBool m
  m := p read_only_mode
  p read_only_mode := true

method p read_only_begin c m
  arg_rw HtmlPage p ; arg CBool c ; arg_w CBool m
  m := p read_only_mode
  p read_only_mode := c

method p read_only_end m
  arg_rw HtmlPage p ; arg CBool m
  p read_only_mode := m

meta '. read_only' e
  if e:size<1 or not (e:0 cast HtmlPage)
    return
  if e:size=2
    void
  eif e:size=3
    if not (e:1 cast CBool)
method p head s
  arg_rw HtmlPage p ; arg Str s
  var Pointer:Stream stream :> p http_stream
  var Address start := stream stream_write_buf
  var Address cur := stream stream_write_cur
  var Address stop := stream stream_write_stop
  if (cast stop Int).-.(cast cur Int)>=s:len
    var Address a := memory_search start (cast cur Int).-.(cast start Int) "</head>":characters 7
    if a<>null
      memory_move a (a translate Byte s:len) (cast cur Int).-.(cast a Int)
      memory_copy s:characters a s:len
      stream stream_write_cur := cur translate Byte s:len
      return
      return
  else
    return
  e:(e:size-1) compile ?
  var Link:Argument a :> argument local CBool
  e suckup e:0
  if e:size=2
    e add (instruction (the_function '. read_only_begin' Htm
  else
    check e:size=3
    e suckup e:1
    e add (instruction (the_function '. read_only_begin' Htm
  e suckup e:(e:size-1)
  e add (instruction (the_function '. read_only_end' HtmlPag
  e set_void_result
  stream writechars "[dq]"
  stream writechars s



export '. read_only'

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


method p flush
  arg_rw HtmlPage p
  p:http_stream flush anytime

method p flush
  arg_rw HtmlPage p
  p:http_stream flush anytime


function 'cast Status' p -> s
  arg HtmlPage p ; arg Status s
  s := cast p:http_stream Status


function 'cast Status' p -> s
  arg HtmlPage p ; arg Status s
  s := cast p:http_stream Status


method p virtual_command -> c
  arg HtmlPage p ; arg_C Str c
  c :> p:http_request command


method p lang -> l
  arg HtmlPage p ; arg_C Str l
  l :> p:http_request lang


method p lang -> l
  arg HtmlPage p ; arg_C Str l
  l :> p:http_request lang


export '. flush' 'cast Status' '. lang'
export '. head' '. flush' 'cast Status' '. virtual_command' '. lang'



method page goto_hyperlink target autoext section options
  arg_rw HtmlPage page ; arg Str target ; arg CBool autoext 
  var Str without_path := target (target search_last "/" -1)
  var Str t := target
  if autoext and without_path:len<>0 and (without_path searc
    t += ".html"
  if section<>""
    t += "#"+http_encode:section
  if options<>""
    t += "?"+http_encode:options



method page goto_hyperlink target autoext section options
  arg_rw HtmlPage page ; arg Str target ; arg CBool autoext 
  var Str without_path := target (target search_last "/" -1)
  var Str t := target
  if autoext and without_path:len<>0 and (without_path searc
    t += ".html"
  if section<>""
    t += "#"+http_encode:section
  if options<>""
    t += "?"+http_encode:options
  if (page:env first "default dynamic")=null
    page:http_request answer_is_dynamic := true
  page:http_request answer_is_dynamic := true
  page html "<script language=[dq]JavaScript[dq]>[lf]"
  page html "  location.replace([dq]"+t+"[dq])[lf]"
  page html "</script>[lf]"
  page html "Your browser is not very smart. You should sele
  
meta '. goto_url' e
  if e:size<2 or not (e:0 cast HtmlPage) or not (e:1 cast St
    return
  e suckup e:0 ; e suckup e:1
  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 := 2
  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
      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
      e suckup e:(i+1)
      options :> e:(i+1):result
      i += 2
    else
      return
  e add (instruction (the_function '. goto_hyperlink' HtmlPa
  e set_void_result


method page goto_backward n
  arg_rw HtmlPage page ; arg Int n
  page html "<script language=[dq]JavaScript[dq]>[lf]"
  page html "  location.replace([dq]"+t+"[dq])[lf]"
  page html "</script>[lf]"
  page html "Your browser is not very smart. You should sele
  
meta '. goto_url' e
  if e:size<2 or not (e:0 cast HtmlPage) or not (e:1 cast St
    return
  e suckup e:0 ; e suckup e:1
  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 := 2
  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
      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
      e suckup e:(i+1)
      options :> e:(i+1):result
      i += 2
    else
      return
  e add (instruction (the_function '. goto_hyperlink' HtmlPa
  e set_void_result


method page goto_backward n
  arg_rw HtmlPage page ; arg Int n
  if (page:env first "default dynamic")=null
    page:http_request answer_is_dynamic := true
  page:http_request answer_is_dynamic := true
  page html "<script language=[dq]JavaScript[dq]>[lf]"
  var Int x := undefined ; var Int y := undefined
  part search
    if n=0
      if ("&"+page:http_request:form+"&" eparse any "&_plian
        leave search
      eif (page:http_request:url_options parse "button+" (va
        leave search
    eif n=1
      var Pointer:Arrow c :> page:http_request:query_log fir
      while c<>null
        if ((c map Str) parse acword:"referer" ":" any "?but
          leave search
        c :> page:http_request:query_log next c
  if x=defined and y=defined
    var Str spos := (character 65+x\17576)+(character 65+x\6
    page html "    window.name = '_xy_"+spos+"_'+window.name
  if page:http_request:browser_model="netscape"
    page html "  history.go(-"+(string n+1)+")[lf]"
  eif false # page:http_request:browser_model="ie" and page:
    page html "  window.name = '_reload_'+window.name[lf]"
    page html "  history.go(-"+(string n+1)+")[lf]"
  else # Mozilla 0.9.8, IE 6, Opera 6 and Konqueror
    page html "  window.name = '_back_"+(character 65+n)+"__
  page html "</script>[lf]"
  page html "<p>Now computing ...</p><p><font size=[dq]-1[dq
  page html "<script language=[dq]JavaScript[dq]>[lf]"
  var Int x := undefined ; var Int y := undefined
  part search
    if n=0
      if ("&"+page:http_request:form+"&" eparse any "&_plian
        leave search
      eif (page:http_request:url_options parse "button+" (va
        leave search
    eif n=1
      var Pointer:Arrow c :> page:http_request:query_log fir
      while c<>null
        if ((c map Str) parse acword:"referer" ":" any "?but
          leave search
        c :> page:http_request:query_log next c
  if x=defined and y=defined
    var Str spos := (character 65+x\17576)+(character 65+x\6
    page html "    window.name = '_xy_"+spos+"_'+window.name
  if page:http_request:browser_model="netscape"
    page html "  history.go(-"+(string n+1)+")[lf]"
  eif false # page:http_request:browser_model="ie" and page:
    page html "  window.name = '_reload_'+window.name[lf]"
    page html "  history.go(-"+(string n+1)+")[lf]"
  else # Mozilla 0.9.8, IE 6, Opera 6 and Konqueror
    page html "  window.name = '_back_"+(character 65+n)+"__
  page html "</script>[lf]"
  page html "<p>Now computing ...</p><p><font size=[dq]-1[dq
  page:env insert "default backward" true entry_new:Void





export '. goto_url' '. reload_page' '. goto_backward'





export '. goto_url' '. reload_page' '. goto_backward'