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 (******************************************************************************)
38 "http://localhost:8081/getdtd?uri=cic.dtd" ->
39 Configuration.dtd_dir ^ "/cic.dtd"
40 | "http://localhost:8081/getdtd?uri=maththeory.dtd" ->
41 Configuration.dtd_dir ^ "/maththeory.dtd"
42 | "http://localhost:8081/getdtd?uri=annotations.dtd" ->
43 Configuration.dtd_dir ^ "/annotations.dtd"
50 `Not_recognized -> Neturl.Url_part_not_recognized
51 | `Allowed -> Neturl.Url_part_allowed
52 | `Required -> Neturl.Url_part_required
54 { Neturl.null_url_syntax with
55 Neturl.url_enable_scheme = enable_if `Allowed;
56 Neturl.url_enable_host = enable_if `Allowed;
57 Neturl.url_enable_path = Neturl.Url_part_required;
58 Neturl.url_accepts_8bits = true;
62 let file_url_of_id xid =
63 let file_url_of_sysname sysname =
64 (* By convention, we can assume that sysname is a URL conforming
65 * to RFC 1738 with the exception that it may contain non-ASCII
69 Neturl.url_of_string url_syntax sysname
70 (* may raise Malformed_URL *)
72 Neturl.Malformed_URL -> raise Pxp_reader.Not_competent
76 Pxp_types.Anonymous -> raise Pxp_reader.Not_competent
77 | Pxp_types.Public (_,sysname) ->
78 let sysname = resolve sysname in
79 if sysname <> "" then file_url_of_sysname sysname
80 else raise Pxp_reader.Not_competent
81 | Pxp_types.System sysname ->
82 let sysname = resolve sysname in
83 file_url_of_sysname sysname
86 try Neturl.url_scheme url with Not_found -> "file" in
88 try Neturl.url_host url with Not_found -> "" in
90 if scheme <> "file" then raise Pxp_reader.Not_competent;
91 if host <> "" && host <> "localhost" then raise Pxp_reader.Not_competent;
96 let from_file ?system_encoding utf8_filename =
99 new Pxp_reader.resolve_as_file
100 ?system_encoding:system_encoding
101 ~url_of_id:file_url_of_id
105 let utf8_abs_filename =
106 if utf8_filename <> "" && utf8_filename.[0] = '/' then
109 Sys.getcwd() ^ "/" ^ utf8_filename
112 let syntax = { Neturl.ip_url_syntax with Neturl.url_accepts_8bits = true } in
113 let url = Neturl.make_url
116 ~path:(Neturl.split_path utf8_abs_filename)
120 let xid = Pxp_types.System (Neturl.string_of_url url) in
123 Pxp_yacc.ExtID(xid, r)