X-Git-Url: http://git.annexia.org/?a=blobdiff_plain;f=rpmdepsize.ml;h=f48c0ef9e0c05c9db2e365d8eaeef4259139e786;hb=b2b717fc777536665f1fd77a3f3d06f235347881;hp=9570da6465d860ae84993a46eb73f2aabbaa46d7;hpb=d86eee19536e3a18caa17f1f56807f4ec6c533c9;p=rpmdepsize.git

diff --git a/rpmdepsize.ml b/rpmdepsize.ml
index 9570da6..f48c0ef 100644
--- a/rpmdepsize.ml
+++ b/rpmdepsize.ml
@@ -19,8 +19,14 @@
  * Python script modified from a version by Seth Vidal.
  *)
 
+(* Rename the extlib Std module so it doesn't clash with the
+ * sexplib Std module.
+ *)
+module Extlib_Std = Std
+
 open Sexplib
-TYPE_CONV_PATH "."
+open Sexplib.Conv
+(*TYPE_CONV_PATH "."*)
 
 open ExtList
 open Unix
@@ -130,7 +136,7 @@ sys.stdout.write (\"))\")  # suppress trailing newline" in
   let chan = open_process_in cmd in
   ignore (input_line chan); (* Drop "Loaded plugins" line. *)
   let root, pkgs =
-    root_packages_of_sexp (Sexp.of_string (Std.input_all chan)) in
+    root_packages_of_sexp (Sexp.of_string (Extlib_Std.input_all chan)) in
   (match close_process_in chan with
    | WEXITED 0 -> ()
    | WEXITED i -> failwithf "python command exited with status %d" i
@@ -385,6 +391,11 @@ let open_window pkgstr =
 
   window#set_geometry_hints ~min_size:(80,80) (da :> GObj.widget);
 
+  (* Force a repaint of the drawing area. *)
+  let drawing_area_repaint () =
+    GtkBase.Widget.queue_draw da#as_widget
+  in
+
   (* Pango contexts used to draw large and small text. *)
   let pango_large_context = da#misc#create_pango_context in
   pango_large_context#set_font_description (Pango.Font.from_string "Sans 12");
@@ -396,6 +407,24 @@ let open_window pkgstr =
    *)
   let opened = ref None in
 
+  (* If we are moused-over a particular package, then this is != None. *)
+  let current = ref None in
+  let set_current new_current =
+    let old_current = !current in
+    current := new_current;
+    (* Because this structure contains loops, we can't use
+     * structural comparisons like: = <> compare.
+     *)
+    let do_repaint =
+      match old_current, new_current with
+      | None, Some _ -> true
+      | Some _, None -> true
+      | Some { pkg = { nevra = n1 } }, Some { pkg = { nevra = n2 } } ->
+	  n1 <> n2
+      | _ -> false in
+    if do_repaint then drawing_area_repaint ()
+  in
+
   (* Called from the "Open package" menu entry and other places. *)
   let open_package pkgstr =
     debug "open_package %s\n%!" pkgstr;
@@ -432,12 +461,12 @@ let open_window pkgstr =
 
 	opened :=
 	  Some (root, pkgs, depsmap, totalsmap, tree, depth, top_total);
+	set_current None;
 
 	(* Update the window title. *)
 	window#set_title (pkgstr ^ " - " ^ base_title);
 
-	(* Force a repaint of the drawing area. *)
-	GtkBase.Widget.queue_draw da#as_widget;
+	drawing_area_repaint ()
     )
   in
 
@@ -563,32 +592,33 @@ let open_window pkgstr =
       let height = int_of_float height in
 
       if width > 8 then (
-	draw_pkg_outline x y width pkgsizewidth height colour;
+	draw_pkg_outline x y width pkgsizewidth height colour pkg;
 	draw_pkg_label x y width height colour pkg total increm
       )
       else if width >= 4 then
-	draw_pkg_narrow x y width height colour
+	draw_pkg_narrow x y width height colour pkg
 	  (* else
 	     XXX This doesn't work.  We need to coalesce small packages
 	     in the tree.
 	     draw_pkg_narrow x y 1 height colour *)
 
