Patch title: Release 86 bulk changes
Abstract:
File: /pliant/appli/type_browser.pli
Key:
    Removed line
    Added line
# Copyright  Patrice Ossona de Mendez
#
# 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/os.pli"
module "/pliant/language/compiler.pli"
module "type_browser/page.pli"
module "/pliant/protocol/http/server.pli"
module "/pliant/protocol/http/style/default.style"

public

method page show_castto t
  arg_rw HtmlPage page; arg Type t
  var Link:(Index Str Arrow) fl :> t find_castto
  var Pointer:Function f
  var Pointer:PairFunctionModule p
  implicit page
    table columns 2
      each c fl
        p :> c map PairFunctionModule 
        f :> p f
        cell
          var Str mn :=  (fl key c)+" -> "+t:name
          var Str source := f:position 0 (f:position search " " f:position:len)
          if source<>""
            var Str fn := f:name
            if (fn search " " -1)>=0
              fn := "'"+fn+"'"
            link mn source section "function "+fn
          else
            bold
              text mn
            if (addressof p:m)<>null
              eol
              small
                [(]
                show_module p:m
                [)]
          if f:name<>"cast "+t:name
            eol
            [(alias of ];text f:name;[)]
        cell
          var Bool some := false
          if (f:flags .and. function_flag_implicit)<>0
            [implicit]; some:=true
          if (f:flags .and. function_flag_extension)<>0
            if some
              [, ]
            else
              some:=true
            [extension]
          if (f:flags .and. function_flag_reduction)<>0
            if some
              [, ]
            else
              some:=true
            [reduction]
          if not some
            fixed:[ ]
       
method page show_castfrom t
  arg_rw HtmlPage page; arg Type t
  var Link:(Index Str Arrow) fl :> t find_castfrom
  var Pointer:Function f
  var Pointer:PairFunctionModule p
  implicit page
    table columns 2
      each c fl
        p :> c map PairFunctionModule 
        f :> p f
        cell
          var Str mn :=  t:name+" -> "+(fl key c)
          var Str source := f:position 0 (f:position search " " f:position:len)
          if source<>""
            var Str fn := f:name
            if (fn search " " -1)>=0
              fn := "'"+fn+"'"
            link mn source section "function "+fn
          else
            bold
              text mn
            if (addressof p:m)<>null
              eol
              small
                [(]
                show_module p:m
                [)]
          if f:name<>"cast "+(fl key c)
            eol
            [(alias of ];text f:name;[)]
        cell
          var Bool some := false
          if (f:flags .and. function_flag_implicit)<>0
            [implicit]; some:=true
          if (f:flags .and. function_flag_extension)<>0
            if some
              [, ]
            else
              some:=true
            [extension]
          if (f:flags .and. function_flag_reduction)<>0
            if some
              [, ]
            else
              some:=true
            [reduction]
          if not some
            fixed:[ ]
       

method page show_methods t
  arg_rw HtmlPage page; arg Type t
  var Link:(Index Str Arrow) fl :> t find_methods
  var Pointer:FunctionPrototype fp
  var Int maxa := 0
  var Bool res := false
  var Pointer:Function f
  var Pointer:PairFunctionModule p
  each c fl
    p :> c map PairFunctionModule 
    f :> p f 
    if f:nb_args>maxa
      maxa := f:nb_args
    if not:res and f:nb_args<>f:nb_args_with_result
      res:=true
  var Pointer:Function f
  var Int maxc := (shunt res 3 4)+maxa
  implicit page
    center
      table columns maxc border 1
        html "<tr><td rowspan=2></td><td colspan="+string:maxc+"></td><td rowspan=2></td></tr>"
        html "<tr><td>"
        center
          [Method name]
        html "</td>"
        html "<td colspan="+string:(maxa+1)+">"
        center
          [Arguments]
        html "</td>"
        if res
          html "<td>"
          center
            [Result]
          html "</td>"
        html "</tr>"
        each c fl
          html "<tr><td rowspan=4></td><td colspan="+string:maxc+"></td><td rowspan=4></td></tr>"
          p :> c map PairFunctionModule 
          f :> p f 
          html "<tr><td rowspan=3>"
          var Str mn := fl key c
          if mn<>f:name
            mn+= " (alias of "+f:name+")"
          var Str source := f:position 0 (f:position search " " f:position:len)
          if source<>""
            link (mn 2 mn:len) source section "method "+(f:name 2 f:name:len)
            if (f:flags .and. function_flag_generic <> 0)
              italic:[ (generic)]  
          else
            bold
              text (mn 2 mn:len)
            if (f:flags .and. function_flag_generic <> 0)
              italic:[ (generic)]  
            if (addressof p:m)<>null
              eol
              small
                [(]
                show_module p:m
                [)]
          html "</td>"
          html "<td>"
          center
            italic:[Name]
          html "</td>"
          for (var Int i) 0 f:nb_args-1
            fp :> f arg i
            html "<td>"
            center
              fixed 
                text (shunt fp:name="" " " fp:name)
            html "</td>"
          if f:nb_args <> maxa
            html "<td colspan="+string:(maxa-f:nb_args)+" rowspan=3>"
            fixed:[ ]
            html "</td>"
          if res
            if f:nb_args_with_result<>f:nb_args
              html "<td>"
              fixed:[ ]
              html "</td>"
            else
              html "<td rowspan=3>"
              fixed:[ ]
              html "</td>"
          html "</tr>"
          html "<tr>"
          html "<td>"
          center
            italic:[Type]
          html "</td>"
          for (var Int i) 0 f:nb_args_with_result-1
            fp :> f arg i
            html "<td>"
            center
              text fp:type:name
            html "</td>"
          html "</tr><tr>"
          html "<td>"
          center
            italic:[Access]
          html "</td>"
          for (var Int i) 0 f:nb_args_with_result-1
            fp :> f arg i
            html "<td>"
            center
              fixed
                text access_to_string:(fp access)
            html "</td>"
          html "</tr>"
        html "<tr><td colspan="+string:(maxc+2)+"></td></tr>"

