Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with
or
.
Download ZIP
Newer
Older
100644 227 lines (192 sloc) 5.616 kB
fccc685 Initial open-source release
MLstate authored
1 (*
2 Copyright © 2011 MLstate
3
4 This file is part of OPA.
5
6 OPA is free software: you can redistribute it and/or modify it under the
7 terms of the GNU Affero General Public License, version 3, as published by
8 the Free Software Foundation.
9
10 OPA is distributed in the hope that it will be useful, but WITHOUT ANY
11 WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS
12 FOR A PARTICULAR PURPOSE. See the GNU Affero General Public License for
13 more details.
14
15 You should have received a copy of the GNU Affero General Public License
16 along with OPA. If not, see <http://www.gnu.org/licenses/>.
17 *)
18 (**
19 Adding hyperlink to the generated svg.
20 @author Mathieu Barbin
21 *)
22
23 (**
24 This module is an ad-hoc implementation for adding hyperlinks to
25 a svg file.
26 The format of the svg should be very specific, there is no parser for svg.
27
28 The format is the one seen in practice as the format produced by dot -Tsvg.
29 The hypothesis done is that any node is surrounded by a comment, indicating
30 the title of the node :
31 {[
32 <!-- qmlslicer -->
33 <g id="node39" class="node"><title>qmlslicer</title>
34 <ellipse style="fill:none;stroke:black;" cx="645" cy="-162" rx="52.8111" ry="18"/>
35 <text text-anchor="middle" x="645" y="-157.9" style="font-family:Times New Roman;font-size:14.00;">qmlslicer</text>
36 </g>
37 ]}
38
39
40 The preprocess proposed by this file is meant to add extra href annotation,
41 indexed by the name of the node.
42
43 So, if in the map you have a binding :
44 {[
45 qmlslicer -> "odep__lib_qmlslicer.svg"
46 ]}
47 the preprocess will return :
48 <!-- qmlslicer -->
49 <a xlink:href="odep__lib_qmlslicer.svg">
50 <g id="node39" class="node"><title>qmlslicer</title>
51 <ellipse style="fill:none;stroke:black;" cx="645" cy="-162" rx="52.8111" ry="18"/>
52 <text text-anchor="middle" x="645" y="-157.9" style="font-family:Times New Roman;font-size:14.00;">qmlslicer</text>
53 </g>
54 </a>
55
56
57 For using this application, you should give all the svg you want to process,
58 the link added correspond to all found file, suffixed with name.
59 In case of several matching file, the choosen link is unspecified.
60
61 Exemple:
62
63 odeplink toto.svg tutu.tata.svg
64
65 link toto -> "toto".svg
66 link tata -> tutu.tata.svg
67 *)
68
69 (* depends *)
70 module String = Base.String
71
72 let tmp = "odeplink.tmp"
73
74 (*
75 The set contains file without extension
76 *)
77 let find_suffix set suffix =
78 Return.set_checkpoint (
79 fun label ->
80 StringSet.iter (
81 fun elt ->
82 if String.is_suffix suffix elt
83 then Return.return label (Some (elt^".svg"))
84 else ()
85 ) set ;
86 None
87 )
88
89 (*
90 Given a list of file, compute the set of filename without extension
91 *)
92 let compute_set list =
93 List.fold_left (fun set file -> StringSet.add (File.chop_extension file) set)
94 StringSet.empty list
95
96 let pat_begin = "<!--\\(.*\\)-->"
97 let reg_begin = Str.regexp pat_begin
98
99 let pat_end = "</g>"
100 let reg_end = Str.regexp pat_end
101
102 let match_begin line =
103 let line = String.trim line in
104 if Str.string_match reg_begin line 0
105 then (
106 try
107 let word = Str.matched_group 1 line in
108 let word = String.trim word in
109 Some word
110 with
111 | Not_found -> None
112 )
113 else
114 None
115
116 let match_end line =
117 let line = String.trim line in
118 Str.string_match reg_end line 0
119
120 type env = string option
121 let start = None
122
123 let pp_line map env line output =
124 Printf.fprintf output "%s\n" line ;
125 match env with
126 | Some _ -> (
127 if match_end line
128 then (
129 Printf.fprintf output "</a>\n" ;
130 None
131 )
132 else env
133 )
134 | None -> (
135 (* search for a begin *)
136 match match_begin line with
137 | Some lib -> (
138 match map lib with
139 | Some link ->
140 Printf.fprintf output "<a xlink:href=%S>\n" link ;
141 Some lib
142 | None ->
143 env
144 )
145 | None -> env
146 )
147
148 let preprocess map input output =
149 try
150 let rec aux env =
151 let line = input_line input in
152 let env = pp_line map env line output in
153 aux env
154 in
155 aux start
156 with
157 | End_of_file ->
158 flush output ;
159 ()
160
161 let preprocess_file map filename =
162 let oc = open_out tmp in
163 let ic = open_in filename in
164 preprocess map ic oc ;
165 close_in ic ;
166 close_out oc ;
167 let _ = File.copy ~force:true tmp filename in
168 ()
169
170 (*
171 map a format, with NODE variable
172 *)
173 let node_pattern =
174 let buf = Buffer.create 124 in
175 let subst pat = function
176 | "NODE" -> pat
177 | e -> e
178 in
179 (fun pat node ->
180 Buffer.clear buf ;
181 Buffer.add_substitute buf (subst node) pat ;
182 Buffer.contents buf)
183
184
185 let link = ref None
186 let svg = ref []
187
188 let spec = [
189 (* l *)
190 "--link",
191 Arg.String (fun s -> link := Some s),
192 " Add external link. e.g. : path/to/file/$(NODE).html"
193 ]
194
9a4a8ee [enhance] help/manpages: global pass for improving help messages of O…
Mathieu Baudet authored
195 let usage_msg = Printf.sprintf "%s: svg hyperlink adder\nUsage: %s *.svg\n" Sys.argv.(0) Sys.argv.(0)
fccc685 Initial open-source release
MLstate authored
196
197 let anon_fun file =
198 match File.extension file with
199 | "svg" ->
200 svg := file :: !svg
201 | _ ->
202 Printf.eprintf "I don't know what to do with arg %S\n%s%!" file usage_msg ;
203 exit 1
204
205 let parse () =
9a4a8ee [enhance] help/manpages: global pass for improving help messages of O…
Mathieu Baudet authored
206 Arg.parse spec anon_fun (usage_msg^"Options:")
fccc685 Initial open-source release
MLstate authored
207
208 let _ =
209 parse ();
210 let set = compute_set !svg in
211 let map =
212 match !link with
213 | None -> find_suffix set
214 | Some pat -> (
215 fun node ->
216 match find_suffix set node with
217 | (Some _) as link -> link
218 | None ->
219 if String.is_word node
220 then
221 Some (node_pattern pat node)
222 else
223 None
224 )
225 in
226 List.iter (preprocess_file map) !svg
Something went wrong with that request. Please try again.