1 (* rpmdepsize - visualize the size of RPM dependencies
2 * (C) Copyright 2009 Red Hat Inc.
4 * This program is free software; you can redistribute it and/or modify
5 * it under the terms of the GNU General Public License as published by
6 * the Free Software Foundation; either version 2 of the License, or
7 * (at your option) any later version.
9 * This program is distributed in the hope that it will be useful,
10 * but WITHOUT ANY WARRANTY; without even the implied warranty of
11 * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
12 * GNU General Public License for more details.
14 * You should have received a copy of the GNU General Public License
15 * along with this program; if not, write to the Free Software
16 * Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
18 * Written by Richard W.M. Jones <rjones@redhat.com>
19 * Python script modified from a version by Seth Vidal.
22 (* Rename the extlib Std module so it doesn't clash with the
25 module Extlib_Std = Std
29 (*TYPE_CONV_PATH "."*)
35 (* This corresponds to the sexpr that we write out from the
36 * Python code. OCaml will type-check it.
38 type root_packages = nevra * packages
39 and packages = pkg list
47 size : int64; (* installed size, excl. dirs *)
50 and nevra = string (* Name-[Epoch:]Version-Release.Arch *)
53 (* Full dependency representation. This is actually a graph because
54 * it contains dependency loops. The only difference from the pkg
55 * structure is that we have resolved the nevra strings into direct
56 * links, so we can quickly recurse over the tree.
58 * Parents/deps are mutable only because we want to modify these
59 * lists when creating this graph in 'create_deps'.
62 pkg : pkg; (* the package *)
63 mutable children : deps list; (* dependencies of this package (below) *)
64 mutable parents : deps list; (* parents of this package (above) *)
67 (* Final tree representation, loops removed, and everything we want to
68 * display stored in the nodes.
70 type tree = Tree of pkg * int64 * int64 * GDraw.color * tree list
72 (* Helpful modules, operators and functions. *)
73 module StringMap = Map.Make (String)
75 let sum = List.fold_left (+^) 0L
76 let spaces n = String.make n ' '
77 let failwithf = ksprintf failwith
79 (* Debugging support (--debug on the command line). *)
80 let debug_flag = ref false
82 (* ifprintf consumes the arguments, but produces no output *)
83 (if !debug_flag then eprintf else ifprintf Pervasives.stderr) format
85 (* Python has privileged access to the yum repodata, so we have to use
86 * this Python snippet to pull the data that we need out. This is the
87 * part of the program that takes ages to run, because Python is as
88 * slow as a fat snake that's just eaten a huge lunch. We can't help
91 * This function takes a string (package name) and returns a
94 let repoquery pkgstr =
102 basepkg = yb.pkgSack.returnPackages (patterns=[sys.argv[1]])[0]
103 deps = dict ({basepkg:False})
105 # Recursively find all the dependencies.
109 for pkg in deps.keys():
110 if deps[pkg] == False:
113 for r in pkg.requires:
114 ps = yb.whatProvides (r[0], r[1], r[2])
115 best = yb._bestPackageFromList (ps.returnPackages ())
116 if best.name != pkg.name:
117 deps[pkg].append (best)
118 if not deps.has_key (best):
120 deps[pkg] = yum.misc.unique (deps[pkg])
122 # Get the data out of python as fast as possible so we can
123 # use a serious language for analysis of the tree.
124 print \"(%s (\" % basepkg
125 for pkg in deps.keys():
126 print \"((nevra %s) (name %s) (epoch %s) (version %s) (release %s) (arch %s) (size %s)\" % (pkg, pkg.name, pkg.epoch, pkg.version, pkg.release, pkg.arch, pkg.installedsize)
131 sys.stdout.write (\"))\") # suppress trailing newline" in
133 (* Run the Python program and read in the generated sexpr. *)
135 sprintf "python -c %s %s" (Filename.quote py) (Filename.quote pkgstr) in
136 let chan = open_process_in cmd in
137 ignore (input_line chan); (* Drop "Loaded plugins" line. *)
139 root_packages_of_sexp (Sexp.of_string (Extlib_Std.input_all chan)) in
140 (match close_process_in chan with
142 | WEXITED i -> failwithf "python command exited with status %d" i
143 | WSIGNALED i | WSTOPPED i ->
144 failwithf "python command stopped with signal %d" i
149 (* Create the dependency graph from the raw package data. Probably
150 * contains loops so beware.
152 * Takes the list of packages (from Python code) and returns a
153 * StringMap of nevra -> deps.
155 let create_deps pkgs =
157 List.map (fun pkg -> { pkg = pkg; children = []; parents = [] }) pkgs in
160 fun map ({pkg = pkg} as deps) -> StringMap.add pkg.nevra deps map
161 ) StringMap.empty deps in
166 let dep' = StringMap.find nevra depsmap in
167 (* dep.pkg is parent of dep'.pkg *)
168 dep.children <- dep' :: dep.children;
169 dep'.parents <- dep :: dep'.parents
174 (* For each package, calculate the total installed size of the package,
175 * which includes all subpackages pulled in. So it's what would be
176 * installed if you did 'yum install foo'.
178 * Takes the list of packages and the dependency map (see 'create_deps')
179 * and returns a StringMap of nevra -> total.
181 let create_totals pkgs depsmap =
183 let seen = ref StringMap.empty in
184 let rec _total = function
185 | { pkg = pkg } when StringMap.mem pkg.nevra !seen -> 0L
186 | { pkg = pkg; children = children } ->
187 seen := StringMap.add pkg.nevra true !seen;
188 pkg.size +^ sum (List.map _total children)
190 _total (StringMap.find pkg.nevra depsmap)
194 fun map pkg -> StringMap.add pkg.nevra (total pkg) map
195 ) StringMap.empty pkgs in
198 (* Create the final display tree. Each node is sorted so that
199 * children with the largest contribution come first (on the left).
200 * We remove packages which are already installed by earlier
201 * (leftward) packages. At each node we also store total size and
202 * size of the additional packages.
204 * Takes the nevra of the root package, the depsmap (see 'create_deps')
205 * and the totalsmap (see 'create_totals'), and returns the display
206 * tree and the depth of the tree.
208 let create_tree root depsmap totalsmap =
210 let seen = StringMap.empty in
211 let seen = StringMap.add root true seen in
212 let seen = ref seen in
213 let mark_seen { pkg = pkg } = seen := StringMap.add pkg.nevra true !seen in
214 let not_seen { pkg = pkg } = not (StringMap.mem pkg.nevra !seen) in
215 let rec build_tree = function
216 | { pkg = pkg; children = children } ->
217 (* Sort children by reverse total size. *)
218 let cmp { pkg = p1 } { pkg = p2 } =
219 let t1 = StringMap.find p1.nevra totalsmap in
220 let t2 = StringMap.find p2.nevra totalsmap in
223 let children = List.sort ~cmp children in
224 let children = List.filter not_seen children in
225 List.iter mark_seen children;
226 let children = List.map build_tree children in
227 let total = StringMap.find pkg.nevra totalsmap in
229 let rec sum_child_sizes = function
230 | Tree (pkg, _, _, _, children) ->
232 fun size child -> size +^ sum_child_sizes child
235 sum_child_sizes (Tree (pkg, 0L, 0L, `WHITE, children)) in
236 Tree (pkg, total, increm, `WHITE, children)
238 build_tree (StringMap.find root depsmap) in
240 (* Max depth of the tree. *)
242 let rec depth = function
243 | Tree (pkg, _, _, _, children) ->
244 List.fold_left (fun d c -> max d (1 + depth c)) 1 children
248 (* Allocate a colour to each node in the tree based on its parent. The
249 * single top node is always light grey. The second level nodes are
253 let Tree (pkg, total, increm, _, level2) = tree in
259 `RGB (55000, 55000, 0);
260 `RGB (0, 55000, 55000);
262 let rec colour_level2 cols = function
264 | Tree (pkg, total, increm, _, level3) :: level2 ->
265 let col, cols = match cols with
266 | [] -> List.hd pcols, List.tl pcols
267 | col :: cols -> col, cols in
268 let level3 = colour_level3 col (List.length level3) 0 level3 in
269 Tree (pkg, total, increm, col, level3)
270 :: colour_level2 cols level2
271 and colour_level3 col n i = function
273 | Tree (pkg, total, increm, _, leveln) :: level3 ->
274 let col = scale_colour col n i in
275 let leveln = colour_level3 col (List.length leveln) 0 leveln in
276 Tree (pkg, total, increm, col, leveln)
277 :: colour_level3 col n (i+1) level3
278 and scale_colour col n i =
279 let r, g, b = match col with
280 | `RGB (r, g, b) -> float r, float g, float b
281 | _ -> assert false in
282 let i = float i and n = float n in
283 let scale = 0.8 +. i/.(5.*.n) in
284 let r = r *. scale in
285 let g = g *. scale in
286 let b = b *. scale in
287 `RGB (int_of_float r, int_of_float g, int_of_float b)
289 colour_level2 pcols level2 in
290 Tree (pkg, total, increm, `RGB (55000, 55000, 55000), level2) in
294 (* Debugging functions. These only produce any output if debugging
295 * was enabled on the command line.
297 let debug_pkgs root pkgs =
298 if !debug_flag then (
301 eprintf "%s -> [%s]\n" pkg.nevra (String.concat ", " pkg.deps)
303 eprintf "root package is %s\n" root;
307 let debug_deps root depsmap =
308 if !debug_flag then (
309 let seen = ref StringMap.empty in
310 let rec display ?(indent=0) = function
311 | { pkg = pkg; children = children; parents = parents } ->
312 if StringMap.mem pkg.nevra !seen then
313 eprintf "%s%s -> ...\n" (spaces indent) pkg.nevra
315 eprintf "%s%s ->\n%sparents:[%s]\n"
316 (spaces indent) pkg.nevra (spaces (indent+2)) (
318 (List.map (fun { pkg = pkg } -> pkg.nevra) parents)
320 seen := StringMap.add pkg.nevra true !seen;
321 List.iter (display ~indent:(indent+2)) children
324 display (StringMap.find root depsmap);
328 let debug_tree tree =
329 if !debug_flag then (
330 let rec display ?(indent=0) = function
331 | Tree (pkg, total, increm, _, children) ->
332 eprintf "%s%s %Ld/%Ld/%Ld\n%!"
333 (spaces indent) pkg.nevra pkg.size increm total;
334 List.iter (display ~indent:(indent+2)) children
339 (* Useful display functions. *)
340 let display_percent bytes top_total =
341 100. *. Int64.to_float bytes /. Int64.to_float top_total
343 let display_size bytes =
344 if bytes > 104_857L then
345 sprintf "%.1f MB" (Int64.to_float bytes /. 1_048_576.)
346 else if bytes > 102L then
347 sprintf "%.1f KB" (Int64.to_float bytes /. 1_024.)
351 (* Defer a function callback until Gtk rendering has been done. *)
352 let defer ?(ms=10) f =
353 ignore (GMain.Timeout.add ~ms ~callback:(fun () -> f (); false))
355 (* Open the toplevel window. The 'pkgstr' parameter is the optional
356 * name of the package to open. If None then we open a blank window.
358 let open_window pkgstr =
359 (* Open the window. *)
360 let base_title = "Fedora RPM dependency size viewer" in
362 GWindow.window ~width:800 ~height:600
363 ~title:base_title ~allow_shrink:true () in
365 let vbox = GPack.vbox ~packing:window#add () in
368 let menubar = GMenu.menu_bar ~packing:vbox#pack () in
369 let factory = new GMenu.factory menubar in
370 let accel_group = factory#accel_group in
371 let package_menu = factory#add_submenu "_Package" in
372 let help_menu = factory#add_submenu "_Help" in
374 let factory = new GMenu.factory package_menu ~accel_group in
375 let open_item = factory#add_item "_Open package ..." ~key:GdkKeysyms._O in
376 let quit_item = factory#add_item "E_xit" ~key:GdkKeysyms._Q in
378 let factory = new GMenu.factory help_menu ~accel_group in
379 let about_item = factory#add_item "About" in
381 (* Events for the menu bar. *)
382 ignore (window#connect#destroy ~callback:GMain.quit);
383 ignore (quit_item#connect#activate ~callback:GMain.quit);
385 ignore (about_item#connect#activate ~callback:Rpmdepsize_about.callback);
387 let da = GMisc.drawing_area
388 ~packing:(vbox#pack ~expand:true ~fill:true) () in
390 let draw = new GDraw.drawable da#misc#window in
392 window#set_geometry_hints ~min_size:(80,80) (da :> GObj.widget);
394 (* Force a repaint of the drawing area. *)
395 let drawing_area_repaint () =
396 GtkBase.Widget.queue_draw da#as_widget
399 (* Pango contexts used to draw large and small text. *)
400 let pango_large_context = da#misc#create_pango_context in
401 pango_large_context#set_font_description (Pango.Font.from_string "Sans 12");
402 let pango_small_context = da#misc#create_pango_context in
403 pango_small_context#set_font_description (Pango.Font.from_string "Sans 8");
405 (* This is the currently open package, or None if nothing has
406 * opened by the user yet.
408 let opened = ref None in
410 (* If we are moused-over a particular package, then this is != None. *)
411 let current = ref None in
412 let set_current new_current =
413 let old_current = !current in
414 current := new_current;
415 (* Because this structure contains loops, we can't use
416 * structural comparisons like: = <> compare.
419 match old_current, new_current with
420 | None, Some _ -> true
421 | Some _, None -> true
422 | Some { pkg = { nevra = n1 } }, Some { pkg = { nevra = n2 } } ->
425 if do_repaint then drawing_area_repaint ()
428 (* Called from the "Open package" menu entry and other places. *)
429 let open_package pkgstr =
430 debug "open_package %s\n%!" pkgstr;
432 (* XXX Can't be bothered to do this "properly" (ie with threads etc)
433 * so just put a loading message in the middle of the drawing area.
435 let width, height = draw#size in
436 let txt = pango_large_context#create_layout in
437 Pango.Layout.set_text txt (sprintf "Loading %s ..." pkgstr);
438 let { Pango.width = txtwidth; Pango.height = txtheight } =
439 Pango.Layout.get_pixel_extent txt in
440 let x = (width - txtwidth) / 2 and y = (height - txtheight) / 2 in
441 draw#set_foreground (`RGB (0, 0, 65535));
442 draw#rectangle ~x:(x-4) ~y:(y-2)
443 ~width:(txtwidth+8) ~height:(txtheight+8) ~filled:true ();
444 draw#put_layout ~x ~y ~fore:`WHITE txt;
448 let root, pkgs = repoquery pkgstr in
449 debug_pkgs root pkgs;
450 let depsmap = create_deps pkgs in
451 debug_deps root depsmap;
452 let totalsmap = create_totals pkgs depsmap in
453 let tree, depth = create_tree root depsmap totalsmap in
456 (* top_total is the total size in bytes of everything. Used for
457 * relative display of percentages, widths, etc.
459 let Tree (_, top_total, top_increm, _, _) = tree in
460 assert (top_total = top_increm);
463 Some (root, pkgs, depsmap, totalsmap, tree, depth, top_total);
466 (* Update the window title. *)
467 window#set_title (pkgstr ^ " - " ^ base_title);
469 drawing_area_repaint ()
473 (* If the user selected something on the command line (pkgstr !=
474 * None) then set up an idle event to populate 'opened' as soon as
475 * the window gets drawn on the screen.
480 defer ~ms:50 (fun () -> open_package pkgstr)
485 GWindow.dialog ~parent:window ~modal:true
486 ~position:`CENTER_ON_PARENT ~title:"Open package" () in
487 dlg#add_button "Open package" `OPEN;
488 dlg#add_button "Cancel" `CANCEL;
489 let vbox = dlg#vbox in
490 let hbox = GPack.hbox ~packing:vbox#pack () in
491 ignore (GMisc.label ~text:"Package:" ~packing:hbox#pack ());
492 let entry = GEdit.entry
493 ~width_chars:40 ~packing:(hbox#pack ~expand:true ~fill:true) () in
494 ignore (GMisc.label ~text:"Enter a package name, wildcard or path."
495 ~packing:vbox#pack ());
497 match dlg#run () with
498 | `CANCEL | `DELETE_EVENT ->
501 let pkgstr = entry#text in
504 defer (fun () -> open_package pkgstr)
506 ignore (open_item#connect#activate ~callback);
508 (* Need to enable these mouse events so we can do tooltips. *)
509 GtkBase.Widget.add_events da#as_widget
510 [`ENTER_NOTIFY; `LEAVE_NOTIFY; `POINTER_MOTION];
512 let tooltips = ref None in
514 (* To track tooltips, the 'repaint' function records the location of
515 * each box (ie. package) in the drawing area in this private data
516 * structure, and the 'motion' function looks them up in order to
517 * display the right tooltip over each box.
519 let add_locn, reset_locns, get_locn =
520 let rows = ref [||] in
521 let rowheight = ref 0. in
523 let reset_locns rowheight' depth =
524 (* This data structure sucks because we just do a linear search
525 * over each row when looking up the 'x'. Should use some sort
526 * of self-balancing tree instead. XXX
528 rows := Array.init depth (fun _ -> ref []);
529 rowheight := rowheight'
530 and add_locn x yi width thing =
531 let row = (!rows).(yi) in
532 row := ((x, x +. width), thing) :: !row
534 let yi = int_of_float (y /. !rowheight) in
535 if yi >= 0 && yi < Array.length !rows then (
536 let row = !((!rows).(yi)) in
538 (snd (List.find (fun ((xlow, xhi), thing) ->
539 xlow <= x && x < xhi)
541 with Not_found -> None
545 add_locn, reset_locns, get_locn
548 let rec real_repaint root pkgs depsmap totalsmap tree depth top_total =
549 (* Get the canvas size and fill the background with white. *)
550 let width, height = draw#size in
551 draw#set_background `WHITE;
552 draw#set_foreground `WHITE;
553 draw#rectangle ~x:0 ~y:0 ~width ~height ~filled:true ();
555 (* Calculate the scales so we can fit everything into the window. *)
556 let rowheight = float height /. float depth in
557 let scale = float width /. Int64.to_float top_total in
559 reset_locns rowheight depth;
561 (* Now draw the tree. *)
562 let rec draw_tree x yi = function
563 | Tree (pkg, total, increm, colour, children) ->
564 (* Draw pkg at (x, y). *)
565 let y = float yi *. rowheight in
566 let width = scale *. Int64.to_float increm in
567 let pkgsizewidth = scale *. Int64.to_float pkg.size in
568 draw_pkg x yi y width pkgsizewidth rowheight colour pkg total increm;
570 (* Draw the children of pkg at (i, y + rowheight), where
571 * i starts as x and increments for each child.
574 let rec loop x = function
576 | child :: children ->
577 draw_tree x yi child;
578 let Tree (_, _, increm, _, _) = child in
579 let childwidth = scale *. Int64.to_float increm in
580 loop (x +. childwidth) children
584 (* Draw a single package. *)
585 and draw_pkg x yi y width pkgsizewidth height colour pkg total increm =
586 add_locn x yi width (colour, pkg, total, increm);
588 let x = int_of_float x in
589 let y = int_of_float y in
590 let width = int_of_float width in
591 let pkgsizewidth = int_of_float pkgsizewidth in
592 let height = int_of_float height in
595 draw_pkg_outline x y width pkgsizewidth height colour pkg;
596 draw_pkg_label x y width height colour pkg total increm
598 else if width >= 4 then
599 draw_pkg_narrow x y width height colour pkg
601 XXX This doesn't work. We need to coalesce small packages
603 draw_pkg_narrow x y 1 height colour *)
605 and draw_pkg_outline x y width pkgsizewidth height colour pkg =
606 let body_colour = choose_colour colour pkg in
607 draw#set_foreground body_colour;
608 draw#rectangle ~x:(x+2) ~y:(y+2)
609 ~width:(width-4) ~height:(height-4)
611 if pkgsizewidth > 2 then (
612 draw#set_foreground (darken body_colour);
613 draw#rectangle ~x:(x+2) ~y:(y+2)
614 ~width:(pkgsizewidth-2) ~height:(height-4)
616 draw#set_foreground (choose_contrasting_colour body_colour);
617 draw#set_line_attributes ~style:`ON_OFF_DASH ();
618 draw#line (x+pkgsizewidth) (y+2) (x+pkgsizewidth) (y+height-2);
619 draw#set_line_attributes ~style:`SOLID ()
621 draw#set_foreground `BLACK;
622 draw#rectangle ~x:(x+2) ~y:(y+2)
623 ~width:(width-4) ~height:(height-4)
626 and draw_pkg_label x y width height colour pkg total increm =
627 (* How to write text in a drawing area, in case it's not
628 * obvious, which it certainly is not:
629 * http://www.math.nagoya-u.ac.jp/~garrigue/soft/olabl/lablgtk-list/120.txt
631 (* txt1 is the same as the tooltip. *)
633 let txt = pango_large_context#create_layout in
634 Pango.Layout.set_text txt (
636 Package: %.1f%% %s (%Ld bytes)
637 Incremental: %.1f%% %s (%Ld bytes)
638 Total: %.1f%% %s (%Ld bytes)" pkg.nevra
639 (display_percent pkg.size top_total) (display_size pkg.size) pkg.size
640 (display_percent increm top_total) (display_size increm) increm
641 (display_percent total top_total) (display_size total) total
646 let txt = pango_small_context#create_layout in
647 Pango.Layout.set_text txt (
649 Package: %.1f%% %s (%Ld bytes)
650 Incremental: %.1f%% %s (%Ld bytes)
651 Total: %.1f%% %s (%Ld bytes)" pkg.nevra
652 (display_percent pkg.size top_total) (display_size pkg.size) pkg.size
653 (display_percent increm top_total) (display_size increm) increm
654 (display_percent total top_total) (display_size total) total
659 let txt = pango_small_context#create_layout in
660 Pango.Layout.set_text txt (
662 Pkg: %.1f%% %s (%Ld bytes)
663 Incr: %.1f%% %s (%Ld bytes)
664 Tot: %.1f%% %s (%Ld bytes)" pkg.name
665 (display_percent pkg.size top_total) (display_size pkg.size) pkg.size
666 (display_percent increm top_total) (display_size increm) increm
667 (display_percent total top_total) (display_size total) total
672 let txt = pango_small_context#create_layout in
673 Pango.Layout.set_text txt (
677 Tot: %.1f%% %s" pkg.name
678 (display_percent pkg.size top_total) (display_size pkg.size)
679 (display_percent increm top_total) (display_size increm)
680 (display_percent total top_total) (display_size total)
685 let txt = pango_small_context#create_layout in
686 Pango.Layout.set_text txt (
687 sprintf "%s\nPkg: %.1f%%\nIncr: %.1f%%\nTot: %.1f%%"
689 (display_percent pkg.size top_total)
690 (display_percent increm top_total)
691 (display_percent total top_total)
696 let txt = pango_small_context#create_layout in
697 Pango.Layout.set_text txt (
698 sprintf "%s Pkg: %.1f%% %s Incr: %.1f%% %s Tot: %.1f%% %s" pkg.name
699 (display_percent pkg.size top_total) (display_size pkg.size)
700 (display_percent increm top_total) (display_size increm)
701 (display_percent total top_total) (display_size total)
706 let txt = pango_small_context#create_layout in
707 Pango.Layout.set_text txt (
708 sprintf "%s %.1f%% %.1f%% %.1f%%" pkg.name
709 (display_percent pkg.size top_total)
710 (display_percent increm top_total)
711 (display_percent total top_total)
716 let txt = pango_small_context#create_layout in
717 Pango.Layout.set_text txt (
718 sprintf "%s" pkg.name
722 let txts = [ txt1; txt2; txt3; txt4; txt5; txt6; txt7; txt8 ] in
724 let fore = choose_contrasting_colour colour in
726 let rec loop = function
729 let txt = Lazy.force txt in
730 let { Pango.width = txtwidth;
731 Pango.height = txtheight } =
732 Pango.Layout.get_pixel_extent txt in
733 (* Now with added fudge-factor. *)
734 if width >= txtwidth + 8 && height >= txtheight + 8 then
735 draw#put_layout ~x:(x+4) ~y:(y+4) ~fore txt
740 and draw_pkg_narrow x y width height colour pkg =
741 draw#set_foreground (choose_colour colour pkg);
742 draw#rectangle ~x:(x+2) ~y:(y+2)
743 ~width:(width-4) ~height:(height-4) ~filled:true ()
745 and choose_contrasting_colour = function
747 if r + g + b > 98304 then `BLACK else `WHITE
750 and choose_colour colour pkg =
754 let nevra = pkg.nevra in
757 (fun { pkg = { nevra = n } } -> n = nevra) current.parents in
760 (fun { pkg = { nevra = n } } -> n = nevra) current.children in
761 if is_parent && is_child then `RGB (63000, 63000, 0) (* yellow *)
762 else if is_parent then `RGB (0, 63000, 63000) (* cyan *)
763 else if is_child then `RGB (0, 63000, 0) (* green *)
766 and darken = function
768 `RGB (r * 9 / 10, g * 9 / 10, b * 9 / 10)
776 | Some (root, pkgs, depsmap, totalsmap, tree, depth, top_total) ->
777 real_repaint root pkgs depsmap totalsmap tree depth top_total
780 (* Return false because this is a Gtk event handler. *)
783 ignore (da#event#connect#expose ~callback:repaint);
785 let rec real_motion root pkgs depsmap totalsmap tree depth top_total ev =
786 let x, y = GdkEvent.Motion.x ev, GdkEvent.Motion.y ev in
788 let kill_tooltip () =
789 (match !tooltips with
791 | Some (tt : GData.tooltips) ->
792 tt#set_tip ~text:"" (da :> GObj.widget);
798 (match get_locn x y with
802 | Some (colour, pkg, total, increm) ->
803 (* Update 'current' which points to the currently moused package. *)
804 let dep = StringMap.find pkg.nevra depsmap in
805 set_current (Some dep);
807 let deps_of_string deps =
809 (List.sort (List.map (fun d -> d.pkg.nevra) deps))
812 (* The only way to make the tooltip follow the mouse is to
813 * kill the whole tooltips object and recreate it each time ...
816 let tt = GData.tooltips ~delay:100 () in
817 (* Tooltip text is the same as txt1 + extra. *)
818 let text = sprintf "%s
819 Package: %.1f%% %s (%Ld bytes)
820 Incremental: %.1f%% %s (%Ld bytes)
821 Total: %.1f%% %s (%Ld bytes)" pkg.nevra
822 (display_percent pkg.size top_total) (display_size pkg.size) pkg.size
823 (display_percent increm top_total) (display_size increm) increm
824 (display_percent total top_total) (display_size total) total in
825 let text = if dep.parents = [] then text else text ^ sprintf "
828 (deps_of_string dep.parents) in
829 let text = if dep.children = [] then text else text ^ sprintf "
832 (deps_of_string dep.children) in
833 tt#set_tip ~text (da :> GObj.widget);
841 | Some (root, pkgs, depsmap, totalsmap, tree, depth, top_total) ->
842 real_motion root pkgs depsmap totalsmap tree depth top_total ev
845 (* Return false because this is a Gtk event handler. *)
848 ignore (da#event#connect#motion_notify ~callback:motion);
850 window#add_accel_group accel_group;
856 (* Parse the command line arguments. *)
857 let anon_args = ref [] in
859 let argspec = Arg.align [
860 "--debug", Arg.Set debug_flag,
861 " " ^ "Enable debugging messages on stderr";
863 let anon_fun str = anon_args := str :: !anon_args in
865 "rpmdepsize [package] : visualize the size of RPM dependencies" in
867 Arg.parse argspec anon_fun usage_msg;
869 (* Should be at most one anonymous argument. *)
871 match !anon_args with
875 eprintf "rpmdepsize: too many command line arguments";
878 (* Open the main window. *)