1 (* Copyright (C) 2000, HELM Team.
3 * This file is part of HELM, an Hypertextual, Electronic
4 * Library of Mathematics, developed at the Computer Science
5 * Department, University of Bologna, Italy.
7 * HELM is free software; you can redistribute it and/or
8 * modify it under the terms of the GNU General Public License
9 * as published by the Free Software Foundation; either version 2
10 * of the License, or (at your option) any later version.
12 * HELM is distributed in the hope that it will be useful,
13 * but WITHOUT ANY WARRANTY; without even the implied warranty of
14 * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
15 * GNU General Public License for more details.
17 * You should have received a copy of the GNU General Public License
18 * along with HELM; if not, write to the Free Software
19 * Foundation, Inc., 59 Temple Place - Suite 330, Boston,
22 * For details, see the HELM World-Wide-Web page,
23 * http://cs.unibo.it/helm/.
26 (******************************************************************************)
30 (* Claudio Sacerdoti Coen <sacerdot@cs.unibo.it> *)
34 (******************************************************************************)
37 let starts_with s s' =
38 if String.length s < String.length s' then
41 (String.sub s 0 (String.length s')) = s'
43 if starts_with s "http:" then
44 ClientHTTP.get_and_save_to_tmp s
52 `Not_recognized -> Neturl.Url_part_not_recognized
53 | `Allowed -> Neturl.Url_part_allowed
54 | `Required -> Neturl.Url_part_required
56 { Neturl.null_url_syntax with
57 Neturl.url_enable_scheme = enable_if `Allowed;
58 Neturl.url_enable_host = enable_if `Allowed;
59 Neturl.url_enable_path = Neturl.Url_part_required;
60 Neturl.url_accepts_8bits = true;
64 let file_url_of_id xid =
65 let file_url_of_sysname sysname =
66 (* By convention, we can assume that sysname is a URL conforming
67 * to RFC 1738 with the exception that it may contain non-ASCII
71 Neturl.url_of_string url_syntax sysname
72 (* may raise Malformed_URL *)
74 Neturl.Malformed_URL -> raise Pxp_reader.Not_competent
78 Pxp_types.Anonymous -> raise Pxp_reader.Not_competent
79 | Pxp_types.Public (_,sysname) ->
80 let sysname = resolve sysname in
81 if sysname <> "" then file_url_of_sysname sysname
82 else raise Pxp_reader.Not_competent
83 | Pxp_types.System sysname ->
84 let sysname = resolve sysname in
85 file_url_of_sysname sysname
88 try Neturl.url_scheme url with Not_found -> "file" in
90 try Neturl.url_host url with Not_found -> "" in
92 if scheme <> "file" then raise Pxp_reader.Not_competent;
93 if host <> "" && host <> "localhost" then raise Pxp_reader.Not_competent;
98 let from_file ?system_encoding utf8_filename =
101 new Pxp_reader.resolve_as_file
102 ?system_encoding:system_encoding
103 ~url_of_id:file_url_of_id
107 let utf8_abs_filename =
108 if utf8_filename <> "" && utf8_filename.[0] = '/' then
111 Sys.getcwd() ^ "/" ^ utf8_filename
114 let syntax = { Neturl.ip_url_syntax with Neturl.url_accepts_8bits = true } in
115 let url = Neturl.make_url
118 ~path:(Neturl.split_path utf8_abs_filename)
122 let xid = Pxp_types.System (Neturl.string_of_url url) in
125 Pxp_yacc.ExtID(xid, r)