Patch title: Release 85 bulk changes
Abstract:
File: /pliant/protocol/http/filters.pli
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/stream.pli"
module "/pliant/language/compiler.pli"
module "/pliant/protocol/common/mime.pli"
module "/pliant/util/encoding/html.pli"
module "pli_filter.pli"


function null_filter src dest options
  arg_rw Stream src dest ; arg_rw Str options
  while not src:atend
    dest writeline src:readline


function c_filter src dest options
  arg_rw Stream src dest ; arg_rw Str options
  dest writeline "module [dq]/pliant/protocol/http/style/listing.style[dq] #"
  var CBool doc := false
  while not src:atend
    var Str line := src readline
    if doc
      if (line parse "*/")
        doc := false
      eif (line parse "doc")
        dest writeline "table columns 1 border 0"
        dest writeline "  [0]left_zero_is_at [dq]"+src:name+"[dq] "+(string src:line_number-1)+" 1[0]"
        dest writeline "  cell color lsh 90 10 60"
        dest writeline "  cell color (color hsl 60 10 80)"
      else
        dest writeline "  "+line
    eif (line parse "/*")
      line := src readline
      if line="doc" or line="abstract"
        dest writeline "table columns 1 border 0"
        dest writeline "  [0]left_zero_is_at [dq]"+src:name+"[dq] "+(string src:line_number-1)+" 1[0]"
        if line="doc"
          dest writeline "  cell color lsh 90 10 60"
          dest writeline "  cell color (color hsl 60 10 80)"
        else
          dest writeline "  cell color lsh 90 35 60"
          dest writeline "  cell color (color hsl 60 35 80)"
        doc := true
      else
        dest writeline "raw_line "+string:"/*"
        dest writeline "raw_line "+string:line
    eif line:len>10 and line="/"+(repeat line:len-2 "*")+"/"
      dest writeline "horizontal_line"
    eif (line eparse any:(var Str base) "///" offset:(var Int offset1) spaces:(var Str drop) offset:(var Int offset2) any:(var Str comment))
      if (comment parse word:"section" (var Str drop))
        dest writeline comment ; comment := ""
      dest writeline "raw_characters "+string:(line 0 offset1-3)
      if comment<>""
        dest writeline "[0]right_zero_is_at [dq]"+src:name+"[dq] "+(string src:line_number)+" "+string:offset2+"[0]"+comment
      dest writeline "eol"
    eif (line parse any:(var Str base) "//" any:(var Str comment))
      dest writeline "section "+(string "comment "+comment)
      dest writeline "raw_line "+string:line
    else
      dest writeline "raw_line "+string:line


function pli_filter src dest options
  arg_rw Stream src dest ; arg_rw Str options
  dest writeline "module [dq]/pliant/protocol/http/style/listing.style[dq] #"
  var CBool doc := false
  var Int l:=1
  while not src:atend
    var Str line := src readline
    if (line 0 2)<>"  "
      doc := false
    if doc
      dest writeline "  "+line
    eif line="doc" or line="abstract"
      dest writeline "table columns 1 border 0"
      dest writeline "  [0]left_zero_is_at [dq]"+src:name+"[dq] "+(string src:line_number-1)+" 1[0]"
      if line="doc"
        dest writeline "  cell color lsh 90 10 60"
        dest writeline "  cell color (color hsl 60 50 75)"
      else
        dest writeline "  cell color lsh 90 35 60"
        dest writeline "  cell color (color hsl 60 75 75)"
      doc := true
    eif line="#"+(repeat (max line:len-1 3) "-")
      dest writeline "horizontal_line"
    eif { var Int i := line option_position "##" -1 ; i<>-1 }
      var Str comment := line i+2 line:len
      if (comment parse word:"section" (var Str section))
        dest writeline "section "+string:section ; comment := ""
      dest writeline "raw_characters "+string:(line 0 i)
      if comment<>""
        dest writeline "[0]right_zero_is_at [dq]"+src:name+"[dq] "+(string src:line_number)+" "+(string i+2)+"[0]"+(line i+2 line:len)
      dest writeline "eol"
    else
      dest writeline "line_anchor "+string:l
      if { var Int i := line option_position "#" -1 ; i<>-1 }
        (line i+1 line:len) parse any:(var Str comment)
        dest writeline "section "+(string "comment "+comment)
        dest writeline "raw_characters "+string:(line 0 i)
        dest writeline "color lsh 0 75 200"
        dest writeline "font color (color hsl 200 75 35)"
        dest writeline "  italic"
        dest writeline "    raw_line "+string:(line i line:len)
      eif (line parse word:"module" _ (var Str mod)) or (line parse word:"submodule" _ (var Str mod))
        dest writeline "module_line "+string:line
      eif (line parse word:"function" "'" any:(var Str fun) "'" any)
        dest writeline "section "+(string "function '"+fun+"'")
        dest writeline "raw_line "+string:line
      eif (line parse word:"function" _ any:(var Str fun) _ any) or (line parse word:"function" any:(var Str fun))
        dest writeline "section "+(string "function "+fun)
        dest writeline "raw_line "+string:line
      eif (line parse word:"method" _ any _ "'" any:(var Str fun) "'" any)
        dest writeline "section "+(string "method '"+fun+"'")
        dest writeline "raw_line "+string:line
      eif (line parse word:"method" _ any _ any:(var Str fun) _ any) or (line parse word:"method" _ any _ any:(var Str fun))
        dest writeline "section "+(string "method "+fun)
        dest writeline "raw_line "+string:line
      eif (line parse word:"meta" "'" any:(var Str fun) "'" any)
        dest writeline "section "+(string "meta '"+fun+"'")
        dest writeline "raw_line "+string:line
      eif (line parse word:"meta" _ any:(var Str fun) _ any) or (line parse word:"meta" any:(var Str fun))
        dest writeline "section "+(string "meta "+fun)
        dest writeline "raw_line "+string:line
      eif (line parse word:"type" _ any:(var Str typ))
        dest writeline "section "+(string "type "+typ)
        dest writeline "raw_line "+string:line
      eif ( (line parse word:"plugin" _ any:(var Str plug) _ any:(var Str remain)) or { remain := "" ; line parse word:"plugin" _ any:(var Str plug) } ) and { var Int i := line option_position "plugin" -1 ; i<>-1 }
        dest writeline "section "+(string "plugin "+plug)
        dest writeline "raw_characters "+(string (line 0 i)+"plugin ")
        dest writeline "color lsh 0 65 120"
        dest writeline "font color (color hsl 200 75 35)"
        dest writeline "  bold"
        if remain<>""
          dest writeline "    raw_characters "+string:plug
          dest writeline "raw_line "+(string " "+remain)
        else
          dest writeline "    raw_line "+string:plug
      else
        dest writeline "raw_line"+string:line
    l += 1