-    and draw_pkg_outline x y width pkgsizewidth height colour =
-      draw#set_foreground colour;
+    and draw_pkg_outline x y width pkgsizewidth height colour pkg =
+      let body_colour = choose_colour colour pkg in
+      draw#set_foreground body_colour;
       draw#rectangle ~x:(x+2) ~y:(y+2)
 	~width:(width-4) ~height:(height-4)
 	~filled:true ();
       if pkgsizewidth > 2 then (
-	draw#set_foreground (darken colour);
+	draw#set_foreground (darken body_colour);
 	draw#rectangle ~x:(x+2) ~y:(y+2)
 	  ~width:(pkgsizewidth-2) ~height:(height-4)
 	  ~filled:true ();
-	draw#set_foreground (choose_contrasting_colour colour);
+	draw#set_foreground (choose_contrasting_colour body_colour);
 	draw#set_line_attributes ~style:`ON_OFF_DASH ();
 	draw#line (x+pkgsizewidth) (y+2) (x+pkgsizewidth) (y+height-2);
 	draw#set_line_attributes ~style:`SOLID ()
       );
-      draw#set_foreground (`BLACK);
+      draw#set_foreground `BLACK;
       draw#rectangle ~x:(x+2) ~y:(y+2)
 	~width:(width-4) ~height:(height-4)
 	~filled:false ()
@@ -707,8 +737,8 @@ Tot: %.1f%% %s" pkg.name
       in
       loop txts
 
-    and draw_pkg_narrow x y width height colour =
-      draw#set_foreground colour;
+    and draw_pkg_narrow x y width height colour pkg =
+      draw#set_foreground (choose_colour colour pkg);
       draw#rectangle ~x:(x+2) ~y:(y+2)
 	~width:(width-4) ~height:(height-4) ~filled:true ()
 
@@ -717,6 +747,22 @@ Tot: %.1f%% %s" pkg.name
 	  if r + g + b > 98304 then `BLACK else `WHITE
       | _ -> `WHITE
 
+    and choose_colour colour pkg =
+      match !current with
+      | None -> colour
+      | Some current ->
+	  let nevra = pkg.nevra in
+	  let is_parent =
+	    List.exists
+	      (fun { pkg = { nevra = n } } -> n = nevra) current.parents in
+	  let is_child =
+	    List.exists
+	      (fun { pkg = { nevra = n } } -> n = nevra) current.children in
+	  if is_parent && is_child then `RGB (63000, 63000, 0) (* yellow *)
+	  else if is_parent then `RGB (0, 63000, 63000) (* cyan *)
+	  else if is_child then `RGB (0, 63000, 0) (* green *)
+	  else colour
+
     and darken = function
       | `RGB (r, g, b) ->
 	  `RGB (r * 9 / 10, g * 9 / 10, b * 9 / 10)
@@ -751,21 +797,39 @@ Tot: %.1f%% %s" pkg.name
 
     (match get_locn x y with
      | None ->
+	 set_current None;
 	 kill_tooltip ()
      | Some (colour, pkg, total, increm) ->
+	 (* Update 'current' which points to the currently moused package. *)
+	 let dep = StringMap.find pkg.nevra depsmap in
+	 set_current (Some dep);
+
+	 let deps_of_string deps =
+	   String.concat "\n  "
+	     (List.sort (List.map (fun d -> d.pkg.nevra) deps))
+	 in
+
 	 (* The only way to make the tooltip follow the mouse is to
 	  * kill the whole tooltips object and recreate it each time ...
 	  *)
 	 kill_tooltip ();
 	 let tt = GData.tooltips ~delay:100 () in
-	 (* Tooltip text is the same as txt1. *)
+	 (* Tooltip text is the same as txt1 + extra. *)
 	 let text = sprintf "%s
 Package: %.1f%% %s (%Ld bytes)
 Incremental: %.1f%% %s (%Ld bytes)
 Total: %.1f%% %s (%Ld bytes)" pkg.nevra
 	   (display_percent pkg.size top_total) (display_size pkg.size) pkg.size
-(display_percent increm top_total) (display_size increm) increm
-(display_percent total top_total) (display_size total) total in
+           (display_percent increm top_total) (display_size increm) increm
+           (display_percent total top_total) (display_size total) total in
+	 let text = if dep.parents = [] then text else text ^ sprintf "
+Required by (blue):
+  %s"
+           (deps_of_string dep.parents) in
+	 let text = if dep.children = [] then text else text ^ sprintf "
+Requires (green):
+  %s"
+           (deps_of_string dep.children) in
 	 tt#set_tip ~text (da :> GObj.widget);
 	 tt#enable ();
 	 tooltips := Some tt