X-Git-Url: http://git.annexia.org/?a=blobdiff_plain;f=rpmdepsize.ml;h=f48c0ef9e0c05c9db2e365d8eaeef4259139e786;hb=b2b717fc777536665f1fd77a3f3d06f235347881;hp=1fb9458441f59e84c284f774000345e41cb86a10;hpb=0e837cdf3f0dedf8b9789b79221f0698089c99a1;p=rpmdepsize.git

diff --git a/rpmdepsize.ml b/rpmdepsize.ml
index 1fb9458..f48c0ef 100644
--- a/rpmdepsize.ml
+++ b/rpmdepsize.ml
@@ -19,54 +19,80 @@
  * 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
 open Printf
 
-let debug = true
-
 (* This corresponds to the sexpr that we write out from the
  * Python code.  OCaml will type-check it.
  *)
-type root_packages = string * packages
+type root_packages = nevra * packages
 and packages = pkg list
 and pkg = {
-  nevra : string;			(* name-[epoch:]version-release.arch *)
+  nevra : nevra;
   name : string;
   epoch : int;
   version : string;
   release : string;
   arch : string;
   size : int64;				(* installed size, excl. dirs *)
-  deps : string list;
+  deps : nevra list;
 }
+and nevra = string			(* Name-[Epoch:]Version-Release.Arch *)
  with sexp
 
 (* Full dependency representation.  This is actually a graph because
- * it contains dependency loops.  'deps list' is a ref because we
- * update it as we are building it.
+ * it contains dependency loops.  The only difference from the pkg
+ * structure is that we have resolved the nevra strings into direct
+ * links, so we can quickly recurse over the tree.
+ *
+ * Parents/deps are mutable only because we want to modify these
+ * lists when creating this graph in 'create_deps'.
  *)
-type deps = Deps of pkg * deps list ref
+type deps = {
+  pkg : pkg;			(* the package *)
+  mutable children : deps list;	(* dependencies of this package (below) *)
+  mutable parents : deps list;	(* parents of this package (above) *)
+}
 
 (* Final tree representation, loops removed, and everything we want to
  * display stored in the nodes.
  *)
 type tree = Tree of pkg * int64 * int64 * GDraw.color * tree list
 
+(* Helpful modules, operators and functions. *)
 module StringMap = Map.Make (String)
 let (+^) = Int64.add
 let sum = List.fold_left (+^) 0L
 let spaces n = String.make n ' '
+let failwithf = ksprintf failwith
+
+(* Debugging support (--debug on the command line). *)
+let debug_flag = ref false
+let debug format =
+  (* ifprintf consumes the arguments, but produces no output *)
+  (if !debug_flag then eprintf else ifprintf Pervasives.stderr) format
 
 (* Python has privileged access to the yum repodata, so we have to use
  * this Python snippet to pull the data that we need out.  This is the
  * part of the program that takes ages to run, because Python is as
- * slow as a fat snake that's just eaten a huge lunch.  We can't help that.
+ * slow as a fat snake that's just eaten a huge lunch.  We can't help
+ * that.
+ * 
+ * This function takes a string (package name) and returns a
+ * root_packages type.
  *)
-let repoquery_py = "
+let repoquery pkgstr =
+  let py = "
 import yum
 import yum.misc
 import sys
@@ -102,77 +128,62 @@ for pkg in deps.keys():
     for p in deps[pkg]:
         print \"%s \" % p,
     print \")))\"
