Skip to content
Browse files

* code_map/view_overlays.ml: start of tooltip/hovercard

  • Loading branch information...
1 parent 07114ba commit 6b0ecf54416ab1b43ec2c7e6a32dba73ca644e8f @aryx aryx committed Mar 4, 2014
Showing with 40 additions and 31 deletions.
  1. +1 −1 code_map/controller2.ml
  2. +2 −0 code_map/controller2.mli
  3. +33 −7 code_map/view_overlays.ml
  4. +4 −23 commons/gui.ml
View
2 code_map/controller2.ml
@@ -28,8 +28,8 @@ let current_rects_to_draw = ref []
let current_r = ref None
let paint_content_maybe_refresher = ref None
-
let current_motion_refresher = ref None
+let current_tooltip_refresher = ref None
let _go_back = ref (fun _w ->
failwith "_go_back not defined"
View
2 code_map/controller2.mli
@@ -22,6 +22,8 @@ val paint_content_maybe_refresher:
GMain.Idle.id option ref
val current_motion_refresher:
GMain.Idle.id option ref
+val current_tooltip_refresher:
+ GMain.Timeout.id option ref
val title_of_path: string -> string
View
40 code_map/view_overlays.ml
@@ -127,10 +127,11 @@ let draw_englobing_rectangles_overlay ~dw (r, middle, r_englobing) =
(* ---------------------------------------------------------------------- *)
(* Uses and users macrolevel *)
(* ---------------------------------------------------------------------- *)
-let draw_uses_users_files r dw model =
+let draw_deps_files r dw model =
with_overlay dw (fun cr_overlay ->
let file = r.T.tr_label in
let uses_rect, users_rect = M.deps_rects_of_file file dw model in
+ (* todo: glowing layer *)
uses_rect +> List.iter (fun r ->
CairoH.draw_rectangle_figure ~cr:cr_overlay ~color:"green" r.T.tr_rect;
);
@@ -142,6 +143,7 @@ let draw_uses_users_files r dw model =
(* ---------------------------------------------------------------------- *)
(* Uses and users microlevel *)
(* ---------------------------------------------------------------------- *)
+(* todo: better fisheye, with good background color *)
let draw_magnify_line_overlay_maybe ?honor_color dw line microlevel =
with_overlay dw (fun cr_overlay ->
let font_size = microlevel.layout.lfont_size in
@@ -150,10 +152,10 @@ let draw_magnify_line_overlay_maybe ?honor_color dw line microlevel =
(* todo: put in style *)
if font_size_real < 5.
then Draw_microlevel.draw_magnify_line
- ?honor_color cr_overlay line microlevel
+ ?honor_color cr_overlay line microlevel
)
-let draw_uses_users_entities n dw model =
+let draw_deps_entities n dw model =
with_overlay dw (fun cr_overlay ->
line_and_microlevel_of_node_opt n dw model
@@ -182,6 +184,14 @@ let draw_uses_users_entities n dw model =
)
(* ---------------------------------------------------------------------- *)
+(* Hovercard/tooltip current entity *)
+(* ---------------------------------------------------------------------- *)
+let draw_hovercard ~cr_overlay ~x ~y n _dw _model =
+ ignore(cr_overlay, x, y);
+ pr2 (spf "Draw_hovercard: %s" (Graph_code.string_of_node n));
+ ()
+
+(* ---------------------------------------------------------------------- *)
(* The selected rectangles *)
(* ---------------------------------------------------------------------- *)
@@ -263,15 +273,28 @@ let motion_refresher ev w =
);
draw_englobing_rectangles_overlay ~dw (tr, middle, r_englobing);
- draw_uses_users_files tr dw model;
+ draw_deps_files tr dw model;
entity_def_opt +> Common.do_option (fun n ->
- draw_uses_users_entities n dw model);
+ draw_deps_entities n dw model);
entity_use_opt +> Common.do_option (fun n ->
- draw_uses_users_entities n dw model);
+ draw_deps_entities n dw model);
if w.settings.draw_searched_rectangles;
then draw_searched_rectangles ~dw;
+
+ !Controller.current_tooltip_refresher
+ +>Common.do_option GMain.Timeout.remove;
+ Controller.current_tooltip_refresher :=
+ Some (Gui.gmain_timeout_add ~ms:2000 ~callback:(fun _ ->
+ (match entity_def_opt, entity_use_opt with
+ | Some node, _ | _, Some node ->
+ draw_hovercard ~cr_overlay ~x ~y node dw model
+ | _ -> ()
+ );
+ true
+ ));
+
Controller.current_r := Some tr;
);
@@ -280,10 +303,13 @@ let motion_refresher ev w =
let motion_notify w ev =
- !Controller.current_motion_refresher +> Common.do_option GMain.Idle.remove;
let x, y = GdkEvent.Motion.x ev, GdkEvent.Motion.y ev in
pr2 (spf "motion: %f, %f" x y);
+ (* The motion code now takes time, so it's better do run it when the user
+ * has finished moving his mouse, hence the use of gmain_idle_add below.
+ *)
+ !Controller.current_motion_refresher +> Common.do_option GMain.Idle.remove;
Controller.current_motion_refresher :=
Some (Gui.gmain_idle_add ~prio:200 (fun () -> motion_refresher ev w));
true
View
27 commons/gui.ml
@@ -18,16 +18,11 @@ open Common
(* Prelude *)
(*****************************************************************************)
(*
- * old:
- * This file was named gCommon.ml to be coherent with the other lalbgtk files.
+ * A few convenient wrappers around ocamlgtk.
+ * old: was named gCommon.ml to be coherent with the other lalbgtk files.
+ *
+ * Example of overall organisation to follow:
*
- *)
-
-(*****************************************************************************)
-(* Example of overall organisation to follow: *)
-(*****************************************************************************)
-
-(* Overall layout organisation:
* - menu (File, Edit, View, X, Help)
* - toolbar
* - mainview
@@ -65,10 +60,6 @@ open Common
* just the gui specific stuff.
*)
-(*###########################################################################*)
-(* *)
-(*###########################################################################*)
-
(*****************************************************************************)
(* Widgets composition *)
(*****************************************************************************)
@@ -169,7 +160,6 @@ let mk_menu menu_item f =
f menu;
menu_item
-(*---------------------------------------------------------------------------*)
(* Functions to have even more concise style. Can then write
* w +> GCommon.add (GMenu.toolbar) (fun tb -> ...
@@ -195,7 +185,6 @@ let add_menu menu_item f w =
f menu;
w#add menu_item
-(*---------------------------------------------------------------------------*)
let rec paneds orientation xs =
match xs with
| [] | [_] -> failwith "paneds: need at least 2 elements"
@@ -322,10 +311,6 @@ let entry_with_completion_eff ~text ~model_col ?minimum_key_length () =
c#set_text_column col;
entry
-(*###########################################################################*)
-(* Special bigger widgets *)
-(*###########################################################################*)
-
(*****************************************************************************)
(* CList widget Helpers *)
(*****************************************************************************)
@@ -420,10 +405,6 @@ let view_expand_level (view: GTree.view) depth_limit =
(* todo? gHTML ? gtk_xmhtml ? but apparently only for gtk1.2 :( *)
-(*###########################################################################*)
-(* *)
-(*###########################################################################*)
-
(*****************************************************************************)
(* Menu *)
(*****************************************************************************)

0 comments on commit 6b0ecf5

Please sign in to comment.
Something went wrong with that request. Please try again.