declare_mime_dynamic_filter ".html" (the_function null_filter Stream Stream Str)
declare_mime_dynamic_filter ".pli" (the_function pli_filter Stream Stream Str)
declare_mime_dynamic_filter ".pliant" (the_function pli_filter Stream Stream Str)
declare_mime_dynamic_filter ".page" (the_function pli_filter Stream Stream Str)
declare_mime_dynamic_filter ".style" (the_function pli_filter Stream Stream Str)
declare_mime_dynamic_filter ".remote" (the_function pli_filter Stream Stream Str)
declare_mime_static_filter ".pli" (the_function my_pli_filter Stream Stream Str)
declare_mime_static_filter ".pliant" (the_function my_pli_filter Stream Stream Str)
declare_mime_dynamic_filter ".page" (the_function my_page_filter Stream Stream Str)
declare_mime_static_filter ".style" (the_function my_pli_filter Stream Stream Str)
declare_mime_static_filter ".remote" (the_function my_pli_filter Stream Stream Str)
declare_mime_dynamic_filter ".h" (the_function c_filter Stream Stream Str)
declare_mime_dynamic_filter ".c" (the_function c_filter Stream Stream Str)

declare_mime_type "html" "text/html"
declare_mime_type "ascii" "text/plain"
declare_mime_type "binary" "binary/*"
 
constant xlhtml "" # (shunt (file_query "embedded:/usr/bin/xlhtml" standard)=success "xlhtml" (file_query "embedded:/usr/bin/xlHtml" standard)=success "xlHtml" "")
# xlHtml has been removed because it tends to run forever
constant wvhtml "" # (shunt (file_query "embedded:/usr/bin/wvHtml" standard)=success "wvHtml" "")

if xlhtml<>""
  module "/pliant/language/unsafe.pli"
  module "/pliant/admin/file.pli"
  module "/pliant/admin/execute.pli"

  function xls_filter src dest options
    arg_rw Stream src dest ; arg_rw Str options
    var Str temp1 := replace file_temporary "file:/" "embedded:/"
    (var Stream s) open temp1 out+safe
    while not src:atend
      src read_available (var Address adr) (var Int size)
      s raw_write adr size
    s close
    var Str temp2 := replace file_temporary "file:/" "embedded:/"
    execute xlhtml+" "+file_os_name:(replace temp1 "embedded:/" "file:/") root "embedded:/" path "embedded:/" output temp2
    (var Stream s) open temp2 in+safe
    while not s:atend
      s read_available (var Address adr) (var Int size)
      dest raw_write adr size
    s close
    file_delete temp1
    file_delete temp2
    options += " mime [dq]text/html[dq]"
  declare_mime_static_filter ".xls" (the_function xls_filter Stream Stream Str)
  declare_mime_static_filter ".XLS" (the_function xls_filter Stream Stream Str)

if wvhtml<>""
  module "/pliant/language/unsafe.pli"
  module "/pliant/admin/file.pli"
  module "/pliant/admin/execute.pli"

  function doc_filter src dest options
    arg_rw Stream src dest ; arg_rw Str options
    var Str temp1 := replace file_temporary "file:/" "embedded:/"
    (var Stream s) open temp1 out+safe
    while not src:atend
      src read_available (var Address adr) (var Int size)
      s raw_write adr size
    s close
    var Str temp2 := (replace file_temporary "file:/" "embedded:/")+"/"
    file_tree_create temp2
    execute wvhtml+" --targetdir="+file_os_name:(replace temp2 "embedded:/" "file:/")+" "+file_os_name:(replace temp1 "embedded:/" "file:/")+" document.html" root "embedded:/" path "embedded:/"
    (var Stream s) open temp2+"document.html" in+safe
    while not s:atend
      s read_available (var Address adr) (var Int size)
      dest raw_write adr size
    s close
    file_delete temp1
    file_tree_delete temp2  
    options += " mime [dq]text/html[dq]"
  declare_mime_static_filter ".doc" (the_function doc_filter Stream Stream Str)
  declare_mime_static_filter ".DOC" (the_function doc_filter Stream Stream Str)

plugin filter