+++ /dev/null
-(* Copyright (C) 2000, HELM Team.
- *
- * This file is part of HELM, an Hypertextual, Electronic
- * Library of Mathematics, developed at the Computer Science
- * Department, University of Bologna, Italy.
- *
- * HELM is free software; you can redistribute it and/or
- * modify it under the terms of the GNU General Public License
- * as published by the Free Software Foundation; either version 2
- * of the License, or (at your option) any later version.
- *
- * HELM 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
- * along with HELM; if not, write to the Free Software
- * Foundation, Inc., 59 Temple Place - Suite 330, Boston,
- * MA 02111-1307, USA.
- *
- * For details, see the HELM World-Wide-Web page,
- * http://cs.unibo.it/helm/.
- *)
-
-(******************************************************************************)
-(* *)
-(* PROJECT HELM *)
-(* *)
-(* Claudio Sacerdoti Coen <sacerdot@cs.unibo.it> *)
-(* 11/10/2000 *)
-(* *)
-(* *)
-(******************************************************************************)
-
-let resolve s =
- let starts_with s s' =
- if String.length s < String.length s' then
- false
- else
- (String.sub s 0 (String.length s')) = s'
- in
- if starts_with s "http:" then
- ClientHTTP.get_and_save_to_tmp s
- else
- s
-;;
-
-(*PXP 1.0
-let url_syntax =
- let enable_if =
- function
- `Not_recognized -> Neturl.Url_part_not_recognized
- | `Allowed -> Neturl.Url_part_allowed
- | `Required -> Neturl.Url_part_required
- in
- { Neturl.null_url_syntax with
- Neturl.url_enable_scheme = enable_if `Allowed;
- Neturl.url_enable_host = enable_if `Allowed;
- Neturl.url_enable_path = Neturl.Url_part_required;
- Neturl.url_accepts_8bits = true;
- }
-;;
-
-exception Unexpected;; (* Added when porting the file to PXP 1.1 *)
-
-let file_url_of_id xid =
- let file_url_of_sysname sysname =
- (* By convention, we can assume that sysname is a URL conforming
- * to RFC 1738 with the exception that it may contain non-ASCII
- * UTF-8 characters.
- *)
- try
- Neturl.url_of_string url_syntax sysname
- (* may raise Malformed_URL *)
- with
- Neturl.Malformed_URL -> raise Pxp_reader.Not_competent
- in
- let url =
- match xid with
- Pxp_types.Anonymous -> raise Pxp_reader.Not_competent
- | Pxp_types.Public (_,sysname) ->
- let sysname = resolve sysname in
- if sysname <> "" then file_url_of_sysname sysname
- else raise Pxp_reader.Not_competent
- | Pxp_types.System sysname ->
- let sysname = resolve sysname in
- file_url_of_sysname sysname
- | Pxp_types.Private pid -> raise Unexpected
- in
- let scheme =
- try Neturl.url_scheme url with Not_found -> "file" in
- let host =
- try Neturl.url_host url with Not_found -> "" in
-
- if scheme <> "file" then raise Pxp_reader.Not_competent;
- if host <> "" && host <> "localhost" then raise Pxp_reader.Not_competent;
-
- url
-;;
-
-let from_file ?system_encoding utf8_filename =
-
- let r =
- new Pxp_reader.resolve_as_file
- ?system_encoding:system_encoding
- ~url_of_id:file_url_of_id
- ()
- in
-
- let utf8_abs_filename =
- if utf8_filename <> "" && utf8_filename.[0] = '/' then
- utf8_filename
- else
- Sys.getcwd() ^ "/" ^ utf8_filename
- in
-
- let syntax = { Neturl.ip_url_syntax with Neturl.url_accepts_8bits = true } in
- let url = Neturl.make_url
- ~scheme:"file"
- ~host:"localhost"
- ~path:(Neturl.split_path utf8_abs_filename)
- syntax
- in
-
- let xid = Pxp_types.System (Neturl.string_of_url url) in
-
-
- Pxp_yacc.ExtID(xid, r)
-;;
-*)
-
-(*PXP 1.1*)
-(* csc_pxp_reader.ml is an exact copy of PXP pxp_reader.ml *)
-(* The only reason is to loosen the interface *)
-
-class resolve_as_file
- ?(file_prefix = (`Allowed :> Csc_pxp_reader.spec))
- ?(host_prefix = (`Allowed :> Csc_pxp_reader.spec))
- ?(system_encoding = `Enc_utf8)
- ?(map_private_id = (fun _ -> raise Csc_pxp_reader.Not_competent))
- ?(open_private_id = (fun _ -> raise Csc_pxp_reader.Not_competent))
- ()
- =
-
- let url_syntax =
- let enable_if =
- function
- `Not_recognized -> Neturl.Url_part_not_recognized
- | `Allowed -> Neturl.Url_part_allowed
- | `Required -> Neturl.Url_part_required
- in
- { Neturl.null_url_syntax with
- Neturl.url_enable_scheme = enable_if file_prefix;
- Neturl.url_enable_host = enable_if host_prefix;
- Neturl.url_enable_path = Neturl.Url_part_required;
- Neturl.url_accepts_8bits = true;
- }
- in
-
- let base_url_syntax =
- { Neturl.null_url_syntax with
- Neturl.url_enable_scheme = Neturl.Url_part_required;
- Neturl.url_enable_host = Neturl.Url_part_allowed;
- Neturl.url_enable_path = Neturl.Url_part_required;
- Neturl.url_accepts_8bits = true;
- }
- in
-
- let default_base_url =
- Neturl.make_url
- ~scheme: "file"
- ~host: ""
- ~path: (Neturl.split_path (Sys.getcwd() ^ "/"))
- base_url_syntax
- in
-
- let file_url_of_id xid =
- let module P = Csc_pxp_reader in
- let module T = Pxp_types in
- let file_url_of_sysname sysname =
- (* By convention, we can assume that sysname is a URL conforming
- * to RFC 1738 with the exception that it may contain non-ASCII
- * UTF-8 characters.
- *)
- try
- Neturl.url_of_string url_syntax sysname
- (* may raise Malformed_URL *)
- with
- Neturl.Malformed_URL -> raise P.Not_competent
- in
- let url =
- match xid with
- T.Anonymous -> raise P.Not_competent
- | T.Public (_,sysname) -> let sysname = resolve sysname in
- if sysname <> "" then file_url_of_sysname sysname
- else raise P.Not_competent
- | T.System sysname -> let sysname = resolve sysname in
- file_url_of_sysname sysname
- | T.Private pid -> map_private_id pid
- in
- let scheme =
- try Neturl.url_scheme url with Not_found -> "file" in
- let host =
- try Neturl.url_host url with Not_found -> "" in
-
- if scheme <> "file" then raise P.Not_competent;
- if host <> "" && host <> "localhost" then raise P.Not_competent;
-
- url
- in
-
- let channel_of_file_url xid url =
- let module P = Csc_pxp_reader in
- let module T = Pxp_types in
- match xid with
- T.Private pid -> open_private_id pid
- | _ ->
- ( try
- let path_utf8 =
- try Neturl.join_path (Neturl.url_path ~encoded:false url)
- with Not_found -> raise P.Not_competent
- in
-
- let path =
- Netconversion.recode_string
- ~in_enc: `Enc_utf8
- ~out_enc: system_encoding
- path_utf8 in
- (* May raise Malformed_code *)
-
- open_in_bin path, None
- (* May raise Sys_error *)
-
- with
- | Netconversion.Malformed_code -> assert false
- (* should not happen *)
- | Sys_error _ as e ->
- raise (P.Not_resolvable e)
- )
- in
-
- Csc_pxp_reader.resolve_read_url_channel
- ~base_url: default_base_url
- ~url_of_id: file_url_of_id
- ~channel_of_url: channel_of_file_url
- ()
-;;
-
-let from_file ?(alt = []) ?system_encoding ?enc utf8_filename =
- let r =
- new resolve_as_file
- ?system_encoding:system_encoding
- ()
- in
-
- let url = Csc_pxp_reader.make_file_url
- ?system_encoding
- ?enc
- utf8_filename in
-
- let xid = Pxp_types.System (Neturl.string_of_url url) in
-
- Pxp_yacc.ExtID(xid, new Csc_pxp_reader.combine (r :: alt))
-;;
-
projects / helm.git / blobdiff