Skip to content
Newer
Older
100644 716 lines (629 sloc) 23.7 KB
a2562c6 @smondet First import, build environment, directory tree.
authored Sep 24, 2009
1
2 open Dibrawi_std
3
7ed9da8 @smondet Dibrawi_make,app: First integration of the make algorithm.
authored May 4, 2010
4 module Make = Dibrawi_make
b6e4f98 @smondet Started the Templating module.
authored Sep 29, 2009
5
a524e10 @smondet lib: Create module Dibrawi_system
authored Sep 11, 2010
6 module System = Dibrawi_system
7
d7c9c82 @smondet lib: Create module Xelatex
authored Sep 13, 2010
8 module Xelatex = Dibrawi_xelatex
9
a40657d @smondet Create new module Dibrawi.HTML.Template
authored Sep 22, 2010
10 module HTML = struct
11 module Template = Dibrawi_html_template
12 end
13
14
e7b9fdd @smondet lib: Started to implement the module Data_source.
authored Sep 24, 2009
15 module Info = struct
6c4315b @smondet Dibrawi.File_tree: Code cleaning.
authored Jun 8, 2010
16 let version = 0
17 let version_string = sprintf "The Dibrawi library, v %d" version
e7b9fdd @smondet lib: Started to implement the module Data_source.
authored Sep 24, 2009
18 end
a2562c6 @smondet First import, build environment, directory tree.
authored Sep 24, 2009
19
84086a4 @smondet Fixes and improvements
authored Sep 26, 2009
20 module File_tree = struct
21
6c4315b @smondet Dibrawi.File_tree: Code cleaning.
authored Jun 8, 2010
22 type file_tree_item =
23 | Dir of string * string * file_tree
24 | File of string * string
25 and
84086a4 @smondet Fixes and improvements
authored Sep 26, 2009
26 file_tree = file_tree_item list
27
6c4315b @smondet Dibrawi.File_tree: Code cleaning.
authored Jun 8, 2010
28
29 let fold_tree
30 ?(dir=fun path name a -> a) ?(file=fun path name a -> ())
31 init tree =
32 let rec parse current = function
33 | Dir (path, name, l) ->
34 let next = dir path name current in
35 Ls.iter (parse next) l
36 | File (path, name) ->
37 file path name current
38 in
39 Ls.iter (parse init) tree
40
84086a4 @smondet Fixes and improvements
authored Sep 26, 2009
41
6c4315b @smondet Dibrawi.File_tree: Code cleaning.
authored Jun 8, 2010
42 let print_tree =
43 fold_tree
44 ~dir:(fun path name indent ->
45 printf "%s%s\n" (Str.make indent ' ') name;
46 indent + 2)
47 ~file:(fun path name indent ->
48 printf "%s%s\n" (Str.make indent ' ') name;)
49 0
84086a4 @smondet Fixes and improvements
authored Sep 26, 2009
50
4cfdcd8 @smondet Add filtering functions to module File_tree
authored Nov 22, 2010
51 (** Filter the file tree. *)
52 let rec filter_tree tree ~f =
53 let new_tree = ref [] in
54 let filter = function
55 | Dir (path, name, subdir) ->
56 if f path name then
57 new_tree := Dir (path, name, filter_tree ~f subdir) :: !new_tree
58 | File (path, name) as file ->
59 if f path name then
60 new_tree := file :: !new_tree
61 in
62 Ls.iter filter tree;
63 Ls.rev !new_tree
64
65 (** Exclude files and directories matching [pattern]. *)
66 let exclude_from_tree pattern tree =
67 let rex = Pcre.regexp pattern in
68 filter_tree tree ~f:(fun path name -> not (pcre_matches rex (path ^ name)))
69
70 (** Keep only the files and directories matching [pattern]. *)
71 let filter_tree_with_pattern pattern tree =
72 let rex = Pcre.regexp pattern in
73 filter_tree tree ~f:(fun path name -> (pcre_matches rex (path ^ name)))
84086a4 @smondet Fixes and improvements
authored Sep 26, 2009
74
6c4315b @smondet Dibrawi.File_tree: Code cleaning.
authored Jun 8, 2010
75 let string_path_list
76 ?(filter="\\.brtx$") ?(exclude=".*\\.svn.*") ?(url_prefix="") tree =
77 let filt = Pcre.regexp filter in
78 let excl = Pcre.regexp exclude in
79 let paths = ref [] in
80 fold_tree
81 ~file:(fun p n () ->
82 let full = p ^ "/" ^ n in
83 if (pcre_matches filt full) && not (pcre_matches excl full)
84 then (paths := (url_prefix ^ full) :: !paths);) () tree;
85 (Ls.rev !paths)
86
84086a4 @smondet Fixes and improvements
authored Sep 26, 2009
87
6c4315b @smondet Dibrawi.File_tree: Code cleaning.
authored Jun 8, 2010
88 (* Render a path compatible with Future.Path in batteries *)
89 let path_list
90 ?(filter="\\.brtx$") ?(exclude=".*\\.svn.*") ?(prefix=[]) tree =
91 let filt = Pcre.regexp filter in
92 let excl = Pcre.regexp exclude in
93 let paths = ref [] in
94 (* let current = ref prefix in *)
95 fold_tree
96 ~dir:(fun p n c ->
97 Opt.bind (fun cc ->
98 if not (pcre_matches excl n) then Some (n :: cc) else None) c)
99 ~file:(fun p n c ->
100 Opt.may (fun c ->
101 if (pcre_matches filt n)
102 then (paths := (n :: c) :: !paths);) c
103 )
104 (Some prefix) tree;
105 (Ls.rev !paths)
106
107 let str_and_path_list
108 ?(filter="\\.brtx$") ?(exclude=".*\\.svn.*") ?(prefix=("", [])) tree =
109 let filt = Pcre.regexp filter in
110 let excl = Pcre.regexp exclude in
111 let paths = ref [] in
112 (* let current = ref prefix in *)
113 fold_tree
114 ~dir:(fun p n c ->
115 Opt.bind (fun cc ->
116 if not (pcre_matches excl n)
117 then Some (n :: cc) else None) c)
118 ~file:(fun p n c ->
119 Opt.may (fun c ->
120 if (pcre_matches filt n)
121 then (
122 let to_add =
123 ((fst prefix) ^ p ^ "/" ^ n, n :: c) in
124 paths := to_add :: !paths;
125 );) c)
126 (Some (snd prefix)) tree;
127 (Ls.rev !paths)
84086a4 @smondet Fixes and improvements
authored Sep 26, 2009
128 end
e7b9fdd @smondet lib: Started to implement the module Data_source.
authored Sep 24, 2009
129
130 module Data_source = struct
131 (* Future:
132 - is_valid_zipimg: path -> bool
133
8795ec4 @smondet Dibrawi.{File_tree,Todo_list,Special_paths}: Code cleaning.
authored Jun 8, 2010
134 *)
135
136 let get_file_tree ?(data_root="./data/") () =
137 let module FT = File_tree in
138 let ls dir =
139 let sort a = Array.fast_sort Str.compare a; a in
140 Sys.readdir dir |> sort |> Array.to_list in
141 if Sys.is_directory data_root then (
142 let rec explore path name =
143 let next_path = path ^ "/" ^ name in
144 let real_path = data_root ^ "/" ^ next_path in
145 if Sys.is_directory real_path then
146 FT.Dir (path, name, Ls.map (explore next_path) (ls real_path))
147 else
148 FT.File (path, name)
149 in
150 Ls.map (explore ".") (ls data_root)
151 ) else (
152 invalid_arg (sprintf "%s is not a directory" data_root)
e7b9fdd @smondet lib: Started to implement the module Data_source.
authored Sep 24, 2009
153 )
8795ec4 @smondet Dibrawi.{File_tree,Todo_list,Special_paths}: Code cleaning.
authored Jun 8, 2010
154
2e28f26 @smondet Dibrawi.Data_source: close input channels.
authored May 4, 2010
155 let get_file path =
156 let i = Io.open_in path in
157 let all = Io.read_all i in
158 Io.close_in i;
159 all
160
161 let get_page path = get_file path
e7b9fdd @smondet lib: Started to implement the module Data_source.
authored Sep 24, 2009
162
163 end
164
84086a4 @smondet Fixes and improvements
authored Sep 26, 2009
165
a3ce0b5 @smondet Implemented the modules Todo_list and Preprocessor
authored Sep 27, 2009
166 module Todo_list = struct
167
8795ec4 @smondet Dibrawi.{File_tree,Todo_list,Special_paths}: Code cleaning.
authored Jun 8, 2010
168 type todo = [
169 | `copy of (string * (string list))
170 ]
171 type t = todo list ref
172
173 let empty () = ref []
174
175 let is_empty t = !t =@= []
176
177 let to_string ?(sep="; ") tl =
178 let strpath = Str.concat "/" in
179 String.concat sep (Ls.map !tl ~f:(function
180 | `copy (path, from) ->
181 sprintf "Copy File: %s from %s" path (strpath from)))
182
183 let iter t ~f = Ls.iter !t ~f
184
185 let do_things t ~(f:todo -> todo list) =
186 t := Ls.concat (Ls.map !t ~f)
187
188 let simplify t = t := Ls.unique !t
189
a3ce0b5 @smondet Implemented the modules Todo_list and Preprocessor
authored Sep 27, 2009
190 end
191
9d3978e @smondet First implementation of the URLs hook.
authored Sep 27, 2009
192 module Special_paths = struct
193
d68b422 @smondet Added the DIBRAWI_TEMPLATE_PATH_TO_ROOT templating tag.
authored May 26, 2010
194 let parent_directories_path from =
195 let depth = Ls.length from - 1 in
2703459 @smondet Fix Special_paths.parent_directories_path
authored Nov 22, 2010
196 if depth > 0 then
197 (Str.concat "/" (Ls.init depth (fun _ -> "..")))
198 else
199 "."
d68b422 @smondet Added the DIBRAWI_TEMPLATE_PATH_TO_ROOT templating tag.
authored May 26, 2010
200
201 let relativize from path =
202 try
203 match path.[0] with
204 | '/' -> (parent_directories_path from) ^ path
205 | '#' -> (Filename.chop_extension (Ls.hd from)) ^ path
206 | _ -> path
207 with _ -> (Filename.chop_extension (Ls.hd from)) (* the string is empty*)
8795ec4 @smondet Dibrawi.{File_tree,Todo_list,Special_paths}: Code cleaning.
authored Jun 8, 2010
208
209 let typify url extension =
210 match Str.rev_idx url '#', Str.rev_idx url '/' with
211 | Some h , None ->
212 (Str.head url h) ^ extension ^ (Str.tail url h)
213 | Some h, Some l when h > l ->
214 (Str.head url h) ^ extension ^ (Str.tail url h)
215 | _, _ ->
216 url ^ extension
217
218 let compute_path from url extension =
219 typify (relativize from url) extension
220
221 let rec rewrite_url ?todo_list ?(output=`html) ~from url =
222 match url with
5b15a5d @smondet Fix bug in Special_paths.rewrite_url
authored Nov 10, 2010
223 | s when Str.starts_with s "pdf:" ->
8795ec4 @smondet Dibrawi.{File_tree,Todo_list,Special_paths}: Code cleaning.
authored Jun 8, 2010
224 let pdfpath =
225 compute_path from (Str.tail s 4) ".pdf" in
226 pdfpath
5b15a5d @smondet Fix bug in Special_paths.rewrite_url
authored Nov 10, 2010
227 | s when Str.starts_with s "fig:" ->
8795ec4 @smondet Dibrawi.{File_tree,Todo_list,Special_paths}: Code cleaning.
authored Jun 8, 2010
228 let path =
229 compute_path from (Str.tail s 4)
230 (match output with `html -> ".png" | `pdf -> ".pdf") in
231 Opt.may todo_list ~f:(fun rl -> rl := (`copy (path, from)) :: !rl;);
232 path
5b15a5d @smondet Fix bug in Special_paths.rewrite_url
authored Nov 10, 2010
233 | s when Str.starts_with s "page:" ->
234 (compute_path from (Str.tail s 5) ".html")
235 | s when Str.starts_with s "media:" ->
8795ec4 @smondet Dibrawi.{File_tree,Todo_list,Special_paths}: Code cleaning.
authored Jun 8, 2010
236 let path = compute_path from (Str.tail s 6) "" in
237 Opt.may todo_list ~f:(fun rl -> rl := (`copy (path, from)) :: !rl;);
238 path
239 | s -> s
9d3978e @smondet First implementation of the URLs hook.
authored Sep 27, 2009
240
241 end
a3ce0b5 @smondet Implemented the modules Todo_list and Preprocessor
authored Sep 27, 2009
242
243 module Preprocessor = struct
244
33dc674 @smondet Dibrawi.{Preprocessor,Bibliography}: Code cleaning.
authored Jun 8, 2010
245 let default_html_biblio_page = "page:/bibliography"
246
247 let default_html_cite =
248 fun html_biblio_page cites ->
249 "[" ^ (Str.concat ", "
250 (Ls.map cites ~f:(fun cite ->
251 sprintf "{link %s#%s|%s}"
252 html_biblio_page cite cite))) ^ "]"
253
cc4520b @smondet Implement a `mostly silent' preprocessor
authored Mar 15, 2011
254 let sanitize_brtx_command s =
255 Str.replace_chars (function
256 | '\\' -> "\\\\"
257 | ' ' -> "\\ "
258 | '|' -> "\\|"
259 | '{' -> "\\{"
260 | '}' -> "\\}"
261 | c -> Str.of_char c) s
262
4e0d73f @smondet Implement the `cmt' command in the new prepro
authored Mar 17, 2011
263 let sanitize_brtx_content s =
264 Str.replace_chars (function
265 | '#' -> "{#}"
266 | '{' -> "{{}"
267 | '}' -> "{}}"
268 | c -> Str.of_char c) s
269
cc4520b @smondet Implement a `mostly silent' preprocessor
authored Mar 15, 2011
270 let make
271 ?(html_cite=default_html_cite default_html_biblio_page)
272 ?(output=`html) ?(mix_output=`wiki) () =
273 let buf = Buffer.create 42 in
274 let pr = Buffer.add_string buf in
561bcd6 @smondet Fix bug in location printing
authored Mar 15, 2011
275 let ploc l str =
276 snd (Str.replace ~str ~sub:" "
277 ~by:(sprintf "\n#line %d %S\n"
278 l.Bracetax.Error.l_line l.Bracetax.Error.l_file)) in
cc4520b @smondet Implement a `mostly silent' preprocessor
authored Mar 15, 2011
279 let default_raw_end = Bracetax.Commands.Raw.default_raw_end () in
280 let is_old_pp_raw_2 s = Ls.exists ((=) s) ["mc"; "mi"; "me"] in
281 let is_old_pp_raw_n s =
282 Ls.exists ((=) s) ["mix:code"; "mix:ignore"; "mix:end"] in
283 let is_old_pp_raw s = is_old_pp_raw_2 s || is_old_pp_raw_n s in
4e0d73f @smondet Implement the `cmt' command in the new prepro
authored Mar 17, 2011
284 let cmd_stack = Stack.create () in
285 let bypass s =
286 let endtag = "dibrawipreprocessorendtag" in
287 (sprintf "{bypass %s}%s{%s}" endtag s endtag) in
288 let html_or_latex h l = match output with `html -> h | `pdf -> l in
2f886ad @smondet Implement the `cite' command with the new prepro
authored Mar 17, 2011
289 let clean_cite s =
290 Str.replace_chars (function
291 | 'a' .. 'z' | 'A' .. 'Z' | '0' .. '9'
292 | ':' | '.' | '-' | '_' as ok -> Str.of_char ok
293 | _ -> "") s in
294 let split_cites s = Str.nsplit s "," in
cc4520b @smondet Implement a `mostly silent' preprocessor
authored Mar 15, 2011
295 let brtx_printer =
296 { Bracetax.Signatures.
297 print_comment = (fun _ _ -> ());
561bcd6 @smondet Fix bug in location printing
authored Mar 15, 2011
298 print_text = (fun loc s -> pr (ploc loc s));
cc4520b @smondet Implement a `mostly silent' preprocessor
authored Mar 15, 2011
299 enter_cmd = (fun loc cmd args ->
4e0d73f @smondet Implement the `cmt' command in the new prepro
authored Mar 17, 2011
300 Stack.push (cmd, args) cmd_stack;
301 match cmd with
302 | "cmt" ->
303 pr (bypass
304 (html_or_latex
305 "<span class=\"dibrawicomment\">" "\\dbwcmt{"));
306 pr (Str.concat " " (Ls.map sanitize_brtx_content args))
3300353 @smondet Implement the "=" and "@" preprocessor commands
authored Mar 21, 2011
307 | "cite" | "=" | "@" -> ()
4e0d73f @smondet Implement the `cmt' command in the new prepro
authored Mar 17, 2011
308 | _ ->
309 pr (sprintf "{%s%s|" cmd
310 (Str.concat "" (Ls.map (fun s ->
311 sprintf " %s" (sanitize_brtx_command s)) args))));
312 leave_cmd = (fun loc ->
313 match Stack.pop cmd_stack with
314 | ("cmt", _) -> pr (bypass (html_or_latex "</span>" "}"))
2f886ad @smondet Implement the `cite' command with the new prepro
authored Mar 17, 2011
315 | ("cite", args) ->
316 let cites =
317 Ls.map ~f:clean_cite
318 (Ls.flatten (Ls.map args ~f:split_cites)) in
319 pr (html_or_latex (html_cite cites)
320 (bypass (sprintf "\\cite{%s}" (Str.concat "," cites))))
3300353 @smondet Implement the "=" and "@" preprocessor commands
authored Mar 21, 2011
321 | (cmd, args) when cmd = "=" || cmd = "@" ->
322 begin match mix_output with
323 | `wiki ->
324 pr "{bypass endfordiv}<span class=\"dbwmixcode\">{endfordiv}";
325 pr (sprintf "{t|{utf 0x22b2}%s {text mixspecialend}" cmd);
326 pr (Str.concat " " args);
327 pr "{mixspecialend}{utf 0x22b3}}";
328 pr "{bypass endfordiv}</span>{endfordiv}";
329 | `camlmix ->
330 pr "##";
331 pr (if cmd = "=" then "= " else " ");
332 pr (Str.concat " " args);
333 pr " ##";
334 end
4e0d73f @smondet Implement the `cmt' command in the new prepro
authored Mar 17, 2011
335 | _ -> pr "}");
cc4520b @smondet Implement a `mostly silent' preprocessor
authored Mar 15, 2011
336 terminate = (fun loc -> ());
337 is_raw = (fun s ->
338 (Bracetax.Commands.Raw.is_raw_cmd s) || (is_old_pp_raw s));
339 default_raw_end = (function
340 | s when Bracetax.Commands.Raw.is_raw_cmd s -> "end"
341 | s when is_old_pp_raw_2 s -> "me"
342 | s -> "mix:end");
343 enter_raw = (fun loc cmd args ->
dec0ea5 @smondet Implement the mix:* commands in the new prepro
authored Mar 18, 2011
344 Stack.push (cmd, args) cmd_stack;
345 match cmd with
346 | "mix:ignore" | "mi" ->
347 begin match mix_output with
348 | `wiki -> pr "{ignore mixspecialend}"
349 | `camlmix -> pr "##"
350 end
351 | "mix:code" | "mc" ->
352 begin match mix_output with
353 | `wiki ->
354 pr "{bypass endfordiv}<div class=\"dbwmixcode\">{endfordiv}\
355 {code mixspecialend}"
356 | `camlmix -> pr "##"
357 end
358 | s ->
359 pr (sprintf "{%s%s}" cmd
360 (Str.concat "" (Ls.map (fun s ->
361 sprintf " %s" (sanitize_brtx_command s)) args))));
f7bea62 @smondet Move the camlmix sanitisation to the new prepro
authored Mar 15, 2011
362 print_raw =
363 (fun loc line ->
364 if mix_output = `camlmix then
365 pr (Str.replace_all line ~sub:"##" ~by:"###")
366 else
367 pr line);
dec0ea5 @smondet Implement the mix:* commands in the new prepro
authored Mar 18, 2011
368 leave_raw = (fun loc ->
369 match Stack.pop cmd_stack with
370 | ("mix:ignore", _) | ("mi", _) ->
371 begin match mix_output with
372 | `wiki -> pr "{mixspecialend}"
373 | `camlmix -> pr "##"
374 end
375 | ("mix:code", _) | ("mc", _) ->
376 begin match mix_output with
377 | `wiki ->
378 pr "{mixspecialend}";
379 pr "{bypass endfordiv}</div>{endfordiv}";
380 | `camlmix -> pr "##"
381 end
382 | (s, []) -> pr (sprintf "{%s}" default_raw_end)
383 | (s, endtag :: _) -> pr (sprintf "{%s}" endtag));
cc4520b @smondet Implement a `mostly silent' preprocessor
authored Mar 15, 2011
384 error = (function
385 | `undefined s -> eprintf "%s\n" s;
386 | `message ((_, gravity, _) as msg) ->
387 eprintf "%s\n" (Bracetax.Error.to_string msg));} in
f416ee7 @smondet Use separation between prepro's creation and run
authored Mar 18, 2011
388 let do_prepro ~filename str =
cc4520b @smondet Implement a `mostly silent' preprocessor
authored Mar 15, 2011
389 let read_char_opt =
390 let cpt = ref (-1) in
391 (fun () -> try Some (incr cpt; str.[!cpt]) with e -> None) in
f416ee7 @smondet Use separation between prepro's creation and run
authored Mar 18, 2011
392 Stack.clear cmd_stack;
6e41b0e @smondet Clear the preprocessor's buffer before calling
authored Mar 15, 2011
393 Buffer.clear buf; (* `clear' keeps the internal string, `reset'
394 deallocates it. *)
cc4520b @smondet Implement a `mostly silent' preprocessor
authored Mar 15, 2011
395 Bracetax.Parser.do_transformation ~deny_bypass:false brtx_printer
396 read_char_opt filename;
397 Buffer.contents buf in
398 do_prepro
399
400
401
33dc674 @smondet Dibrawi.{Preprocessor,Bibliography}: Code cleaning.
authored Jun 8, 2010
402 let brtx2brtx ?todo_list
403 ?(html_cite=default_html_cite default_html_biblio_page)
4edbef1 @smondet Fix bug in Brtx_transform.html_toc (preprocessor)
authored Sep 20, 2010
404 ?(output=`html) ?(mix_output=`wiki) ?from brtx =
cc4520b @smondet Implement a `mostly silent' preprocessor
authored Mar 15, 2011
405 let future = make ~html_cite ~output ~mix_output () in
dec0ea5 @smondet Implement the mix:* commands in the new prepro
authored Mar 18, 2011
406 let brtx =
407 future (Str.concat "/" (Ls.rev (Opt.default ["?NoFile?"] from))) brtx in
408 brtx
409
33dc674 @smondet Dibrawi.{Preprocessor,Bibliography}: Code cleaning.
authored Jun 8, 2010
410
a3ce0b5 @smondet Implemented the modules Todo_list and Preprocessor
authored Sep 27, 2009
411 end
c77b17f @smondet Added support for bibliography.
authored Sep 29, 2009
412
413 (******************************************************************************)
414 module Bibliography = struct
415
06377ad @smondet Preprocessor: added an end tag for the {bypass} commands.
authored Feb 25, 2010
416 (* str_list is a list S-Expressions (already loaded in memory) *)
33dc674 @smondet Dibrawi.{Preprocessor,Bibliography}: Code cleaning.
authored Jun 8, 2010
417 let load str_list =
28dfb5b @smondet Add sorting and unification to the biblioraphy
authored Oct 11, 2010
418 let cmp = Sebib.Biblio.compare_by_field `id in
419 Sebib.Biblio.sort (Sebib.Biblio.unique ~cmp
420 (Sebib.Parsing.parse (Str.concat " " str_list)))
33dc674 @smondet Dibrawi.{Preprocessor,Bibliography}: Code cleaning.
authored Jun 8, 2010
421
422 let to_brtx biblio =
423 let pattern = "
d4e016f @smondet Improved the bibliograhy page (minor).
authored Oct 12, 2009
424 {section 1 @{id}|{t|@{id}}}\
425 {cite @{id}}{br}\
c77b17f @smondet Added support for bibliography.
authored Sep 29, 2009
426 {b|@{title}}{br} \
427 @{if (has authors)}@{authors-and}\
428 @{else}{i|-- no authors --}@{endif}{br}\
429 @{year} - {i|@{how}}{br} \
d9f0298 @smondet Dibrawi.Bibliography: Adaptation to new syntax.
authored Jan 16, 2010
430 @{if (or (has url) (has pdfurl) (has doi))} {b|Links:} \
c77b17f @smondet Added support for bibliography.
authored Sep 29, 2009
431 @{if (has url)}{t|{link @{url}|URL}}@{endif} \
432 @{if (has pdfurl)}{t|{link @{pdfurl}|PDF}}@{endif} \
433 @{if (has doi)}{t|{link @{doi}|doi}}@{endif}{br}@{endif} \
434 {b|Tags:} {i|@{tags}} {br} \
435 @{if (has keywords)}{b|Keywords:} {i|@{keywords}} {br}@{endif} \
436 @{if (has abstract)}{b|Abstract:} {br} @{abstract} {br}@{endif} \
d9f0298 @smondet Dibrawi.Bibliography: Adaptation to new syntax.
authored Jan 16, 2010
437 @{if (has comment-short)}{b|Description:} \
e2af52f @smondet Dibrawi.Bibliography: Adapted to the new Sebib lib
authored Jan 14, 2010
438 @{comment-short}{br}@{endif}\
d9f0298 @smondet Dibrawi.Bibliography: Adaptation to new syntax.
authored Jan 16, 2010
439 @{if (has comment-main)}{b|Comments:} {br} @{comment}@{endif}" in
33dc674 @smondet Dibrawi.{Preprocessor,Bibliography}: Code cleaning.
authored Jun 8, 2010
440 "{header|{title|Bibliography}}" ^ (Sebib.Format.str ~pattern biblio)
441
442 let bibtex = Sebib.BibTeX.str
443
c77b17f @smondet Added support for bibliography.
authored Sep 29, 2009
444 end
445
b6e4f98 @smondet Started the Templating module.
authored Sep 29, 2009
446
c77b17f @smondet Added support for bibliography.
authored Sep 29, 2009
447 module Brtx_transform = struct
448
449 (* TODO handle errors better *)
81c2d36 @smondet Dibrawi.{Brtx_transform,HTML_menu}: Code cleaning.
authored Jun 8, 2010
450 let to_html ?todo_list ?class_hook ?filename ~from brtx =
451 let html_buffer = Buffer.create 1024 in
452 let err_buffer = Buffer.create 512 in
453 let writer, input_char =
f416ee7 @smondet Use separation between prepro's creation and run
authored Mar 18, 2011
454 Bracetax.Transform.string_io brtx html_buffer err_buffer in
81c2d36 @smondet Dibrawi.{Brtx_transform,HTML_menu}: Code cleaning.
authored Jun 8, 2010
455 let url_hook =
456 Special_paths.rewrite_url ?todo_list ~from in
457 Bracetax.Transform.brtx_to_html
c079509 @smondet Add option ~make_section_links:`always to Bracetax
authored Dec 16, 2010
458 ~writer ?filename ?class_hook ~make_section_links:`always
81c2d36 @smondet Dibrawi.{Brtx_transform,HTML_menu}: Code cleaning.
authored Jun 8, 2010
459 ~img_hook:url_hook ~url_hook ~input_char ();
460 (html_buffer, err_buffer)
461
462 let html_toc ?filename brtx =
463 let brtx_buffer = Buffer.create 1024 in
464 let err_buffer = Buffer.create 512 in
465 let writer, input_char =
f416ee7 @smondet Use separation between prepro's creation and run
authored Mar 18, 2011
466 Bracetax.Transform.string_io brtx brtx_buffer err_buffer in
1638e03 @smondet Make always links when generating TOCs
authored Dec 15, 2010
467 Bracetax.Transform.get_TOC
468 ~make_links:`always ~writer ~input_char ?filename ();
81c2d36 @smondet Dibrawi.{Brtx_transform,HTML_menu}: Code cleaning.
authored Jun 8, 2010
469 let h, e =
470 to_html ~class_hook:"dbwtoc" ~from:[""]
471 (Buffer.contents brtx_buffer) in
472 (Buffer.contents h)
c77b17f @smondet Added support for bibliography.
authored Sep 29, 2009
473
474 end
1079689 @smondet Added support for the menu on the right pane
authored Sep 29, 2009
475
476
477 module HTML_menu = struct
478
81c2d36 @smondet Dibrawi.{Brtx_transform,HTML_menu}: Code cleaning.
authored Jun 8, 2010
479 open Data_source
480 open File_tree
1079689 @smondet Added support for the menu on the right pane
authored Sep 29, 2009
481
81c2d36 @smondet Dibrawi.{Brtx_transform,HTML_menu}: Code cleaning.
authored Jun 8, 2010
482 let brtx_menu
483 ?(url_prefix="")
484 ?(filter="\\.brtx$") ?(exclude_dir=".*\\.svn.*")
485 ?(chop_filter=true) ?(replace=".html") tree =
486 let buf = Buffer.create 1024 in
487 let filt = Pcre.regexp filter in
488 let excl = Pcre.regexp exclude_dir in
489 let presort l =
490 let dirs, files =
491 Ls.partition (function Dir _ -> false | _ -> true) l in
492 dirs @ files in
493 let rec to_brtx = function
494 | Dir (path, name, l) ->
495 (* eprintf "path: %s, name: %s\n" path name; *)
496 if not (pcre_matches excl name) then (
497 Buffer.add_string buf
6f4b8be @smondet Add CSS class to directories in generated menus
authored Nov 22, 2010
498 (sprintf "{*} {bypass}<div class=\"dibrawimenudir\">{end}\
499 %s\n{begin list}\n" name);
81c2d36 @smondet Dibrawi.{Brtx_transform,HTML_menu}: Code cleaning.
authored Jun 8, 2010
500 Ls.iter ~f:to_brtx (presort l);
6f4b8be @smondet Add CSS class to directories in generated menus
authored Nov 22, 2010
501 Buffer.add_string buf (sprintf "{end}{bypass}</div>{end} # %s\n" name);
81c2d36 @smondet Dibrawi.{Brtx_transform,HTML_menu}: Code cleaning.
authored Jun 8, 2010
502 ) else (
503 Buffer.add_string buf
504 (sprintf "# ignore: %s %s\n" path name);
1079689 @smondet Added support for the menu on the right pane
authored Sep 29, 2009
505 );
81c2d36 @smondet Dibrawi.{Brtx_transform,HTML_menu}: Code cleaning.
authored Jun 8, 2010
506 | File (path, name) ->
507 if pcre_matches filt name then (
508 let rex = filt in
509 let link =
510 path ^ "/" ^ (Pcre.replace ~rex ~templ:replace name) in
511 let official_name =
512 if chop_filter
513 then Pcre.replace ~rex ~templ:"" name
514 else name in
515 Buffer.add_string buf
516 (sprintf "{*} {link %s%s|%s}\n" url_prefix link official_name);
517 );
518 in
519 Buffer.add_string buf (sprintf "{begin list}\n");
520 Ls.iter to_brtx (presort tree);
521 Buffer.add_string buf (sprintf "{end} # Root\n");
522 (Buffer.contents buf)
523
524 let html_menu
525 ?(url_prefix="page:/")
526 ?(filter="\\.brtx$") ?(exclude_dir=".*\\.svn.*")
527 ?(chop_filter=true) ?(replace="") ~from tree =
528 let brtx =
529 brtx_menu ~url_prefix ~filter ~exclude_dir ~replace ~chop_filter tree in
530 let buf, err =
f416ee7 @smondet Use separation between prepro's creation and run
authored Mar 18, 2011
531 Brtx_transform.to_html (* Should not need preprocessing. *)
81c2d36 @smondet Dibrawi.{Brtx_transform,HTML_menu}: Code cleaning.
authored Jun 8, 2010
532 ~filename:"BRTX MENU" ~class_hook:"dibrawi_menu" ~from brtx in
533 if (Buffer.contents err <$> "") then (
534 eprintf "Errors in the bracetax: \n%s\n------------%s\n"
535 brtx (Buffer.contents err);
536 failwith "brtx ended with errors";
537 );
538 (Buffer.contents buf)
539
540
541 type menu_factory = {
542 cache: (int, string) Ht.t;
543 source: File_tree.file_tree;
544 }
545 let make_menu_factory source_menu =
546 {cache = Ht.create 5; source = source_menu; }
547
548 let get_menu factory ~from =
549 let depth = Ls.length from - 1 in
550 match Ht.find_opt factory.cache depth with
551 | Some s -> s
552 | None ->
553 let new_one = html_menu ~from factory.source in
554 Ht.add factory.cache depth new_one;
555 new_one
1079689 @smondet Added support for the menu on the right pane
authored Sep 29, 2009
556 end
557
cd8c62a @smondet Started drafting an address book.
authored Oct 13, 2009
558 module Address_book = struct
03d28fb @smondet Dibrawi.Adbose: New format, and no more Camlp4.
authored Jan 16, 2010
559 (* When grown up, this Adbose module is expected to become a
560 * standalone library
561 * *)
562
563 module Adbose = struct
564 module Sx = Sexplib.Sexp
1b2c463 @smondet Dibrawi.Address_book: Code cleaning.
authored Jan 16, 2010
565
03d28fb @smondet Dibrawi.Adbose: New format, and no more Camlp4.
authored Jan 16, 2010
566 type field = string list
567 type kind = [ `person | `group | `organisation ]
568 type entry = kind * string * (field list)
1b2c463 @smondet Dibrawi.Address_book: Code cleaning.
authored Jan 16, 2010
569
03d28fb @smondet Dibrawi.Adbose: New format, and no more Camlp4.
authored Jan 16, 2010
570 type address_book = entry list
571 exception Parse_error of string
1b2c463 @smondet Dibrawi.Address_book: Code cleaning.
authored Jan 16, 2010
572
03d28fb @smondet Dibrawi.Adbose: New format, and no more Camlp4.
authored Jan 16, 2010
573 let address_book_of_string str =
574 let fail msg =
575 raise (Parse_error (sprintf "Address Book Syntax Error: %s" msg)) in
576 let parse_field =
577 function
578 | Sx.Atom s -> fail (sprintf "Unexpected atom: %s" s)
579 | Sx.List l as sx->
580 Ls.map l ~f:(function Sx.Atom s -> s
581 | _ ->
582 fail (sprintf "Expecting list of atoms: %s"
583 (Sx.to_string sx))) in
584 let kind_of_string =
585 function
586 | "person" -> `person
587 | "group" -> `group
588 | "organisation" -> `organisation
589 | s -> fail (sprintf "Unknown kind of entry: %s" s) in
590 let parse_entry =
591 function
592 | (Sx.Atom k) :: (Sx.Atom id) :: fields ->
593 (kind_of_string k, id, Ls.map parse_field fields)
594 | sx ->
595 fail (sprintf "Can't understand: %s" (Sx.to_string (Sx.List sx))) in
596 let sexp =
597 try Sx.of_string (sprintf "(%s)" str)
598 with Failure msg ->
599 raise (Parse_error (sprintf "Request Syntax Error (sexplib): %s" msg))
600 in
601 let fail_atom s = fail (sprintf "Unexpected atom: %s" s) in
602 match sexp with
603 | Sx.Atom s -> fail_atom s
604 | Sx.List l ->
605 Ls.map l
606 ~f:(function
607 | Sx.Atom s -> fail_atom s
608 | Sx.List l -> parse_entry l)
609
1b2c463 @smondet Dibrawi.Address_book: Code cleaning.
authored Jan 16, 2010
610 let get_one field_name (k, i, ff) =
611 Ls.find_opt ff ~f:(function
612 | fn :: _ when fn =$= field_name -> true
613 | _ -> false)
614 let get_all field_name (k, i, f) =
615 Ls.find_all f ~f:(function
616 | f :: _ when f =$= field_name -> true
617 | _ -> false)
5a1d13b @smondet Added support for .abs address books.
authored Oct 15, 2009
618
1b2c463 @smondet Dibrawi.Address_book: Code cleaning.
authored Jan 16, 2010
619 let sort_by_family ab =
620 Ls.sort ab
621 ~cmp:(fun e1 e2 ->
5a1d13b @smondet Added support for .abs address books.
authored Oct 15, 2009
622 match (get_one "name" e1), (get_one "name" e2) with
623 | Some [_; _; l1], Some [_; _; l2] -> Str.compare l1 l2
624 | Some [_; l1], Some [_; l2] -> Str.compare l1 l2
625 | Some [_; _; l1], Some [_; l2] -> Str.compare l1 l2
626 | Some [_; l1], Some [_; _; l2] -> Str.compare l1 l2
627 | _, Some [_; _; l2] -> -1
628 | _, Some [_; l2] -> -1
629 | Some [_; _; l1], _ -> 1
630 | Some [_; l1], _ -> 1
631 | _, _ -> 0)
cd8c62a @smondet Started drafting an address book.
authored Oct 13, 2009
632
1b2c463 @smondet Dibrawi.Address_book: Code cleaning.
authored Jan 16, 2010
633 end
634
635 let load str_list =
636 Adbose.address_book_of_string (Str.concat " " str_list)
637
638 let to_brtx abook =
639 let get_needed ((kind, id, fields) as entry) =
640 let kind_str =
641 match kind with
642 | `person -> "Person"
643 | `group -> "Group"
644 | `organisation -> "Organisation" in
645 let name_str =
646 match Adbose.get_one "name" entry with
647 | Some (_ :: f :: l :: _) -> sprintf "%s, %s" l f
648 | Some (_ :: f :: []) -> f
649 | _ -> "___NO__VALID_NAME___" in
650 (kind_str, id, name_str)
651 in
652 let header =
653 "{header|{title|Address Book}}\n\n" in
654 let sections =
655 let convert_std = function
656 | [_; n] -> (sprintf "{i|%s}" n)
657 | [_; t; n] -> (sprintf "{b|[%s]} {i|%s}" t n)
658 | _ -> "___NOT_A_VALID_STD_FIELD___" in
659 let convert_link = function
660 | [_; t] -> (sprintf "{link %s}" t)
661 | [_; t; n] -> (sprintf "{link %s|%s}" t n)
662 | [_; t; n; c] -> (sprintf "{link %s|%s} ({i|%s})" t n c)
663 | _ -> "___NOT_A_VALID_LINK_FIELD___" in
664 let if_something m f = match m with [] -> "" | l -> f l in
665 let get_if_one_or_more fild etri ~one ~more =
666 match Adbose.get_all fild etri with
667 [] -> "" | [x] -> one x | l -> more l
668 in
669 let make_list ?(plural=fun x -> x ^ "s")
670 field_name convert_entry entry_name entry =
671 get_if_one_or_more field_name entry
672 ~one:(fun x ->
673 sprintf "\n{b|%s:} %s{p}" entry_name (convert_entry x))
674 ~more:(fun l ->
675 let f = convert_entry in
676 (sprintf "\n{b|%s:}{list|\n{*} %s\n}{p}\n"
677 (plural entry_name)
678 (Str.concat "\n{*}" (Ls.map l ~f))))
679 in
5a1d13b @smondet Added support for .abs address books.
authored Oct 15, 2009
680
1b2c463 @smondet Dibrawi.Address_book: Code cleaning.
authored Jan 16, 2010
681 Ls.map (Adbose.sort_by_family abook)
682 ~f:(fun entry ->
683 let kstr, id, name = get_needed entry in
684 let birthday =
685 if_something (Adbose.get_all "birthday" entry)
686 (fun l ->
687 (sprintf "{b|Birthday}: %s{br}\n"
688 (Str.concat ", " (Ls.tl (Ls.hd l))))) in
689 let phones =
690 make_list "phone" convert_std "Phone number" entry in
691 let addresses =
692 let plural = fun x -> x ^ "es" in
693 make_list ~plural "address" convert_std "Address" entry in
694 let emails =
695 make_list "email" convert_std "E-Mail" entry in
696 let links =
697 make_list "link" convert_link "Link" entry in
698 let tags =
699 if_something (Adbose.get_all "tags" entry)
700 (fun l ->
701 (sprintf "{b|Tags}: %s{br}\n"
702 (Str.concat ", " (Ls.tl (Ls.hd l))))) in
703 let comments =
704 if_something (Adbose.get_all "comments" entry)
705 (fun l ->
706 (sprintf "{b|Comments}:{br}\n%s{br}\n"
707 (Str.concat "{br}\n" (Ls.tl (Ls.hd l))))) in
708
709 (sprintf "{section 1 %s|%s (%s)}%s%s%s%s%s%s%s"
710 id name kstr birthday phones addresses emails links
711 tags comments)) in
712 (header ^ (Str.concat "\n\n" sections))
5a1d13b @smondet Added support for .abs address books.
authored Oct 15, 2009
713
cd8c62a @smondet Started drafting an address book.
authored Oct 13, 2009
714
715 end
Something went wrong with that request. Please try again.