function compute_tindex -> newd
  arg Link:(Index Str Address) newd
  newd :> new (Index Str Address)
  each t pliant_general_dictionary type Type
    if t:name:0<>"("
      newd insert t:name addressof:t
  
method page listtypes
  arg_rw HtmlPage page
  var Link:(Index Str Address) newd :> compute_tindex
  var Int x:=0
  implicit page
    table columns 2 border 0
      var Pointer:Address c :> newd first
      while addressof:c<>null
        var Pointer:Type t :> c map Type
        var Str source := t:position 0 (t:position search " " t:position:len)
        cell
         link t:name t:name no_extension
        cell
         if source<>""
           text "  (defined in "
           link source source section "type "+t:name
           text ")"
         else
           fixed:[ ]
        c :> newd next c

method page type_browser tname
  arg_rw HtmlPage page; arg Str tname
  implicit page
    if tname=""
      title "Type Browser"
      para
        [You may access directly a type using the following form, or scroll on the huge list bellow.]
        eol
        [To enter complex data types, please use parenthesized form, like ];fixed:[(Array Int)];[.]
        eol
        var Link:(Index Str Address) td :> compute_tindex 
        var Str ttt:=""
        table columns 3 border 0
          cell
            [Choose a type in the list]
          cell
            select "" (var Str tt) noeol
              var Pointer:Address v :> td first
              while addressof:v<>null
                option (td key v) (td key v)
                v :> td next v
          cell
            fixed:[  ]
          cell
            [... or enter it here]
          cell
            input "" ttt noeol
          cell
            button "See the description"
              goto_url (shunt ttt="" tt ttt) no_extension
      para
        [Here is an indicative list of Pliant types: we list here the ones which are actually registered ]
        [ in the ];fixed:[pliant_general_dictionary];[ and which are simple one (no type with name ]
        [with a ];fixed:['('];[ is listed here).]
      para
       listtypes
    else
      var Pointer:Type t :> get_type tname
      if addressof:t=null
        title "Type [dq]"+tname+"[dq] unknown"
      else
        var Str source := t:position 0 (t:position search " " t:position:len)
        title "Description of [dq]"+tname+"[dq] Data Type"
        if source<>""
          para
            [The type [dq]]; text tname; [[dq] is defined in ]
            link source source section "type "+t:name
            [ module.]
        var Pointer:List mb :> t maybe
        var Pointer:Arrow c :> mb first
        var Str mbt mbs
        if c<>null
          header "Maybe list"
          text "Type "+t:name+" may be "
          mbt := (c map Type):name
          mbs := (c map Type):position
          mbs := mbs 0 (mbs search " " mbs:len)
          if mbs<>""
            link mbt mbs section "type "+mbt
          else
            bold
              text mbt
          while {c :> mb next c; c<>null}
            text ", "
            mbt := (c map Type):name
            mbs := (c map Type):position
            mbs := mbs 0 (mbs search " " mbs:len)
            if mbs<>""
              link mbt mbs section "type "+mbt
            else
              bold
                text mbt
        header "Type description"
        center
          show_type t
        header "Type methods"
        show_methods t
        header "Casts to "+tname
        center
          show_castto t
        header "Casts from "+tname
        center
          show_castfrom t