← Back to branch summary

~ubuntu-branches/debian/sid/frama-c/sid

« back to all changes in this revision

Viewing changes to src/syntactic_callgraph/cg_viewer.ml

  • Committer: Bazaar Package Importer
  • Author(s): Mehdi Dogguy
  • Date: 2009-06-03 08:19:25 UTC
  • Revision ID: james.westby@ubuntu.com-20090603081925-kihvxvt0wy3zc4ar
Tags: upstream-20081201.dfsg
Import upstream version 20081201.dfsg

Show diffs side-by-side

added added

removed removed

Lines of Context:
src/syntactic_callgraph/cg_viewer.ml
 
1
(**************************************************************************)
 
2
(*                                                                        *)
 
3
(*  This file is part of Frama-C.                                         *)
 
4
(*                                                                        *)
 
5
(*  Copyright (C) 2007-2008                                               *)
 
6
(*    CEA (Commissariat � l'�nergie Atomique)                             *)
 
7
(*                                                                        *)
 
8
(*  you can redistribute it and/or modify it under the terms of the GNU   *)
 
9
(*  Lesser General Public License as published by the Free Software       *)
 
10
(*  Foundation, version 2.1.                                              *)
 
11
(*                                                                        *)
 
12
(*  It 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 Lesser General Public License for more details.                   *)
 
16
(*                                                                        *)
 
17
(*  See the GNU Lesser General Public License version 2.1                 *)
 
18
(*  for more details (enclosed in the file licenses/LGPLv2.1).            *)
 
19
(*                                                                        *)
 
20
(**************************************************************************)
 
21
 
 
22
let create_scrolled_canvas packing =
 
23
  let frame = GBin.frame ~shadow_type:`IN () in
 
24
  let canvas =
 
25
    let aa = false (* anti-aliasing *) in
 
26
    GnoCanvas.canvas ~aa ~width:600 ~height:400 ~packing:frame#add ()
 
27
  in
 
28
  let _ = canvas#set_center_scroll_region true in
 
29
         (* if the graph is too big, show its center *)
 
30
  let table = GPack.table ~packing
 
31
                ~rows:2 ~columns:2 ~row_spacings:4 ~col_spacings:4 () in
 
32
  let _ = table#attach ~left:0 ~right:1 ~top:0 ~bottom:1
 
33
            ~expand:`BOTH ~fill:`BOTH ~shrink:`BOTH ~xpadding:0 ~ypadding:0
 
34
            frame#coerce in
 
35
  let w = GRange.scrollbar `HORIZONTAL ~adjustment:canvas#hadjustment ()  in
 
36
  let _ = table#attach ~left:0 ~right:1 ~top:1 ~bottom:2
 
37
            ~expand:`X ~fill:`BOTH ~shrink:`X ~xpadding:0 ~ypadding:0
 
38
            w#coerce  in
 
39
  let w = GRange.scrollbar `VERTICAL ~adjustment:canvas#vadjustment ()  in
 
40
  let _ = table#attach ~left:1 ~right:2 ~top:0 ~bottom:1
 
41
            ~expand:`Y ~fill:`BOTH ~shrink:`Y ~xpadding:0 ~ypadding:0
 
42
            w#coerce  in
 
43
    canvas
 
44
 
 
45
let create_graph_win () =
 
46
  let window = GWindow.window ~title:"Call Graph"
 
47
                 ~allow_shrink:true  ~allow_grow:true ()  in
 
48
  let vbox = GPack.vbox ~border_width:4 ~spacing:4 ~packing:window#add () in
 
49
  let help_but = GButton.button ~label:"Help" 
 
50
                   ~packing:(vbox#pack ~expand:false ~fill:true) () in
 
51
  let _ = help_but#connect#clicked ~callback:ViewGraph_select.show_help in
 
52
  let canvas = create_scrolled_canvas (vbox#pack ~expand:true ~fill:true) in
 
53
  let hbox = GPack.hbox ~spacing:4 ~packing:vbox#pack () in
 
54
  let select_init_env =
 
55
    ViewGraph_select.init ViewGraph_select.default_options
 
56
      canvas (hbox#pack ~expand:true ~fill:true) in
 
57
    window#show ();
 
58
    select_init_env
 
59
      
 
60
module Cb = struct
 
61
  type t_env = unit
 
62
  let button_one_press_on_graph _env = ()
 
63
  let button_two_press_on_graph _env = ()
 
64
  let button_three_press_on_graph _env = ()
 
65
  let button_one_press_on_node _env _n = () 
 
66
      (* TODO : show fct in source viewer ? *)
 
67
  let button_two_press_on_node _env _n = ()
 
68
      (* TODO : show calls in source viewer ? *)
 
69
  let button_three_press_on_node _env _n = ()
 
70
  let enter_node _env _n = ()
 
71
  let leave_node _env _n = ()
 
72
end
 
73
 
 
74
module V = ViewGraph_select.VG (Cb)
 
75
 
 
76
let show_cg_cb _a = 
 
77
  let cg_name = Cmdline.CallgraphFilename.get () in
 
78
  let cg_name = 
 
79
    if cg_name <> "" then cg_name
 
80
    else Filename.temp_file "framaC_cg_" ".dot"
 
81
  in Cmdline.CallgraphFilename.set cg_name;
 
82
 
 
83
  let select_init_env = create_graph_win () in
 
84
    Format.printf "[call graph] preparing the file %s " cg_name;
 
85
    !Db.Syntactic_callgraph.dump ();
 
86
    Format.printf "done.";
 
87
  try
 
88
    let env = () in
 
89
    let _graph = V.open_dot_file env select_init_env cg_name in
 
90
      ()
 
91
  with ViewGraph.DotError _ ->
 
92
    GToolbox.message_box "Error"
 
93
      (Printf.sprintf "Didn't succed to build graph for %s\nSorry !" cg_name)
 
94
 
 
95
let main window =
 
96
  GAction.add_actions window#actions 
 
97
    [GAction.add_action "CallGraph" ~label:"_Show Call Graph" ~callback:show_cg_cb];
 
98
    window#ui_manager#add_ui_from_string
 
99
      "<ui><menubar name='MenuBar'> 
 
100
              <menu action='ViewMenu'>
 
101
                 <menuitem action='CallGraph'/> 
 
102
              </menu>
 
103
           </menubar>
 
104
       </ui>";
 
105
    Format.printf "View added";
 
106
  ()
 
107
 
 
108
let () = Design.register_extension main
 
109
 
 
110
(*
 
111
Local Variables:
 
112
compile-command: "LC_ALL=C make -C ../.."
 
113
End:
 
114
*)
 
115