-sys.stdout.write (\"))\")  # suppress trailing newline"
-
-let () =
-  printf "getting repository information (this can take a few seconds ...)\n%!";
+sys.stdout.write (\"))\")  # suppress trailing newline" in
 
   (* Run the Python program and read in the generated sexpr. *)
   let cmd =
-    sprintf "python -c %s %s"
-      (Filename.quote repoquery_py) (Filename.quote Sys.argv.(1)) in
+    sprintf "python -c %s %s" (Filename.quote py) (Filename.quote pkgstr) in
   let chan = open_process_in cmd in
-  ignore (input_line chan); (* drop "Loaded plugins" *)
+  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 -> failwith (sprintf "command exited with status %d" i)
+   | WEXITED i -> failwithf "python command exited with status %d" i
    | WSIGNALED i | WSTOPPED i ->
-       failwith (sprintf "command stopped with signal %d" i)
+       failwithf "python command stopped with signal %d" i
   );
 
-  if debug then (
-    List.iter (
-      fun pkg -> printf "%s -> [%s]\n" pkg.nevra (String.concat ", " pkg.deps)
-    ) pkgs;
-    printf "root package is %s\n" root;
-    printf "===\n%!"
-  );
+  (root, pkgs)
 
-  (* Create the dependency graph, probably contains loops so beware. *)
-  let deps = List.map (fun pkg -> Deps (pkg, ref [])) pkgs in
+(* Create the dependency graph from the raw package data.  Probably
+ * contains loops so beware.
+ *
+ * Takes the list of packages (from Python code) and returns a
+ * StringMap of nevra -> deps.
+ *)
+let create_deps pkgs =
+  let deps =
+    List.map (fun pkg -> { pkg = pkg; children = []; parents = [] }) pkgs in
   let depsmap =
     List.fold_left (
-      fun map (Deps (pkg, _) as deps) ->
-	StringMap.add pkg.nevra deps map
+      fun map ({pkg = pkg} as deps) -> StringMap.add pkg.nevra deps map
     ) StringMap.empty deps in
   List.iter (
-    fun (Deps (pkg, deps)) ->
-      let deps' = List.map (fun n -> StringMap.find n depsmap) pkg.deps in
-      deps := List.append !deps deps'
+    fun dep ->
+      List.iter (
+	fun nevra ->
+	  let dep' = StringMap.find nevra depsmap in
+	  (* dep.pkg is parent of dep'.pkg *)
+	  dep.children <- dep' :: dep.children;
+	  dep'.parents <- dep :: dep'.parents
+      ) dep.pkg.deps;
   ) deps;
-  let deps = () in ignore deps;
+  depsmap
 
-  if debug then (
-    let seen = ref StringMap.empty in
-    let rec display ?(indent=0) = function
-      | Deps (pkg, deps) ->
-	  if StringMap.mem pkg.nevra !seen then
-	    printf "%s%s -> ...\n" (spaces indent) pkg.nevra
-	  else (
-	    printf "%s%s -> [%s]\n"
-	      (spaces indent) pkg.nevra (
-		String.concat ", "
-		  (List.map (fun (Deps (pkg, _)) -> pkg.nevra) !deps)
-	      );
-	    seen := StringMap.add pkg.nevra true !seen;
-	    List.iter (display ~indent:(indent+2)) !deps
-	  )
-    in
-    display (StringMap.find root depsmap);
-    printf "===\n%!"
-  );
-
-  (* For each package, calculate the total installed size of the package,
-   * which includes all subpackages pulled in.  So it's what would be
-   * installed if you did 'yum install foo'.
-   *)
+(* For each package, calculate the total installed size of the package,
+ * which includes all subpackages pulled in.  So it's what would be
+ * installed if you did 'yum install foo'.
+ *
+ * Takes the list of packages and the dependency map (see 'create_deps')
+ * and returns a StringMap of nevra -> total.
+ *)
+let create_totals pkgs depsmap =
   let total pkg =
     let seen = ref StringMap.empty in
     let rec _total = function
-      | Deps (pkg, _) when StringMap.mem pkg.nevra !seen -> 0L
-      | Deps (pkg, { contents = children }) ->
+      | { pkg = pkg } when StringMap.mem pkg.nevra !seen -> 0L
+      | { pkg = pkg; children = children } ->
 	  seen := StringMap.add pkg.nevra true !seen;
 	  pkg.size +^ sum (List.map _total children)
     in
@@ -182,23 +193,29 @@ let () =
     List.fold_left (
       fun map pkg -> StringMap.add pkg.nevra (total pkg) map
     ) StringMap.empty pkgs in
+  totalsmap
 
-  (* Create the final display tree.  Each node is sorted so that
-   * children with the largest contribution come first (on the left).
-   * We remove packages which are already installed by earlier
-   * (leftward) packages.  At each node we also store total size and
-   * size of the additional packages.
-   *)
+(* Create the final display tree.  Each node is sorted so that
+ * children with the largest contribution come first (on the left).
+ * We remove packages which are already installed by earlier
+ * (leftward) packages.  At each node we also store total size and
+ * size of the additional packages.
+ *
+ * Takes the nevra of the root package, the depsmap (see 'create_deps')
+ * and the totalsmap (see 'create_totals'), and returns the display
+ * tree and the depth of the tree.
+ *)
+let create_tree root depsmap totalsmap =
   let tree =
     let seen = StringMap.empty in
     let seen = StringMap.add root true seen in
     let seen = ref seen in
-    let mark_seen (Deps (pkg, _))= seen := StringMap.add pkg.nevra true !seen in
-    let not_seen (Deps (pkg, _)) = not (StringMap.mem pkg.nevra !seen) in
+    let mark_seen { pkg = pkg } = seen := StringMap.add pkg.nevra true !seen in
+    let not_seen { pkg = pkg } = not (StringMap.mem pkg.nevra !seen) in
     let rec build_tree = function
-      | Deps (pkg, { contents = children }) ->
+      | { pkg = pkg; children = children } ->
 	  (* Sort children by reverse total size. *)
-	  let cmp (Deps (p1, _)) (Deps (p2, _)) =
+	  let cmp { pkg = p1 } { pkg = p2 } =
 	    let t1 = StringMap.find p1.nevra totalsmap in
 	    let t2 = StringMap.find p2.nevra totalsmap in
 	    compare t2 t1
@@ -220,16 +237,6 @@ let () =
     in
     build_tree (StringMap.find root depsmap) in
 
-  if debug then (
-    let rec display ?(indent=0) = function
-      | Tree (pkg, total, increm, _, children) ->
-	  printf "%s%s %Ld/%Ld/%Ld\n%!"
-	    (spaces indent) pkg.nevra pkg.size increm total;
-	  List.iter (display ~indent:(indent+2)) children
-    in
-    display tree;
-  );
-
   (* Max depth of the tree. *)
   let depth =
     let rec depth = function
@@ -282,36 +289,222 @@ let () =
       colour_level2 pcols level2 in
     Tree (pkg, total, increm, `RGB (55000, 55000, 55000), level2) in
 
-  (* top_total is the total size in bytes of everything.  Used for
-   * relative display of percentages, widths, etc.
-   *)
-  let Tree (_, top_total, top_increm, _, _) = tree in
-  assert (top_total = top_increm);
-
-  (* Useful display functions. *)
-  let display_percent bytes =
-    100. *. Int64.to_float bytes /. Int64.to_float top_total
-
-  and display_size bytes =
-    if bytes > 104_857L then
-      sprintf "%.1f MB" (Int64.to_float bytes /. 1_048_576.)
-    else if bytes > 102L then
-      sprintf "%.1f KB" (Int64.to_float bytes /. 1_024.)
-    else
-      sprintf "%Ld" bytes
-  in
+  tree, depth
+
+(* Debugging functions.  These only produce any output if debugging
+ * was enabled on the command line.
+ *)
+let debug_pkgs root pkgs =
+  if !debug_flag then (
+    List.iter (
+      fun pkg ->
+	eprintf "%s -> [%s]\n" pkg.nevra (String.concat ", " pkg.deps)
+    ) pkgs;
+    eprintf "root package is %s\n" root;
+    eprintf "===\n%!"
+  )
+
+let debug_deps root depsmap =
+  if !debug_flag then (
+    let seen = ref StringMap.empty in
+    let rec display ?(indent=0) = function
+      | { pkg = pkg; children = children; parents = parents } ->
+	  if StringMap.mem pkg.nevra !seen then
+	    eprintf "%s%s -> ...\n" (spaces indent) pkg.nevra
+	  else (
+	    eprintf "%s%s ->\n%sparents:[%s]\n"
+	      (spaces indent) pkg.nevra (spaces (indent+2)) (
+		String.concat ", "
+		  (List.map (fun { pkg = pkg } -> pkg.nevra) parents)
+	      );
+	    seen := StringMap.add pkg.nevra true !seen;
+	    List.iter (display ~indent:(indent+2)) children
+	  )
+    in
+    display (StringMap.find root depsmap);
+    eprintf "===\n%!"
+  )
 
+let debug_tree tree =
+  if !debug_flag then (
+    let rec display ?(indent=0) = function
+      | Tree (pkg, total, increm, _, children) ->
+	  eprintf "%s%s %Ld/%Ld/%Ld\n%!"
+	    (spaces indent) pkg.nevra pkg.size increm total;
+	  List.iter (display ~indent:(indent+2)) children
+    in
+    display tree;
+  )
+
+(* Useful display functions. *)
+let display_percent bytes top_total =
+  100. *. Int64.to_float bytes /. Int64.to_float top_total
+
+let display_size bytes =
+  if bytes > 104_857L then
+    sprintf "%.1f MB" (Int64.to_float bytes /. 1_048_576.)
+  else if bytes > 102L then
+    sprintf "%.1f KB" (Int64.to_float bytes /. 1_024.)
+  else
+    sprintf "%Ld" bytes
+
+(* Defer a function callback until Gtk rendering has been done. *)
+let defer ?(ms=10) f = 
+  ignore (GMain.Timeout.add ~ms ~callback:(fun () -> f (); false))
+
+(* Open the toplevel window.  The 'pkgstr' parameter is the optional
+ * name of the package to open.  If None then we open a blank window.
+ *)
+let open_window pkgstr =
   (* Open the window. *)
-  let title = root ^ " - Fedora RPM dependency size viewer" in
+  let base_title = "Fedora RPM dependency size viewer" in
   let window =
-    GWindow.window ~width:800 ~height:600 ~title ~allow_shrink:true () in
+    GWindow.window ~width:800 ~height:600
+      ~title:base_title ~allow_shrink:true () in
+
+  let vbox = GPack.vbox ~packing:window#add () in
+
+  (* Menu bar. *)
+  let menubar = GMenu.menu_bar ~packing:vbox#pack () in
+  let factory = new GMenu.factory menubar in
+  let accel_group = factory#accel_group in
+  let package_menu = factory#add_submenu "_Package" in
+  let help_menu = factory#add_submenu "_Help" in
 
+  let factory = new GMenu.factory package_menu ~accel_group in
+  let open_item = factory#add_item "_Open package ..." ~key:GdkKeysyms._O in
+  let quit_item = factory#add_item "E_xit" ~key:GdkKeysyms._Q in
+
+  let factory = new GMenu.factory help_menu ~accel_group in
+  let about_item = factory#add_item "About" in
+
+  (* Events for the menu bar. *)
   ignore (window#connect#destroy ~callback:GMain.quit);
+  ignore (quit_item#connect#activate ~callback:GMain.quit);
 
-  let da = GMisc.drawing_area ~packing:window#add () in
+  ignore (about_item#connect#activate ~callback:Rpmdepsize_about.callback);
+
+  let da = GMisc.drawing_area
+    ~packing:(vbox#pack ~expand:true ~fill:true) () in
   da#misc#realize ();
   let draw = new GDraw.drawable da#misc#window in
 
+  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");
+  let pango_small_context = da#misc#create_pango_context in
+  pango_small_context#set_font_description (Pango.Font.from_string "Sans 8");
+
+  (* This is the currently open package, or None if nothing has
+   * opened by the user yet.
+   *)
+  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;
+
+    (* XXX Can't be bothered to do this "properly" (ie with threads etc)
+     * so just put a loading message in the middle of the drawing area.
+     *)
+    let width, height = draw#size in
+    let txt = pango_large_context#create_layout in
+    Pango.Layout.set_text txt (sprintf "Loading %s ..." pkgstr);
+    let { Pango.width = txtwidth; Pango.height = txtheight } =
+      Pango.Layout.get_pixel_extent txt in
+    let x = (width - txtwidth) / 2 and y = (height - txtheight) / 2 in
+    draw#set_foreground (`RGB (0, 0, 65535));
+    draw#rectangle ~x:(x-4) ~y:(y-2)
+      ~width:(txtwidth+8) ~height:(txtheight+8) ~filled:true ();
+    draw#put_layout ~x ~y ~fore:`WHITE txt;
+
+    defer (
+      fun () ->
+	let root, pkgs = repoquery pkgstr in
+	debug_pkgs root pkgs;
+	let depsmap = create_deps pkgs in
+	debug_deps root depsmap;
+	let totalsmap = create_totals pkgs depsmap in
+	let tree, depth = create_tree root depsmap totalsmap in
+	debug_tree tree;
+
+	(* top_total is the total size in bytes of everything.  Used for
+	 * relative display of percentages, widths, etc.
+	 *)
+	let Tree (_, top_total, top_increm, _, _) = tree in
+	assert (top_total = top_increm);
+
+	opened :=
+	  Some (root, pkgs, depsmap, totalsmap, tree, depth, top_total);
+	set_current None;
+
+	(* Update the window title. *)
+	window#set_title (pkgstr ^ " - " ^ base_title);
+
+	drawing_area_repaint ()
+    )
+  in
+
+  (* If the user selected something on the command line (pkgstr !=
+   * None) then set up an idle event to populate 'opened' as soon as
+   * the window gets drawn on the screen.
+   *)
+  (match pkgstr with
+   | None -> ()
+   | Some pkgstr ->
+       defer ~ms:50 (fun () -> open_package pkgstr)
+  );
+
+  let callback _ =
+    let dlg =
+      GWindow.dialog ~parent:window ~modal:true
+	~position:`CENTER_ON_PARENT ~title:"Open package" () in
+    dlg#add_button "Open package" `OPEN;
+    dlg#add_button "Cancel" `CANCEL;
+    let vbox = dlg#vbox in
+    let hbox = GPack.hbox ~packing:vbox#pack () in
+    ignore (GMisc.label ~text:"Package:" ~packing:hbox#pack ());
+    let entry = GEdit.entry
+      ~width_chars:40 ~packing:(hbox#pack ~expand:true ~fill:true) () in
+    ignore (GMisc.label ~text:"Enter a package name, wildcard or path."
+	      ~packing:vbox#pack ());
+    dlg#show ();
+    match dlg#run () with
+    | `CANCEL | `DELETE_EVENT ->
+	dlg#destroy ()
+    | `OPEN ->
+	let pkgstr = entry#text in
+	dlg#destroy ();
+	if pkgstr <> "" then
+	  defer (fun () -> open_package pkgstr)
+  in
+  ignore (open_item#connect#activate ~callback);
+
   (* Need to enable these mouse events so we can do tooltips. *)
   GtkBase.Widget.add_events da#as_widget
     [`ENTER_NOTIFY; `LEAVE_NOTIFY; `POINTER_MOTION];
@@ -352,13 +545,7 @@ let () =
     add_locn, reset_locns, get_locn
   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");
-  let pango_small_context = da#misc#create_pango_context in
-  pango_small_context#set_font_description (Pango.Font.from_string "Sans 8");
-
-  let repaint _ =
+  let rec real_repaint root pkgs depsmap totalsmap tree depth top_total =
     (* Get the canvas size and fill the background with white. *)
     let width, height = draw#size in
     draw#set_background `WHITE;
@@ -405,32 +592,33 @@ let () =
       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
-      (* 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;
+	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 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 ()
@@ -448,9 +636,9 @@ let () =
 Package: %.1f%% %s (%Ld bytes)
 Incremental: %.1f%% %s (%Ld bytes)
 Total: %.1f%% %s (%Ld bytes)" pkg.nevra
-(display_percent pkg.size) (display_size pkg.size) pkg.size
-(display_percent increm) (display_size increm) increm
-(display_percent total) (display_size total) total
+	    (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
 	);
 	txt
       )
@@ -461,9 +649,9 @@ Total: %.1f%% %s (%Ld bytes)" pkg.nevra
 Package: %.1f%% %s (%Ld bytes)
 Incremental: %.1f%% %s (%Ld bytes)
 Total: %.1f%% %s (%Ld bytes)" pkg.nevra
-(display_percent pkg.size) (display_size pkg.size) pkg.size
-(display_percent increm) (display_size increm) increm
-(display_percent total) (display_size total) total
+	    (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
 	);
 	txt
       )
@@ -474,9 +662,9 @@ Total: %.1f%% %s (%Ld bytes)" pkg.nevra
 Pkg: %.1f%% %s (%Ld bytes)
 Incr: %.1f%% %s (%Ld bytes)
 Tot: %.1f%% %s (%Ld bytes)" pkg.name
-(display_percent pkg.size) (display_size pkg.size) pkg.size
-(display_percent increm) (display_size increm) increm
-(display_percent total) (display_size total) total
+	    (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
 	);
 	txt
       )
@@ -487,9 +675,9 @@ Tot: %.1f%% %s (%Ld bytes)" pkg.name
 Pkg: %.1f%% %s
 Incr: %.1f%% %s
 Tot: %.1f%% %s" pkg.name
-(display_percent pkg.size) (display_size pkg.size)
-(display_percent increm) (display_size increm)
-(display_percent total) (display_size total)
+	    (display_percent pkg.size top_total) (display_size pkg.size)
+	    (display_percent increm top_total) (display_size increm)
+	    (display_percent total top_total) (display_size total)
 	);
 	txt
       )
