#
# patch "database.ml"
# from [71b2ddb5568b0ebb79cd126a3e47849ab8b64b37]
# to [8bed9e273720671d912a5ec433f82ccef4150522]
#
# patch "database.mli"
# from [92a7d49361cafc56f963f7d5188f9705f3f53705]
# to [e94e03fdf58c03a0229b72f1ff1bfcf7533afb65]
#
# patch "view.ml"
# from [e1aa0f35c08c8299262d4a5878f28b6f472796cf]
# to [80d4521aa9ca2c89b47e7acee54aa862f2a7d380]
#
========================================================================
--- database.ml 71b2ddb5568b0ebb79cd126a3e47849ab8b64b37
+++ database.ml 8bed9e273720671d912a5ec433f82ccef4150522
@@ -502,6 +502,10 @@
get_matching_cert db.db "date"
(string_is_prefix d_pref)
+let get_matching_ids db id_pref =
+ get_matching_cert db.db "branch"
+ (string_is_prefix id_pref)
+
let run_monotone_diff db monotone_exe status cb (old_id, new_id) =
ignore (spawn_monotone
monotone_exe db.filename
========================================================================
--- database.mli 92a7d49361cafc56f963f7d5188f9705f3f53705
+++ database.mli e94e03fdf58c03a0229b72f1ff1bfcf7533afb65
@@ -20,6 +20,7 @@
val get_matching_tags : t -> (string -> bool) -> (string * string) list
val get_matching_dates : t -> string -> (string * string) list
+val get_matching_ids : t -> string -> (string * string) list
val get_key_rowid : t -> string -> int
========================================================================
--- view.ml e1aa0f35c08c8299262d4a5878f28b6f472796cf
+++ view.ml 80d4521aa9ca2c89b47e7acee54aa862f2a7d380
@@ -292,7 +292,91 @@
+module Complete = struct
+ let is_id =
+ let re = Str.regexp "^[0-9a-fA-F]+$" in
+ fun id -> Str.string_match re id 0
+ let is_date =
+ let re = Str.regexp "[0-9][0-9][0-9][0-9]-[0-9][0-9]-[0-9][0-9]" in
+ fun id -> Str.string_partial_match re id 0
+
+ let complete_with_db ctrl f =
+ match ctrl#get_db with
+ | None -> []
+ | Some db -> f db
+
+ let complete_id ctrl query_domain q =
+ complete_with_db ctrl
+ (fun db ->
+ let data = Database.get_matching_ids db q in
+ match query_domain with
+ | QUERY_ALL -> data
+ | QUERY_BRANCHES allowed_branches ->
+ List.filter
+ (fun (_, branch_name) -> List.mem branch_name allowed_branches)
+ data)
+
+ let complete_tag ctrl q =
+ complete_with_db ctrl
+ (fun db ->
+ let re = Str.regexp q in
+ Database.get_matching_tags db
+ (fun t -> Str.string_match re t 0))
+
+ let get_id_and_uniquify data =
+ data
+ ++ List.map fst
+ ++ List.sort compare
+ ++ Viz_misc.list_uniq
+
+ let several_completions parent (t, ids) =
+ let txt = Buffer.create 128 in
+ Printf.bprintf txt
+ "Several possible completions for %s :\n\n"
+ (Glib.Markup.escape_text t) ;
+ List.iter
+ (fun id -> Printf.bprintf txt " %s\n" id)
+ ids ;
+ Printf.bprintf txt "" ;
+ let m =
+ GWindow.message_dialog
+ ~message:(Buffer.contents txt)
+ ~use_markup:true
+ ~message_type:`INFO
+ ~buttons:GWindow.Buttons.close
+ ~parent
+ ~destroy_with_parent:true
+ ~title:"Monotone-viz - Date completion" () in
+ ignore (m#connect#response (fun _ -> m#destroy ())) ;
+ m#show ()
+
+ exception None
+ exception Many of (string * string list)
+
+ let complete_date ctrl domain t =
+ if is_date t
+ then t
+ else
+ let match_data =
+ if is_id t
+ then complete_id ctrl domain t
+ else complete_tag ctrl t in
+ match get_id_and_uniquify match_data with
+ | [] -> raise None
+ | [ id ] ->
+ begin
+ match Database.fetch_cert_value (some ctrl#get_db) id "date" with
+ | t :: _ -> t
+ | [] -> raise None
+ end
+ | ids ->
+ raise (Many (t, ids))
+end
+
+
+
+
module Branch_selector = struct
type t = {
button : GButton.button ;
@@ -372,6 +456,9 @@
(* The radio buttons for the date limit *)
let packing = Ui.category "Date limit" packing in
+ let tooltips = GData.tooltips () in
+ let date_entry_tooltip_text =
+ "Specify a date (YYYY-MM-DD), a tag or a revision id" in
let tbl =
GPack.table
~columns:2 ~rows:3
@@ -393,8 +480,10 @@
hb#misc#set_sensitive false ;
Ui.add_label "from " packing ;
let e1 = GEdit.entry ~packing () in
+ tooltips#set_tip ~text:date_entry_tooltip_text e1#coerce ;
Ui.add_label " to " packing ;
let e2 = GEdit.entry ~packing ~activates_default:true () in
+ tooltips#set_tip ~text:date_entry_tooltip_text e2#coerce ;
ignore (e1#connect#activate (fun () -> e2#misc#grab_focus ())) ;
(button, e1, e2) in
let b3, entry_dur, kind, entry_id =
@@ -404,8 +493,10 @@
~packing:(tbl#attach ~left:0 ~top:2) () in
let hb = GPack.hbox ~packing:(tbl#attach ~left:1 ~top:2 ~expand:`X) () in
let packing = hb#pack ~padding:4 in
+(*
ignore (button#connect#toggled (fun () ->
hb#misc#set_sensitive button#active)) ;
+*)
hb#misc#set_sensitive false ;
let e1 = GEdit.entry ~packing () in
let tc =
@@ -489,15 +580,17 @@
then QUERY_ALL
else QUERY_BRANCHES !acc
- let make_query_limit_interval s_from s_to =
- QUERY_NO_LIMIT
+ let make_query_limit_interval ctrl domain s_from s_to =
+ let t_from = Complete.complete_date ctrl domain s_from in
+ let t_to = Complete.complete_date ctrl domain s_to in
+ QUERY_BETWEEN (t_from, t_to)
- let make_query_limit_span s_dur s_kind s_id =
+ let make_query_limit_span ctrl domain s_dur s_kind s_id =
+ let t_ref = Complete.complete_date ctrl domain s_id in
QUERY_NO_LIMIT
-
- let make_query ?id s =
+ let make_query ctrl ?id s =
try
let query_domain = get_query_domain s in
let query_limit =
@@ -505,17 +598,19 @@
| 0 ->
QUERY_NO_LIMIT
| 1 ->
- make_query_limit_interval
+ make_query_limit_interval ctrl query_domain
s.entries.(0)#text s.entries.(1)#text
| _ ->
- make_query_limit_span
+ make_query_limit_span ctrl query_domain
s.entries.(2)#text
(GEdit.text_combo_get_active s.span_kind)
s.entries.(3)#text in
Some { query = (query_domain, query_limit) ;
preselect = id }
- with exn ->
- None
+ with
+ | Complete.None -> None
+ | Complete.Many compl ->
+ Complete.several_completions s.w compl ; None
let adjust_view_button_sensitivity s =
s.w#set_response_sensitive `VIEW (s.selected_b > 0)
@@ -569,7 +664,7 @@
(fun q ->
s.w#misc#hide () ;
ctrl#query q)
- (make_query s)))
+ (make_query ctrl s)))
module Trie = struct
@@ -680,7 +775,7 @@
(fst s.span_kind)#set_active span_kind ;
may
ctrl#query
- (make_query ?id s)
+ (make_query ctrl ?id s)
let set_branch s ctrl ?id br =
@@ -697,7 +792,7 @@
adjust_view_button_sensitivity s ;
may
ctrl#query
- (make_query ?id s)
+ (make_query ctrl ?id s)
let present_dialog s =
s.button#clicked ()
@@ -1273,10 +1368,6 @@
find.find_entry#set_text "" ;
find.last_find <- "", []
- let is_id =
- let re = Str.regexp "^[0-9a-fA-F]*$" in
- fun id -> Str.string_match re id 0
-
let locate_id ctrl id =
match ctrl#get_agraph with
| None -> []
@@ -1292,10 +1383,6 @@
else acc)
(Agraph.get_layout g).c_nodes []
- let is_date =
- let re = Str.regexp "[0-9][0-9][0-9][0-9]-[0-9][0-9]-[0-9][0-9]$" in
- fun id -> Str.string_partial_match re id 0
-
let locate_with_db ctrl f =
match ctrl#get_db with
| None -> []
@@ -1327,9 +1414,9 @@
| _ ->
let candidates =
try
- if is_id q
+ if Complete.is_id q
then locate_id ctrl q
- else if is_date q
+ else if Complete.is_date q
then locate_date ctrl q
else locate_tag ctrl q
with Failure _ | Invalid_argument _ -> [] in