Skip to content
This repository

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
Newer
Older
100644 287 lines (249 sloc) 9.46 kb
a2562c67 »
2009-09-24 First import, build environment, directory tree.
1
2 open Dibrawi_std
3
e7b9fdd4 »
2009-09-24 lib: Started to implement the module Data_source.
4 module Info = struct
5 let version = 0
6 let version_string = sprintf p"The Dibrawi library, v %d" version
7 end
a2562c67 »
2009-09-24 First import, build environment, directory tree.
8
84086a43 »
2009-09-26 Fixes and improvements
9 module File_tree = struct
10
11 type file_tree_item =
12 | Dir of string * string * file_tree
13 | File of string * string
14 and
15 file_tree = file_tree_item list
16
17
18 let fold_tree
19 ?(dir=fun path name a -> a) ?(file=fun path name a -> ())
20 init tree = (
21 let rec parse current = function
22 | Dir (path, name, l) ->
23 let next = dir path name current in
24 Ls.iter (parse next) l
25 | File (path, name) ->
26 file path name current
27 in
28 Ls.iter (parse init) tree
29 )
30
31 let print_tree =
32 fold_tree
33 ~dir:(fun path name indent ->
9d3978e2 »
2009-09-27 First implementation of the URLs hook.
34 printf p"%s%s\n" (Str.make indent ' ') name;
84086a43 »
2009-09-26 Fixes and improvements
35 indent + 2)
36 ~file:(fun path name indent ->
9d3978e2 »
2009-09-27 First implementation of the URLs hook.
37 printf p"%s%s\n" (Str.make indent ' ') name;)
84086a43 »
2009-09-26 Fixes and improvements
38 0
39
40
41 let string_path_list
42 ?(filter="\\.brtx$") ?(exclude=".*\\.svn.*") ?(url_prefix="")
43 tree = (
44 let filt = Pcre.regexp filter in
45 let excl = Pcre.regexp exclude in
46 let paths = ref [] in
47 fold_tree
48 ~file:(fun p n () ->
49 let full = p ^ "/" ^ n in
50 if (pcre_matches filt full) && not (pcre_matches excl full)
51 then (paths := (url_prefix ^ full) :: !paths);) () tree;
52 Ls.rev !paths
53 )
54
55 (* Render a path compatible with Future.Path in batteries *)
56 let path_list
57 ?(filter="\\.brtx$") ?(exclude=".*\\.svn.*") ?(prefix=[])
58 tree = (
59 let filt = Pcre.regexp filter in
60 let excl = Pcre.regexp exclude in
61 let paths = ref [] in
62 (* let current = ref prefix in *)
63 fold_tree
64 ~dir:(fun p n c ->
65 Opt.bind (fun cc ->
66 if not (pcre_matches excl n) then Some (n :: cc) else None) c)
67 ~file:(fun p n c ->
68 Opt.may c ~f:(fun c ->
69 if (pcre_matches filt n)
70 then (paths := (n :: c) :: !paths);)
71 )
72 (Some prefix) tree;
73 Ls.rev !paths
74 )
75 end
e7b9fdd4 »
2009-09-24 lib: Started to implement the module Data_source.
76
77 module Data_source = struct
78 (* Future:
79 - get_page: path -> string
80 - is_valid_zipimg: path -> bool
81
82 *)
83
84
85
86 let get_file_tree ?(data_root="./data/") () = (
84086a43 »
2009-09-26 Fixes and improvements
87 open Shell, File_tree in
e7b9fdd4 »
2009-09-24 lib: Started to implement the module Data_source.
88 let ls dir =
9d3978e2 »
2009-09-27 First implementation of the URLs hook.
89 let sort a = Array.fast_sort Str.compare a; a in
e7b9fdd4 »
2009-09-24 lib: Started to implement the module Data_source.
90 Shell.readdir dir |> sort |> Array.to_list in
91 if is_directory data_root then (
92 let rec explore path name =
93 let next_path = path ^ "/" ^ name in
84086a43 »
2009-09-26 Fixes and improvements
94 let real_path = data_root ^ next_path in
95 if is_directory real_path then
96 Dir (path, name, Ls.map (explore next_path) (ls real_path))
e7b9fdd4 »
2009-09-24 lib: Started to implement the module Data_source.
97 else
98 File (path, name)
99 in
84086a43 »
2009-09-26 Fixes and improvements
100 Ls.map (explore ".") (ls data_root)
e7b9fdd4 »
2009-09-24 lib: Started to implement the module Data_source.
101 ) else (
102 invalid_arg (sprintf p"%s is not a directory" data_root)
103 )
104 )
105
106
107
108 end
109
110 module HTML_menu = struct
111
a00c0ab4 »
2009-09-25 Now Dibrawi is able to output a Bracetax menu.
112 open Data_source
84086a43 »
2009-09-26 Fixes and improvements
113 open File_tree
a00c0ab4 »
2009-09-25 Now Dibrawi is able to output a Bracetax menu.
114
115 let brtx_menu
84086a43 »
2009-09-26 Fixes and improvements
116 ?(url_prefix="")
a00c0ab4 »
2009-09-25 Now Dibrawi is able to output a Bracetax menu.
117 ?(filter="\\.brtx$") ?(exclude_dir=".*\\.svn.*")
118 ?(chop_filter=true) ?(replace=".html") tree = (
119 let buf = Buffer.create 1024 in
120 let filt = Pcre.regexp filter in
121 let excl = Pcre.regexp exclude_dir in
122 let rec to_brtx = function
123 | Dir (path, name, l) ->
124 (* eprintf p"path: %s, name: %s\n" path name; *)
84086a43 »
2009-09-26 Fixes and improvements
125 if not (pcre_matches excl name) then (
a00c0ab4 »
2009-09-25 Now Dibrawi is able to output a Bracetax menu.
126 Buffer.add_string buf
127 (sprintf p"{*} %s\n{begin list}\n" name);
128 Ls.iter ~f:to_brtx l;
129 Buffer.add_string buf (sprintf p"{end} # %s\n" name);
130 ) else (
131 Buffer.add_string buf (sprintf p"# ignore: %s %s\n" path name);
132 );
133 | File (path, name) ->
84086a43 »
2009-09-26 Fixes and improvements
134 if pcre_matches filt name then (
a00c0ab4 »
2009-09-25 Now Dibrawi is able to output a Bracetax menu.
135 let rex = filt in
136 let link =
137 path ^ "/" ^ (Pcre.replace ~rex ~templ:replace name) in
138 let official_name =
139 if chop_filter
140 then Pcre.replace ~rex ~templ:"" name
141 else name in
142 Buffer.add_string buf
84086a43 »
2009-09-26 Fixes and improvements
143 (sprintf p"{*} {link %s%s|%s}\n" url_prefix link official_name);
a00c0ab4 »
2009-09-25 Now Dibrawi is able to output a Bracetax menu.
144 );
145 in
146 Buffer.add_string buf (sprintf p"{begin list}\n");
147 Ls.iter to_brtx tree;
148 Buffer.add_string buf (sprintf p"{end} # Root\n");
149 Buffer.contents buf
150 )
151
152 let html_menu
84086a43 »
2009-09-26 Fixes and improvements
153 ?(url_prefix="")
a00c0ab4 »
2009-09-25 Now Dibrawi is able to output a Bracetax menu.
154 ?(filter="\\.brtx$") ?(exclude_dir=".*\\.svn.*")
155 ?(chop_filter=true) ?(replace=".html") tree = (
84086a43 »
2009-09-26 Fixes and improvements
156 let brtx =
157 brtx_menu
158 ~url_prefix ~filter ~exclude_dir ~replace ~chop_filter tree in
3701e2e2 »
2009-09-25 HTML_menu: Added built-in tranformation of the bracetax input.
159 let buf, err = Buffer.create 42, Buffer.create 42 in
160 let writer, input_char = Bracetax.Transform.string_io brtx buf err in
161 Bracetax.Transform.brtx_to_html
162 ~writer ~filename:"BRTX MENU" ~class_hook:"dibrawi_menu" ~input_char
163 ~deny_bypass:true ();
164 if Buffer.contents err <> "" then (
165 eprintf p"Errors in the bracetax: \n%s\n------------%s\n"
166 brtx (Buffer.contents err);
167 failwith "brtx ended with errors";
168 );
169 (Buffer.contents buf)
a00c0ab4 »
2009-09-25 Now Dibrawi is able to output a Bracetax menu.
170 )
e7b9fdd4 »
2009-09-24 lib: Started to implement the module Data_source.
171 end
84086a43 »
2009-09-26 Fixes and improvements
172
a3ce0b58 »
2009-09-27 Implemented the modules Todo_list and Preprocessor
173 module Todo_list = struct
174
175 type todo = [
176 | `pdf of string
177 | `tex of string
178 | `bibtex
179 ]
180 type t = todo list ref
181
182 let empty () = ref []
183
184 let to_string ?(sep="; ") tl =
185 String.concat sep (Ls.map !tl ~f:(function
186 | `pdf path -> sprintf p"Build PDF: %s" path
187 | `tex path -> sprintf p"Build TeX: %s" path
188 | `bibtex -> "Build the BibTeX"
189 ))
190
191 end
192
9d3978e2 »
2009-09-27 First implementation of the URLs hook.
193 module Special_paths = struct
194
195 let relativize from path = (
196 try match path.[0] with
197 | '/' ->
198 let depth = Ls.length from - 1 in
199 (Str.concat "/" (Ls.init depth ~f:(fun _ -> ".."))) ^ path
200 | '#' ->
201 (Ls.hd from) ^ path
202 | _ -> path
203 with _ -> (Ls.hd from) (* the string is empty*)
204 )
205 let typify url extension = (
206 match Str.rev_idx url '#', Str.rev_idx url '/' with
207 | Some h , None ->
208 (Str.head url h) ^ extension ^ (Str.tail url h)
209 | Some h, Some l when h > l ->
210 (Str.head url h) ^ extension ^ (Str.tail url h)
211 | _, _ ->
212 url ^ extension
213 )
214 let compute_path from url extension =
215 typify (relativize from url) extension
216
217 (* html_cite: string -> string *)
218 let default_html_cite id =
219 (* TODO manage id,id,id *)
220 sprintf p"page:/bibliography.html#%s" id
221
222 let rec rewrite_url
223 ?todo_list
224 ?(output=`html) ?(html_cite=default_html_cite) ~from url = (
225 (* let beg str = String.sub str 0 in *)
226 (* let after str n = String.sub str n (String.length str - n) in *)
227 match url with
228 | s when Str.length s < 4 -> s
229 | s when Str.head s 4 = "pdf:" ->
230 let pdfpath =
231 compute_path from (Str.tail s 4) ".pdf" in
232 Opt.may todo_list
233 ~f:(fun rl -> rl := (`compile_pdf pdfpath) :: !rl;);
234 pdfpath
235 | s when Str.head s 5 = "page:" ->
236 (compute_path from (Str.tail s 5) ".html")
237 | s when Str.head s 4 = "img:" ->
238 compute_path from (Str.tail s 4)
239 (match output with `html -> ".png" | `pdf -> ".pdf")
240 | s -> s
241 )
242
243 end
a3ce0b58 »
2009-09-27 Implemented the modules Todo_list and Preprocessor
244
245 module Preprocessor = struct
246
247 let prepro_regexp =
248 Pcre.regexp "(\\{cite [^\\}]*\\})|(\\{pdfinc [^\\}]*\\})"
249
250 let brtx2brtx
251 ?todo_list
252 ?(html_biblio_page="page:/bibliography.html") ?(output=`html) ~from brtx = (
253
254 Pcre.substitute ~rex:prepro_regexp brtx ~subst:(fun s ->
255 eprintf p"Got: %s\n" s;
256 Shell.catch_break true;
257 match s with
258 | cite when Str.head cite 6 = "{cite " ->
259 if output = `html then (
260 let cites =
261 (Str.nsplit (Str.sub s 6 (String.length s - 7)) ",") in
262 "[" ^ (Str.concat ","
263 (Ls.map cites ~f:(fun cite ->
264 sprintf p"{link %s#%s|%s}"
265 html_biblio_page cite cite))) ^ "]"
266 ) else (
267 Opt.may todo_list ~f:(fun tl -> tl := `bibtex :: !tl);
268 sprintf p"{bypass}\\cite{%s}{end}"
269 (Str.sub s 6 (String.length s - 7))
270 )
271 | pdfinc when Str.head pdfinc 8 = "{pdfinc " ->
272 let page_path = Str.sub s 8 (String.length s - 9) in
273 let path =
274 Special_paths.compute_path from page_path in
275 if output = `html then (
276 sprintf p"{t|{link %s}}" (path ".html")
277 ) else (
278 Opt.may todo_list
279 ~f:(fun tl -> tl := (`tex (path ".tex")) :: !tl);
280 sprintf p"{bypass}\\input{%s}{end}" (path ".tex")
281 )
282
283 | s -> s;
284 )
285 )
286 end
Something went wrong with that request. Please try again.