@@ -498,9 +686,9 @@ Tot: %.1f%% %s" pkg.name
 	Pango.Layout.set_text txt (
 	  sprintf "%s\nPkg: %.1f%%\nIncr: %.1f%%\nTot: %.1f%%"
 	    pkg.name
-	    (display_percent pkg.size)
-	    (display_percent increm)
-	    (display_percent total)
+	    (display_percent pkg.size top_total)
+	    (display_percent increm top_total)
+	    (display_percent total top_total)
 	);
 	txt
       )
@@ -508,9 +696,9 @@ Tot: %.1f%% %s" pkg.name
 	let txt = pango_small_context#create_layout in
 	Pango.Layout.set_text txt (
 	  sprintf "%s Pkg: %.1f%% %s Incr: %.1f%% %s Tot: %.1f%% %s" pkg.name
-	    (display_percent pkg.size) (display_size pkg.size)
-	    (display_percent increm) (display_size increm)
-	    (display_percent total) (display_size total)
+	    (display_percent pkg.size top_total) (display_size pkg.size)
+	    (display_percent increm top_total) (display_size increm)
+	    (display_percent total top_total) (display_size total)
 	);
 	txt
       )
@@ -518,9 +706,9 @@ Tot: %.1f%% %s" pkg.name
 	let txt = pango_small_context#create_layout in
 	Pango.Layout.set_text txt (
 	  sprintf "%s %.1f%% %.1f%% %.1f%%" pkg.name
-	    (display_percent pkg.size)
-	    (display_percent increm)
-	    (display_percent total)
+	    (display_percent pkg.size top_total)
+	    (display_percent increm top_total)
+	    (display_percent total top_total)
 	);
 	txt
       )
