# # patch "main.ml" # from [d28cf22acf96dbbc12206b6e4b3965bd39299617] # to [ee04cdcfaf5e0fbf0e24f71be66c3a8bdcbb4640] # # patch "ui.ml" # from [3c6f04a0d57dbed565e1305c6cdab1c8c6db2253] # to [b7ef06298881927e45f40ca98daf6cb02da81efa] # # patch "view.ml" # from [ede5932de2c0b8af4c78f3694a9bfeb3be9f9261] # to [83f362ba3f6afabb069a8bf1fb0db6c2d31d440f] # # patch "view.mli" # from [e5c355a71b30159cdce2eb5f6073b73e66e05ba6] # to [30ccdc219586dfe86f23cbc5e3715ff40238e6be] # ======================================================================== --- main.ml d28cf22acf96dbbc12206b6e4b3965bd39299617 +++ main.ml ee04cdcfaf5e0fbf0e24f71be66c3a8bdcbb4640 @@ -1,9 +1,10 @@ open Viz_misc type mt_options = | MTopt_none | MTopt_db of string - | MTopt_full of string * string + | MTopt_branch of string * string + | MTopt_full of string * string * string let unquote s = if s.[0] = '"' @@ -28,8 +29,11 @@ else up (Sys.getcwd ()) let parse_MT_options () = + let mt_file = + let mt_dir = Lazy.lazy_from_fun find_MT_dir in + fun f -> Filename.concat (Lazy.force mt_dir) f in match - try with_file_in input_lines (Filename.concat (find_MT_dir ()) "options") + try with_file_in input_lines (mt_file "options") with Not_found | Sys_error _ -> [] with | [] -> MTopt_none | lines -> @@ -49,7 +53,13 @@ let db = Glib.Convert.filename_from_utf8 db_raw in match may_assoc "branch" options with | Some branch when Glib.Utf8.validate branch -> - MTopt_full (db, branch) + begin + try + let revision = with_file_in input_line (mt_file "revision") in + MTopt_full (db, branch, revision) + with Sys_error _ -> + MTopt_branch (db, branch) + end | _ -> MTopt_db db with Glib.Convert.Error _ -> @@ -61,10 +71,14 @@ parse_MT_options () | db :: [] | db :: "" :: _ -> MTopt_db db - | db :: branch_raw :: _ -> + | db :: branch_raw :: rest -> try let branch = Glib.Convert.locale_to_utf8 branch_raw in - MTopt_full (db, branch) + match rest with + | [] | "" :: _ -> + MTopt_branch (db, branch) + | revision :: _ -> + MTopt_full (db, branch, revision) with Glib.Convert.Error _ -> MTopt_db db @@ -73,7 +87,7 @@ let aa = ref true in let cli_args = [ "-noaa", Arg.Clear aa, "don't use an anti-aliased canvas" ] in let usg_msg = - Printf.sprintf "usage: %s [options] [db [branch]]" + Printf.sprintf "usage: %s [options] [db [branch [revision]]]" (Filename.basename Sys.executable_name) in Arg.parse cli_args (fun a -> anons := Q.push !anons a) usg_msg ; (!aa, parse_options (Q.to_list !anons)) @@ -107,9 +121,11 @@ match mt_options with | MTopt_none -> () | MTopt_db fname -> - View.open_db v fname None - | MTopt_full (fname, branch) -> - View.open_db v fname (Some branch) + View.open_db v fname + | MTopt_branch (fname, branch) -> + View.open_db v ~branch fname + | MTopt_full (fname, branch, id) -> + View.open_db v ~id ~branch fname with Viz_types.Error msg -> View.error_notice ~parent:w msg end ; ======================================================================== --- ui.ml 3c6f04a0d57dbed565e1305c6cdab1c8c6db2253 +++ ui.ml b7ef06298881927e45f40ca98daf6cb02da81efa @@ -374,7 +374,7 @@ action_connect "/toolbar/Open" (fun () -> may - (fun db_fname -> View.open_db v db_fname None) + (fun db_fname -> View.open_db v db_fname) (show_open_dialog open_dialog)) ; action_connect "/toolbar/Quit" GMain.quit ; ======================================================================== --- view.ml ede5932de2c0b8af4c78f3694a9bfeb3be9f9261 +++ view.ml 83f362ba3f6afabb069a8bf1fb0db6c2d31d440f @@ -59,12 +59,17 @@ cert_view : GTree.view ; } +type select_info = { + query : Viz_types.query ; + preselect : string option ; + } type branch_selector = { combo : GEdit.combo_box GEdit.text_combo ; mutable combo_signal : GtkSignal.id option ; sub : GButton.toggle_button ; mutable branches : string array ; - select_signal : Viz_types.query Signal.t ; + select_signal : select_info Signal.t ; + mutable preselected_id : string option ; } type event = [ @@ -75,7 +80,7 @@ | `UPDATE_END | `NODE_SELECT of string | `NODE_POPUP of string * int - | `NODE_SWITCH_BRANCH of string] + | `NODE_SWITCH_BRANCH of string * string] type canvas = { w : GnoCanvas.canvas ; @@ -366,16 +371,18 @@ module Branch_selector = struct let select_branch s = let (combo, _) = s.combo in + let id = s.preselected_id in + s.preselected_id <- None ; try + let query = + match combo#active with + | -1 -> raise Exit + | 0 -> ALL + | i -> + let b = s.branches.(i - 1) in + if s.sub#active then COLLECTION b else BRANCH b in Signal.emit s.select_signal - begin - match combo#active with - | -1 -> raise Exit - | 0 -> ALL - | i -> - let b = s.branches.(i - 1) in - if s.sub#active then COLLECTION b else BRANCH b - end + { query = query ; preselect = id } with Exit -> () let with_inactive_combo ({ combo = (combo, _) } as s) f = @@ -409,7 +416,8 @@ let c = { combo = combo ; combo_signal = None ; sub = checkb ; branches = [||] ; - select_signal = Signal.make () } in + select_signal = Signal.make () ; + preselected_id = None } in begin let callback () = ignore (Glib.Idle.add (fun () -> @@ -432,6 +440,7 @@ let clear { selector = s } = s.branches <- [||] ; + s.preselected_id <- None ; with_inactive_combo s (fun (_, (model, _)) -> model#clear ()) @@ -455,8 +464,9 @@ end) br) - let set_branch { selector = s } b = + let set_branch { selector = s } ?id b = let (combo, _) = s.combo in + s.preselected_id <- id ; combo#set_active begin try 1 + array_index s.branches b @@ -694,18 +704,13 @@ center_on v (Agraph.get_node g id) | None -> () - module PQueue = Heap.Imperative (struct - type t = float * (unit -> unit) - let compare ((x, _) : t) (y, _) = compare x y - end) - let default_node_props = [ `OUTLINE_COLOR "black" ; `WIDTH_PIXELS 2 ], [ `FILL_COLOR "black" ] let border = 10. - let update_graph v = + let update_graph v preselect_id = let canvas = v.canvas.w in let graph = some v.agraph in let layout = Agraph.get_layout graph in @@ -804,11 +809,11 @@ true | _ -> false end - | `TWO_BUTTON_PRESS b when is_neighbor node -> - if GdkEvent.Button.button b = 1 then begin + | `TWO_BUTTON_PRESS b when is_neighbor node && GdkEvent.Button.button b = 1 -> + begin match Database.fetch_cert_value db id "branch" with | other_branch :: _ -> - Signal.emit v.event_signal (`NODE_SWITCH_BRANCH other_branch) + Signal.emit v.event_signal (`NODE_SWITCH_BRANCH (other_branch, id)) | [] -> () end ; true | _ -> false)) ; @@ -862,30 +867,55 @@ | _ -> false)) ; v.canvas.branch_items <- Some main_group ; - let q = PQueue.create 256 in - let count = ref 0 in - NodeMap.iter - (fun id n -> - incr count ; - let p = if lr_layout then n.n_x else n.n_y in - PQueue.add q (p, node_item id n)) - layout.c_nodes ; - EdgeMap.iter - (fun edge spl -> - incr count ; - let p = - let len = Array.length spl.controlp in - spl.controlp.(if lr_layout then len - 2 else len - 1) in - PQueue.add q (p, edge_item edge spl)) - layout.c_edges ; + let presel_node = + maybe (fun id -> NodeMap.find id layout.c_nodes) preselect_id in + let enqueue v (q, count) = + (v :: q, count + 1) in + let acc = + ([], 0) in + let acc = + let prio n = + match presel_node with + | None when lr_layout -> n.n_x + | None -> n.n_y + | Some p when lr_layout -> ~-. (abs_float (n.n_x -. p.n_x)) + | Some p -> ~-. (abs_float (n.n_y -. p.n_y)) in + NodeMap.fold + (fun id n acc -> + enqueue (prio n, node_item id n) acc) + layout.c_nodes + acc in + let q, count = + let prio spl = + let len = Array.length spl.controlp in + match presel_node with + | None when lr_layout -> spl.controlp.(len - 2) + | None -> spl.controlp.(len - 1) + | Some p when lr_layout -> + ~-. (abs_float (spl.controlp.(len - 2) -. p.n_x)) + | Some p -> + ~-. (abs_float (spl.controlp.(len - 1) -. p.n_y)) in + EdgeMap.fold + (fun edge spl acc -> + enqueue (prio spl, edge_item edge spl) acc) + layout.c_edges + acc in + let q = + List.sort + (fun ((p1 : float), _) (p2, _) -> compare p2 p1) + q in let id = + let q = ref q in Glib.Idle.add (fun () -> try for i = 1 to 10 do - snd (PQueue.pop_maximum q) () + match !q with + | [] -> raise Exit + | (_, action) :: tl -> + q := tl ; action () done ; true - with Heap.EmptyHeap -> + with Exit -> v.canvas.background_rendering <- None ; pr#progress_end () ; set_busy_cursor v.canvas false ; @@ -894,8 +924,11 @@ | exn -> Printf.eprintf "Uncaught exception: '%s'\n%!" (Printexc.to_string exn) ; true) in + may + (fun id -> ignore (Glib.Idle.add (fun () -> center_on_by_id v id ; false))) + preselect_id ; v.canvas.background_rendering <- Some id ; - pr#progress_start "Drawing ancestry graph ..." !count ; + pr#progress_start "Drawing ancestry graph ..." count ; set_busy_cursor v.canvas true ; Signal.emit v.event_signal `UPDATE_BEGIN @@ -991,7 +1024,7 @@ -let handle_query v query = +let handle_query v ?id query = may (fun db -> may Agraph.abort_layout v.agraph ; @@ -1012,7 +1045,7 @@ | `LAYOUT_ERROR msg -> error_notice ~parent:v.canvas.w msg | `LAYOUT_DONE -> - Canvas.update_graph v))) + Canvas.update_graph v id))) v.db @@ -1033,7 +1066,7 @@ may Database.close_db v.db -let open_db v fname branch = +let open_db v ?id ?branch fname = (* fname should be in filesystem encoding, branch should be UTF-8 *) close v ; @@ -1042,7 +1075,7 @@ v.db <- Some db ; Branch_selector.populate v (nice_fetch Database.fetch_branches db) ; - may (Branch_selector.set_branch v) branch ; + may (Branch_selector.set_branch v ?id) branch ; Signal.emit v.event_signal `OPEN_DB with Viz_types.Error msg -> error_notice ~parent:v.canvas.w msg @@ -1085,7 +1118,8 @@ drag_active = false } in - Branch_selector.connect v (handle_query v) ; + Branch_selector.connect v + (fun i -> handle_query v ?id:i.preselect i.query) ; begin let clipboard = GData.clipboard Gdk.Atom.primary in @@ -1115,7 +1149,6 @@ (Str.split (Str.regexp "\r\n") sel#data) in open_db v (Viz_misc.string_slice ~s:7 f) - None with Not_found -> () end)) ; @@ -1168,8 +1201,8 @@ | `NODE_SELECT id -> Canvas.display_selection_marker v id ; Info_Display.fetch_and_display_data v id - | `NODE_SWITCH_BRANCH branch -> - Branch_selector.set_branch v branch + | `NODE_SWITCH_BRANCH (branch, id) -> + Branch_selector.set_branch v ~id branch | `CLEAR -> Info_Display.clear_info v ; KeyNav.clear v ; @@ -1188,7 +1221,7 @@ may (fun db -> let branch = Branch_selector.get_branch v in let fname = Database.get_filename db in - open_db v fname branch) + open_db v ?id:v.selected_node ?branch fname) v.db @@ -1243,7 +1276,7 @@ handle_query v (Agraph.get_query g) | Some g when !need_redraw -> Canvas.clear v ; - Canvas.update_graph v + Canvas.update_graph v v.selected_node | _ -> () let get_ancestors v id = ======================================================================== --- view.mli e5c355a71b30159cdce2eb5f6073b73e66e05ba6 +++ view.mli 30ccdc219586dfe86f23cbc5e3715ff40238e6be @@ -7,6 +7,7 @@ val set_busy_cursor : #GObj.widget -> bool -> unit type info_display +type select_info type branch_selector type event = [ `CLEAR @@ -16,7 +17,7 @@ | `UPDATE_END | `NODE_SELECT of string | `NODE_POPUP of string * int - | `NODE_SWITCH_BRANCH of string] + | `NODE_SWITCH_BRANCH of string * string] type canvas type keyboard_nav type find @@ -45,11 +46,11 @@ module Branch_selector : sig val make : packing:(GObj.widget -> unit) -> branch_selector * find - val connect : t -> (Viz_types.query -> unit) -> unit + val connect : t -> (select_info -> unit) -> unit val get_display_sub_branches : t -> bool val clear : t -> unit val populate : t -> string list -> unit - val set_branch : t -> string -> unit + val set_branch : t -> ?id:string -> string -> unit val get_branch : t -> string option end @@ -67,7 +68,7 @@ val clear : t -> unit val center_on : t -> string * Viz_types.c_node -> unit val center_on_by_id : t -> string -> unit - val update_graph : t -> unit + val update_graph : t -> string option -> unit end module Find : @@ -83,7 +84,7 @@ val connect_event : t -> (event -> unit) -> unit val close : t -> unit val finalize : t -> unit -val open_db : t -> string -> string option -> unit +val open_db : t -> ?id:string -> ?branch:string -> string -> unit val reload : t -> unit val zoom : t -> [< `IN | `OUT ] -> unit -> unit val display_certs : t -> string -> unit