Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
Newer
Older
100644 414 lines (366 sloc) 12.569 kb
387c73d visual: syncweb
pad authored
1 (*s: main_codemap.ml *)
8634b74 initial import into fresh git repo.
pad authored
2 (*
3 * Please imagine a long and boring gnu-style copyright notice
4 * appearing just here.
5 *)
6 open Common
7
8 module Flag = Flag_visual
c9879d4 @aryx * commons/file_type.ml: Opa
aryx authored
9 module FT = File_type
8634b74 initial import into fresh git repo.
pad authored
10
11 (*****************************************************************************)
12 (* Prelude *)
13 (*****************************************************************************)
83943cd visual: layers_with_index type and integration in model2.ml
pad authored
14 (*
6dea9bd rename pfff_visual in CodeMap and worked on the toc of the codemap manua...
pad authored
15 * Main entry point of codemap.
8107735 @aryx * main_codemap.ml:
aryx authored
16 *
17 * history:
fea6a42 @aryx * main_codemap.ml:
aryx authored
18 * - talked about mixing sgrep/spatch with code visualization,
19 * highlighting with a certain color different architecture aspect
20 * of the linux kernel (influenced by work on aspect browser)
8107735 @aryx * main_codemap.ml:
aryx authored
21 * - talked about fancy code visualizer while at cleanmake with YY,
22 * spiros, etc.
fea6a42 @aryx * main_codemap.ml:
aryx authored
23 * - saw SeeSoft code visualizer
24 * - code thumbnails by MSR
25 * - saw treemap of Linux kernel by fekete? idea of mixing
26 * tree-map + code-thumbnails
83943cd visual: layers_with_index type and integration in model2.ml
pad authored
27 *)
8634b74 initial import into fresh git repo.
pad authored
28
29 (*****************************************************************************)
30 (* Flags *)
31 (*****************************************************************************)
32
2c597ba moving code from view2.ml to main_visual.ml
pad authored
33 (*s: main flags *)
8634b74 initial import into fresh git repo.
pad authored
34 let screen_size = ref 2
ecd4236 @aryx * main_codemap.ml: -no_legend
aryx authored
35 let legend = ref true
83943cd visual: layers_with_index type and integration in model2.ml
pad authored
36
8107735 @aryx * main_codemap.ml:
aryx authored
37 let db_file = ref (None: Common.filename option)
83943cd visual: layers_with_index type and integration in model2.ml
pad authored
38 let layer_file = ref (None: Common.filename option)
8107735 @aryx * main_codemap.ml:
aryx authored
39 let layer_dir = ref (None: Common.dirname option)
053d8ce visual: adding a -ocaml_filter
pad authored
40
83943cd visual: layers_with_index type and integration in model2.ml
pad authored
41 (* See also Gui.synchronous_actions *)
42 let test_mode = ref (None: string option)
43 let proto = ref false
2c597ba moving code from view2.ml to main_visual.ml
pad authored
44 (*e: main flags *)
8634b74 initial import into fresh git repo.
pad authored
45
83943cd visual: layers_with_index type and integration in model2.ml
pad authored
46 (* todo? config file ?
47 * GtkMain.Rc.add_default_file "/home/pad/c-pfff/data/pfff_browser.rc";
48 *)
49
f7748eb @aryx * main_codemap.ml: factorize filters
aryx authored
50 let filter = ref Treemap_pl.ex_filter_file
51
52 let filters = [
53 "ocaml", Treemap_pl.ocaml_filter_file;
54 "mli", Treemap_pl.ocaml_mli_filter_file;
55 "php", Treemap_pl.php_filter_file;
56 "nw", (fun file ->
c9879d4 @aryx * commons/file_type.ml: Opa
aryx authored
57 match FT.file_type_of_file file with
58 | FT.Text "nw" -> true | _ -> false
f7748eb @aryx * main_codemap.ml: factorize filters
aryx authored
59 );
60 "pfff", (fun file ->
c9879d4 @aryx * commons/file_type.ml: Opa
aryx authored
61 match FT.file_type_of_file file with
889db0f @aryx * main_codemap.ml: filter pfff now show PHP and Prolog
aryx authored
62 | FT.PL (
63 (FT.ML _) | FT.Makefile | FT.Opa | FT.Prolog _ | FT.Web (FT.Php _))
64 ->
f7748eb @aryx * main_codemap.ml: factorize filters
aryx authored
65 (* todo: should be done in file_type_of_file *)
c9879d4 @aryx * commons/file_type.ml: Opa
aryx authored
66 not (FT.is_syncweb_obj_file file)
674ac61 @aryx misc
aryx authored
67 && not (file =~ ".*commons/" ||
68 file =~ ".*external/" ||
889db0f @aryx * main_codemap.ml: filter pfff now show PHP and Prolog
aryx authored
69 file =~ ".*_build/")
f7748eb @aryx * main_codemap.ml: factorize filters
aryx authored
70 | _ -> false
71 );
c9879d4 @aryx * commons/file_type.ml: Opa
aryx authored
72 "cpp", (let x = ref false in (fun file ->
f7748eb @aryx * main_codemap.ml: factorize filters
aryx authored
73 Common.once x (fun () -> Parse_cpp.init_defs !Flag_parsing_cpp.macros_h);
c9879d4 @aryx * commons/file_type.ml: Opa
aryx authored
74 match FT.file_type_of_file file with
75 | FT.PL (FT.C _ | FT.Cplusplus _) -> true
76 | _ -> false
77 ));
78 "opa", (fun file ->
79 match FT.file_type_of_file file with
d954858 @aryx * visual/draw_microlevel.ml: handling OPA code
aryx authored
80 | FT.PL (FT.Opa) (* | FT.PL (FT.ML _) *) -> true
77fab59 @aryx * visual/parsing2.ml: js error recovery
aryx authored
81 (* | FT.PL (FT.Web (_)) -> true *)
f7748eb @aryx * main_codemap.ml: factorize filters
aryx authored
82 | _ -> false
83 );
84 ]
85
8634b74 initial import into fresh git repo.
pad authored
86 (* action mode *)
87 let action = ref ""
88
89 (*****************************************************************************)
2c597ba moving code from view2.ml to main_visual.ml
pad authored
90 (* Helpers *)
91 (*****************************************************************************)
92
83943cd visual: layers_with_index type and integration in model2.ml
pad authored
93 let set_gc () =
94 if !Flag.debug_gc
95 then Gc.set { (Gc.get()) with Gc.verbose = 0x01F };
96 (* see http://www.elehack.net/michael/blog/2010/06/ocaml-memory-tuning *)
97 Gc.set { (Gc.get()) with Gc.minor_heap_size = 2_000_000 };
98 Gc.set { (Gc.get()) with Gc.space_overhead = 200 };
99 ()
100
101 (*****************************************************************************)
102 (* Model helpers *)
103 (*****************************************************************************)
104
2c597ba moving code from view2.ml to main_visual.ml
pad authored
105 (*s: treemap_generator *)
106 let treemap_generator paths =
053d8ce visual: adding a -ocaml_filter
pad authored
107 let treemap = Treemap_pl.code_treemap ~filter_file:!filter paths in
2c597ba moving code from view2.ml to main_visual.ml
pad authored
108 let algo = Treemap.Ordered Treemap.PivotByMiddle in
ca5f0a3 pfff_visual: adding a -bl that boost label size and alpha. Useful
pad authored
109 let rects = Treemap.render_treemap_algo
110 ~algo ~big_borders:!Flag.boost_label_size
111 treemap in
2c597ba moving code from view2.ml to main_visual.ml
pad authored
112 Common.pr2 (spf "%d rectangles to draw" (List.length rects));
113 rects
114 (*e: treemap_generator *)
115
116 (*s: build_model *)
117 let build_model2 root dbfile_opt =
118 let db_opt = dbfile_opt +> Common.fmap (fun file ->
119 if file =~ ".*.json"
120 then Database_code.load_database file
121 else Common.get_value file
122 )
123 in
124 let hentities = Model2.hentities root db_opt in
125 let hfiles_entities = Model2.hfiles_and_top_entities root db_opt in
aa2c85d visual: provide file/dir completion even if does not have a light db
pad authored
126 let all_entities = Model2.all_entities db_opt root in
2c597ba moving code from view2.ml to main_visual.ml
pad authored
127 let idx = Completion2.build_completion_defs_index all_entities in
128
129 let model = { Model2.
130 db = db_opt;
131 hentities = hentities;
132 hfiles_entities = hfiles_entities;
133 big_grep_idx = idx;
134 }
135 in
136 (*
137 let model = Ancient2.mark model in
138 Gc.compact ();
139 *)
140 (*
141 (* sanity check *)
142 let hentities = (Ancient2.follow model).Model2.hentities in
143 let n = Hashtbl.length hentities in
144 pr2 (spf "before = %d" n);
145 let cnt = ref 0 in
146 Hashtbl.iter (fun k v -> pr2 k; incr cnt) hentities;
147 pr2 (spf "after = %d" !cnt);
148 (* let _x = Hashtbl.find hentities "kill" in *)
149 *)
150 model
151
152 let build_model a b =
153 Common.profile_code2 "View.build_model" (fun () ->
154 build_model2 a b)
155 (*e: build_model *)
156
a83661d @aryx codemap: added -with_layers flag
aryx authored
157 (* could also try to parse all json files and filter the one which do
158 * not parse *)
159 let layers_in_dir dir =
160 Common.readdir_to_file_list dir +> Common.map_filter (fun file ->
08a3d95 @aryx codemap: display list of layers
aryx authored
161 if file =~ "layer.*marshall"
a83661d @aryx codemap: added -with_layers flag
aryx authored
162 then Some (Filename.concat dir file)
163 else None
164 )
165
2c597ba moving code from view2.ml to main_visual.ml
pad authored
166 (*****************************************************************************)
8634b74 initial import into fresh git repo.
pad authored
167 (* Main action *)
168 (*****************************************************************************)
169
2c597ba moving code from view2.ml to main_visual.ml
pad authored
170 (*s: main_action() *)
8634b74 initial import into fresh git repo.
pad authored
171 let main_action xs =
83943cd visual: layers_with_index type and integration in model2.ml
pad authored
172 set_gc ();
92da018 @aryx use new logger
aryx authored
173 Logger.log Config.logger "codemap" None;
8634b74 initial import into fresh git repo.
pad authored
174
4de5fa1 visual: layer highlighting at micro level !!
pad authored
175 let root = Common.common_prefix_of_files_or_dirs xs in
176 pr2 (spf "Using root = %s" root);
177
68c2a71 visual: splitted draw2.ml in many files.
pad authored
178 let model = Async.async_make () in
4de5fa1 visual: layer highlighting at micro level !!
pad authored
179
83943cd visual: layers_with_index type and integration in model2.ml
pad authored
180 let layers =
a83661d @aryx codemap: added -with_layers flag
aryx authored
181 match !layer_file, !layer_dir, xs with
182 | Some file, _, _ ->
183 [Layer_code.load_layer file]
184 | None, Some dir, _
185 | None, None, [dir] ->
186 layers_in_dir dir +> List.map Layer_code.load_layer
187 | _ -> []
83943cd visual: layers_with_index type and integration in model2.ml
pad authored
188 in
9bd5f77 @aryx * main_codemap.ml: estet
aryx authored
189 let layers_with_index =
190 Layer_code.build_index_of_layers ~root
a83661d @aryx codemap: added -with_layers flag
aryx authored
191 (match layers with
9bd5f77 @aryx * main_codemap.ml: estet
aryx authored
192 (* not active by default ? it causes some problems *)
193 | [layer] -> [layer, false]
194 | _ -> layers +> List.map (fun x -> x, false)
a83661d @aryx codemap: added -with_layers flag
aryx authored
195 )
4de5fa1 visual: layer highlighting at micro level !!
pad authored
196 in
2c597ba moving code from view2.ml to main_visual.ml
pad authored
197
9bd5f77 @aryx * main_codemap.ml: estet
aryx authored
198 let dw = Model2.init_drawing treemap_generator model layers_with_index xs in
2c597ba moving code from view2.ml to main_visual.ml
pad authored
199
8634b74 initial import into fresh git repo.
pad authored
200 (* the GMain.Main.init () is done by linking with gtkInit.cmo *)
201 pr2 (spf "Using Cairo version: %s" Cairo.compile_time_version_string);
706ed62 create db_light file PFFF_DB.db in the software directory.
pad authored
202 let db_file =
08a3d95 @aryx codemap: display list of layers
aryx authored
203 (* todo: do as for layers, put this logic of marshall vs json elsewhere *)
706ed62 create db_light file PFFF_DB.db in the software directory.
pad authored
204 match !db_file, xs with
205 | None, [dir] ->
206 let db = Filename.concat dir Database_code.default_db_name in
207 if Sys.file_exists db
208 then begin
209 pr2 (spf "Using pfff light db: %s" db);
210 Some db
211 end
5c15dfd main_visual: use json db_light file if present
pad authored
212 else
213 let db = Filename.concat dir Database_code.default_db_name ^ ".json" in
214 if Sys.file_exists db
215 then begin
216 pr2 (spf "Using pfff light db: %s" db);
217 Some db
218 end
219 else
220 !db_file
706ed62 create db_light file PFFF_DB.db in the software directory.
pad authored
221 | _ -> !db_file
222 in
8634b74 initial import into fresh git repo.
pad authored
223
2c597ba moving code from view2.ml to main_visual.ml
pad authored
224
225 (* This can require lots of stack. Make sure to have ulimit -s 40000.
226 * This thread also cause some Bus error on MacOS :(
227 * so have to use Timeout instead when on the Mac
228 *)
229 (if Cairo_helpers.is_old_cairo()
230 then
231 Thread.create (fun () ->
68c2a71 visual: splitted draw2.ml in many files.
pad authored
232 Async.async_set (build_model root db_file) model;
2c597ba moving code from view2.ml to main_visual.ml
pad authored
233 ) ()
234 +> ignore
235 else
68c2a71 visual: splitted draw2.ml in many files.
pad authored
236 Async.async_set (build_model root db_file) model;
2c597ba moving code from view2.ml to main_visual.ml
pad authored
237 (*
238 GMain.Timeout.add ~ms:2000 ~callback:(fun () ->
239 Model2.async_set (build_model root dbfile_opt) model;
240 false
241 ) +> ignore
242 *)
243 );
244
8634b74 initial import into fresh git repo.
pad authored
245 Common.finalize (fun () ->
246 View2.mk_gui
ecd4236 @aryx * main_codemap.ml: -no_legend
aryx authored
247 ~screen_size:!screen_size
248 ~legend:!legend
8634b74 initial import into fresh git repo.
pad authored
249 !test_mode
c2f2857 move a little more code to main_visual.ml
pad authored
250 (root, model, dw, db_file)
8634b74 initial import into fresh git repo.
pad authored
251 ) (fun() ->
252 ()
253 )
2c597ba moving code from view2.ml to main_visual.ml
pad authored
254 (*e: main_action() *)
8634b74 initial import into fresh git repo.
pad authored
255
256 (*****************************************************************************)
257 (* Extra actions *)
258 (*****************************************************************************)
259
2c597ba moving code from view2.ml to main_visual.ml
pad authored
260 (*s: visual_commitid() action *)
8634b74 initial import into fresh git repo.
pad authored
261 let visual_commitid id =
262 let files = Common.cmd_to_list
263 (spf "git show --pretty=\"format:\" --name-only %s"
264 id)
265 (* not sure why git adds an extra empty line at the beginning but we
266 * have to filter it
267 *)
268 +> Common.exclude Common.null_string
269 in
270 pr2_gen files;
271 main_action files
2c597ba moving code from view2.ml to main_visual.ml
pad authored
272 (*e: visual_commitid() action *)
8634b74 initial import into fresh git repo.
pad authored
273
274 (*---------------------------------------------------------------------------*)
275 (* the command line flags *)
276 (*---------------------------------------------------------------------------*)
277 let extra_actions () = [
2c597ba moving code from view2.ml to main_visual.ml
pad authored
278 (*s: actions *)
279 "-commitid", " <id>",
280 Common.mk_action_1_arg (visual_commitid);
281 (*e: actions *)
8634b74 initial import into fresh git repo.
pad authored
282 ]
283
284 (*****************************************************************************)
285 (* The options *)
286 (*****************************************************************************)
287
83943cd visual: layers_with_index type and integration in model2.ml
pad authored
288 (* update: try to put ocamlgtk related tests in widgets/test_widgets.ml, not
289 * here. Here it's for ... well it's for nothing I think because it's not
290 * really easy to test a gui.
8634b74 initial import into fresh git repo.
pad authored
291 *)
292 let all_actions () =
293 extra_actions()++
294 []
295
296 let options () = [
2c597ba moving code from view2.ml to main_visual.ml
pad authored
297 (*s: options *)
298 "-screen_size" , Arg.Set_int screen_size,
f7748eb @aryx * main_codemap.ml: factorize filters
aryx authored
299 " <int> (1 = small, 2 = big)";
2c597ba moving code from view2.ml to main_visual.ml
pad authored
300 "-ss" , Arg.Set_int screen_size,
301 " alias for -screen_size";
302 "-ft", Arg.Set_float Flag.threshold_draw_content_font_size_real,
303 " ";
ca5f0a3 pfff_visual: adding a -bl that boost label size and alpha. Useful
pad authored
304 "-boost_lbl" , Arg.Set Flag.boost_label_size,
305 " ";
f7748eb @aryx * main_codemap.ml: factorize filters
aryx authored
306 "-no_boost_lbl" , Arg.Clear Flag.boost_label_size,
ca5f0a3 pfff_visual: adding a -bl that boost label size and alpha. Useful
pad authored
307 " ";
ecd4236 @aryx * main_codemap.ml: -no_legend
aryx authored
308 "-no_legend" , Arg.Clear legend,
309 " ";
2c597ba moving code from view2.ml to main_visual.ml
pad authored
310
71ecb02 @aryx code overlay prototype. Also added codemap -symlinks
aryx authored
311 "-symlinks", Arg.Unit (fun () ->
312 Treemap.follow_symlinks := true;
313 ),
314 " ";
315 "-no_symlinks", Arg.Unit (fun () ->
316 Treemap.follow_symlinks := false;
317 ),
318 " ";
83943cd visual: layers_with_index type and integration in model2.ml
pad authored
319
2c597ba moving code from view2.ml to main_visual.ml
pad authored
320 "-with_info", Arg.String (fun s -> db_file := Some s),
83943cd visual: layers_with_index type and integration in model2.ml
pad authored
321 " <db_light_file>";
322 "-with_layer", Arg.String (fun s -> layer_file := Some s),
323 " <layer_file>";
a83661d @aryx codemap: added -with_layers flag
aryx authored
324 "-with_layers", Arg.String (fun s -> layer_dir := Some s),
325 " <layer_dir>";
2c597ba moving code from view2.ml to main_visual.ml
pad authored
326
327 "-test" , Arg.String (fun s -> test_mode := Some s),
328 " <str> execute an internal script";
329 "-proto" , Arg.Set proto,
330 " ";
331
f7748eb @aryx * main_codemap.ml: factorize filters
aryx authored
332 "-filter", Arg.String (fun s -> filter := List.assoc s filters;),
333 spf " filter certain files (available = %s)"
334 (filters +> List.map fst +> Common.join ", ");
d0e5f4d @aryx * main_codemap.ml: comment
aryx authored
335
f7748eb @aryx * main_codemap.ml: factorize filters
aryx authored
336 "-extra_filter", Arg.String (fun s -> Flag.extra_filter := Some s),
94caea7 @aryx lang_c++: many stuff, passing template args, passing qualifiers, etc
aryx authored
337 " ";
2c597ba moving code from view2.ml to main_visual.ml
pad authored
338 "-verbose" , Arg.Set Flag.verbose_visual,
339 " ";
340 "-debug_gc", Arg.Set Flag.debug_gc,
341 " ";
342 "-debug_handlers", Arg.Set Gui.synchronous_actions,
343 " ";
2f269f8 * visual/: copyright (via syncweb)
Yoann Padioleau authored
344 (*
f7748eb @aryx * main_codemap.ml: factorize filters
aryx authored
345 "-disable_ancient", Arg.Clear Flag.use_ancient,
2c597ba moving code from view2.ml to main_visual.ml
pad authored
346 " ";
f7748eb @aryx * main_codemap.ml: factorize filters
aryx authored
347 "-enable_ancient", Arg.Set Flag.use_ancient,
2c597ba moving code from view2.ml to main_visual.ml
pad authored
348 " ";
2f269f8 * visual/: copyright (via syncweb)
Yoann Padioleau authored
349 *)
f7748eb @aryx * main_codemap.ml: factorize filters
aryx authored
350 "-disable_fonts", Arg.Set Flag.disable_fonts,
2c597ba moving code from view2.ml to main_visual.ml
pad authored
351 " ";
352 (*e: options *)
8634b74 initial import into fresh git repo.
pad authored
353 ] ++
354 Common.options_of_actions action (all_actions()) ++
f7748eb @aryx * main_codemap.ml: factorize filters
aryx authored
355 (*
8634b74 initial import into fresh git repo.
pad authored
356 Flag_analyze_php.cmdline_flags_verbose () ++
6a6af0a @aryx * main_codemap.ml: take now also a -macros argument
aryx authored
357 Flag_parsing_cpp.cmdline_flags_macrofile () ++
f7748eb @aryx * main_codemap.ml: factorize filters
aryx authored
358 *)
8634b74 initial import into fresh git repo.
pad authored
359 Common.cmdline_flags_devel () ++
360 Common.cmdline_flags_verbose () ++
361 [
362 "-version", Arg.Unit (fun () ->
6dea9bd rename pfff_visual in CodeMap and worked on the toc of the codemap manua...
pad authored
363 pr2 (spf "CodeMap version: %s" Config.version);
8634b74 initial import into fresh git repo.
pad authored
364 exit 0;
365 ),
366 " guess what";
367 ]
368
369 (*****************************************************************************)
370 (* The main entry point *)
371 (*****************************************************************************)
372 let main () =
373 Common_extra.set_link ();
374
375 let usage_msg =
9f4fc26 @aryx add link to github wiki page for sgrep, spatch, and codemap
aryx authored
376 spf "Usage: %s [options] <file or dir> \nDoc: %s\nOptions:"
377 (Common.basename Sys.argv.(0))
378 "https://github.com/facebook/pfff/wiki/Codemap"
8634b74 initial import into fresh git repo.
pad authored
379 in
380 let args = Common.parse_options (options()) usage_msg Sys.argv in
381
382 (* must be done after Arg.parse, because Common.profile is set by it *)
383 Common.profile_code "Main total" (fun () ->
384
385 (match args with
386 (* --------------------------------------------------------- *)
387 (* actions, useful to debug subpart *)
388 (* --------------------------------------------------------- *)
389 | xs when List.mem !action (Common.action_list (all_actions())) ->
390 Common.do_action !action xs (all_actions())
391
392 | _ when not (Common.null_string !action) ->
393 failwith ("unrecognized action or wrong params: " ^ !action)
394
395 (* --------------------------------------------------------- *)
396 (* main entry *)
397 (* --------------------------------------------------------- *)
398 | (x::xs) ->
399 main_action (x::xs)
400
401 (* --------------------------------------------------------- *)
402 (* empty entry *)
403 (* --------------------------------------------------------- *)
404 | _ -> Arg.usage (Arg.align (options())) usage_msg;
405 );
406 )
407
408 (*****************************************************************************)
409 let _ =
9bd5f77 @aryx * main_codemap.ml: estet
aryx authored
410 Common.main_boilerplate (fun () ->
411 main ()
412 )
387c73d visual: syncweb
pad authored
413 (*e: main_codemap.ml *)
Something went wrong with that request. Please try again.