@@ -549,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 ()
 
@@ -559,19 +747,42 @@ 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)
       | _ -> `WHITE
     in
-    draw_tree 0. 0 tree;
+    draw_tree 0. 0 tree
+
+  and repaint _ =
+    (match !opened with
+     | None -> ()
+     | Some (root, pkgs, depsmap, totalsmap, tree, depth, top_total) ->
+	 real_repaint root pkgs depsmap totalsmap tree depth top_total
+    );
 
     (* Return false because this is a Gtk event handler. *)
     false
   in
   ignore (da#event#connect#expose ~callback:repaint);
 
-  let motion ev =
+  let rec real_motion root pkgs depsmap totalsmap tree depth top_total ev =
     let x, y = GdkEvent.Motion.x ev, GdkEvent.Motion.y ev in
 
     let kill_tooltip () =
@@ -586,31 +797,83 @@ 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) (display_size pkg.size) pkg.size
-(display_percent increm) (display_size increm) increm
-(display_percent total) (display_size total) total in
+	   (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
+	 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
+    )
+
+  and motion ev =
+    (match !opened with
+     | None -> ()
+     | Some (root, pkgs, depsmap, totalsmap, tree, depth, top_total) ->
+	 real_motion root pkgs depsmap totalsmap tree depth top_total ev
     );
 
     (* Return false because this is a Gtk event handler. *)
     false
   in
-
   ignore (da#event#connect#motion_notify ~callback:motion);
 
+  window#add_accel_group accel_group;
   window#show ();
   GMain.main ()
+
+(* Main program. *)
+let () =
+  (* Parse the command line arguments. *)
+  let anon_args = ref [] in
+
+  let argspec = Arg.align [
+    "--debug", Arg.Set debug_flag,
+    " " ^ "Enable debugging messages on stderr";
+  ] in
+  let anon_fun str = anon_args := str :: !anon_args in
+  let usage_msg =
+    "rpmdepsize [package] : visualize the size of RPM dependencies" in
+
+  Arg.parse argspec anon_fun usage_msg;
+
+  (* Should be at most one anonymous argument. *)
+  let pkgstr =
+    match !anon_args with
+    | [] -> None
+    | [p] -> Some p
+    | _ ->
+	eprintf "rpmdepsize: too many command line arguments";
+	exit 1 in
+
+  (* Open the main window. *)
+  open_window pkgstr