Patch title: Release 95 bulk changes
Abstract:
File: /pliant/graphic/browser/server/instructions.pli
Key:
    Removed line
    Added line
   
module "/pliant/language/compiler.pli"
module "/pliant/language/context.pli"
module "/pliant/util/pml/io.pli"
module "/pliant/util/pml/body.pli"
module "context.pli"
module "/pliant/protocol/http/site.pli"
module "/pliant/storage/database.pli"
module "/pliant/graphic/vector/font.pli"
module "/pliant/math/vector.pli"
module "/pliant/math/curve.pli"
module "/pliant/language/compiler.pli"
module "/pliant/language/context.pli"
module "/pliant/util/pml/io.pli"
module "/pliant/util/pml/body.pli"
module "context.pli"
module "/pliant/protocol/http/site.pli"
module "/pliant/storage/database.pli"
module "/pliant/graphic/vector/font.pli"
module "/pliant/math/vector.pli"
module "/pliant/math/curve.pli"
module "/pliant/util/encoding/utf8.pli"
module "/pliant/language/type/text/str32.pli"


browser_server_instruction connect
  if (connection itag "connect" (var Str site_name) (var Str


browser_server_instruction connect
  if (connection itag "connect" (var Str site_name) (var Str
    # console "connect instruction '" site_name "' '" url "'" eol
    var Data:Site site :> site_database:data:site site_name
    if site:computer<>computer_fullname and site:computer<>"
      site :> var Data:Site no_site
    var Int longuest := 0
    var Data:SiteArea area
    each a site:area
      var Str p := a path
      if (url 0 p:len)=p
        var Int l := p len
        if l>longuest
          area :> a
          longuest := l
        eif l=longuest
          area :> var Data:SiteArea nonexisting_area
    if (allowed area:read)
      user_rights kmap "read" Bool := true
    else
      if debug
        console "not allowed" eol
      connection error "not allowed"
      return
    if (allowed area:write)
      user_rights kmap "write" Bool := true
    if area:root<>""
      url := area:root+(url area:path:len url:len)
    browser_pages_sem rd_request
    var Int i := url len
    # FIXME: two slow
    while { var Link:Function fun :> (browser_pages first (u
      i -= 1
    browser_pages_sem rd_release
    if exists:fun
      context url := url
      context subpath := url i url:len
      context env := var Dictionary empty_dictionary
      connection oraw open (cast "group" Ident) body
      page_prototype context fun
      connection oraw close
    else
      connection error "unkown url '"+url+"' requested"
  else
    connection error "invalid 'connect' instruction"



browser_server_instruction set
  env_sem request
  if (connection itag "set" (var Str id) (var Str value))
    var Data:Site site :> site_database:data:site site_name
    if site:computer<>computer_fullname and site:computer<>"
      site :> var Data:Site no_site
    var Int longuest := 0
    var Data:SiteArea area
    each a site:area
      var Str p := a path
      if (url 0 p:len)=p
        var Int l := p len
        if l>longuest
          area :> a
          longuest := l
        eif l=longuest
          area :> var Data:SiteArea nonexisting_area
    if (allowed area:read)
      user_rights kmap "read" Bool := true
    else
      if debug
        console "not allowed" eol
      connection error "not allowed"
      return
    if (allowed area:write)
      user_rights kmap "write" Bool := true
    if area:root<>""
      url := area:root+(url area:path:len url:len)
    browser_pages_sem rd_request
    var Int i := url len
    # FIXME: two slow
    while { var Link:Function fun :> (browser_pages first (u
      i -= 1
    browser_pages_sem rd_release
    if exists:fun
      context url := url
      context subpath := url i url:len
      context env := var Dictionary empty_dictionary
      connection oraw open (cast "group" Ident) body
      page_prototype context fun
      connection oraw close
    else
      connection error "unkown url '"+url+"' requested"
  else
    connection error "invalid 'connect' instruction"



browser_server_instruction set
  env_sem request
  if (connection itag "set" (var Str id) (var Str value))
    if not default_charset_is_utf8
      value := utf8_decode value
    if (id parse (var Str sid) (var Str vid))
      var Link:BrowserServerSection section :> (env first "s
      if exists:section and (entry_type addressof:section)=B
        var Link:BrowserServerVariable va :> (section:env fi
        if exists:va and (entry_type addressof:va)=BrowserSe
          if va:variable<>null
            var Pointer:Function fun :> (entry_type va:varia
            if exists:fun and fun<>(the_function '. from str
              from_string (va:variable map Universal) value 
          if va:data_path<>""
            var Data_ data := data_root search_path va:data_
            data:base:sem request
            var Status status := data:interface set data add
            data:base:sem release
          if (exists va:run:function)
            var DelayedAction action := va run
            env_sem release
            connection oraw open (cast "group" Ident) body
            execute1 action:parameter action:function
            connection oraw close
            env_sem request
  env_sem release



browser_server_instruction font
  if (connection itag "font" (var Str name))
    if (name 0 1)="/"
      var Link:Font f :> font (name 1 name:len)
      if exists:f
        connection oraw open (cast "font" Ident)
        if (connection iattr "bbox")
          connection oraw (cast "bbox" Ident) f:bbox_x0 f:bb
        if (connection iattr "vector")
          connection oraw (cast "vector" Ident) f:vector:x f
        connection oraw body
        if not (connection ibody_begin)
          return
        while (connection iraw (var Int n))
          var Pointer:FontChar ch :> f:chars first n
          if exists:ch
            connection oraw open (cast "char" Ident) n
            connection oraw (cast "bbox" Ident) ch:bbox_x0 c
            connection oraw (cast "vector" Ident) ch:vector:
            connection oraw body
            for (var Int i) 0 ch:curves:size-1
              var Pointer:Curve c :> ch:curves i
              connection oraw open (cast "c" Ident) c:mode b
              for (var Int j) 0 c:size-1
                var Pointer:CurvePoint p :> c point j
                connection oraw open (cast "p" Ident) p:x p:
                if p:in_x<>0 or p:in_y<>0
                  connection oraw (cast "i" Ident) (cast p:i
                if p:out_x<>0 or p:out_y<>0
                  connection oraw (cast "o" Ident) (cast p:o
                connection oraw close
              connection oraw close
            connection oraw close
        if not (connection ibody_end)
          return
        connection oraw close
        return
  connection oraw (var Void v)
    if (id parse (var Str sid) (var Str vid))
      var Link:BrowserServerSection section :> (env first "s
      if exists:section and (entry_type addressof:section)=B
        var Link:BrowserServerVariable va :> (section:env fi
        if exists:va and (entry_type addressof:va)=BrowserSe
          if va:variable<>null
            var Pointer:Function fun :> (entry_type va:varia
            if exists:fun and fun<>(the_function '. from str
              from_string (va:variable map Universal) value 
          if va:data_path<>""
            var Data_ data := data_root search_path va:data_
            data:base:sem request
            var Status status := data:interface set data add
            data:base:sem release
          if (exists va:run:function)
            var DelayedAction action := va run
            env_sem release
            connection oraw open (cast "group" Ident) body
            execute1 action:parameter action:function
            connection oraw close
            env_sem request
  env_sem release



browser_server_instruction font
  if (connection itag "font" (var Str name))
    if (name 0 1)="/"
      var Link:Font f :> font (name 1 name:len)
      if exists:f
        connection oraw open (cast "font" Ident)
        if (connection iattr "bbox")
          connection oraw (cast "bbox" Ident) f:bbox_x0 f:bb
        if (connection iattr "vector")
          connection oraw (cast "vector" Ident) f:vector:x f
        connection oraw body
        if not (connection ibody_begin)
          return
        while (connection iraw (var Int n))
          var Pointer:FontChar ch :> f:chars first n
          if exists:ch
            connection oraw open (cast "char" Ident) n
            connection oraw (cast "bbox" Ident) ch:bbox_x0 c
            connection oraw (cast "vector" Ident) ch:vector:
            connection oraw body
            for (var Int i) 0 ch:curves:size-1
              var Pointer:Curve c :> ch:curves i
              connection oraw open (cast "c" Ident) c:mode b
              for (var Int j) 0 c:size-1
                var Pointer:CurvePoint p :> c point j
                connection oraw open (cast "p" Ident) p:x p:
                if p:in_x<>0 or p:in_y<>0
                  connection oraw (cast "i" Ident) (cast p:i
                if p:out_x<>0 or p:out_y<>0
                  connection oraw (cast "o" Ident) (cast p:o
                connection oraw close
              connection oraw close
            connection oraw close
        if not (connection ibody_end)
          return
        connection oraw close
        return
  connection oraw (var Void v)