+ (* This is the currently open package, or None if nothing has
+ * opened by the user yet.
+ *)
+ let opened = ref None 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);
+
+ (* 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];
+
+ let tooltips = 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
+
+ (* To track tooltips, the 'repaint' function records the location of
+ * each box (ie. package) in the drawing area in this private data
+ * structure, and the 'motion' function looks them up in order to
+ * display the right tooltip over each box.
+ *)
+ let add_locn, reset_locns, get_locn =
+ let rows = ref [||] in
+ let rowheight = ref 0. in
+
+ let reset_locns rowheight' depth =
+ (* This data structure sucks because we just do a linear search
+ * over each row when looking up the 'x'. Should use some sort
+ * of self-balancing tree instead. XXX
+ *)
+ rows := Array.init depth (fun _ -> ref []);
+ rowheight := rowheight'
+ and add_locn x yi width thing =
+ let row = (!rows).(yi) in
+ row := ((x, x +. width), thing) :: !row
+ and get_locn x y =
+ let yi = int_of_float (y /. !rowheight) in
+ if yi >= 0 && yi < Array.length !rows then (
+ let row = !((!rows).(yi)) in
+ try Some
+ (snd (List.find (fun ((xlow, xhi), thing) ->
+ xlow <= x && x < xhi)
+ row))
+ with Not_found -> None
+ )
+ else None
+ in
+ add_locn, reset_locns, get_locn
+ in
+
+ let rec real_repaint root pkgs depsmap totalsmap tree depth top_total =