#
#
# patch "app.ml"
#  from [834eb830af7b4c524b219cd8c928cc8e94ba1354]
#    to [07ab9f9e45097db0f3110a86bf82c966cea7ca8c]
#
# patch "automate.ml"
#  from [226131260a583b06dfd4c61465ea9c8635df5737]
#    to [bd6b8f753127cfd4676276294b96ebdfea404823]
#
# patch "basic_io_lexer.mli"
#  from [35b059d07b02f9b50d82d4156180da2d72414849]
#    to [20d5687ac500fa12ef010d839f80d7a7f5d05aea]
#
# patch "basic_io_lexer.mll"
#  from [c2a66033259ea5a40cdc0bf4620ca5b661a62179]
#    to [ba4720c3e3ad4457f5c75e1caf20cc562cda77f3]
#
# patch "main.ml"
#  from [ce99c7ae5acc3bc348255ed12b1972fc4e3405a7]
#    to [59666f3ce595ac5513666dfbf041dec11bc514ad]
#
# patch "monotone.ml"
#  from [3f63dcb34f5c5181bef95b8a5c8679928fb700b2]
#    to [07cf2f805ca932b3a36b66c26d680f4546f8bfe0]
#
# patch "monotone.mli"
#  from [501932e7b04b87a18442dd08c930e54f907c3474]
#    to [10c00b941773d4fd958d3eedf8b6f4d11b6c85a8]
#
# patch "revision.ml"
#  from [7ebe36ea4f1c4b9a6f0e9660d32ba991995b116e]
#    to [ed65760918027461605d1691fd2fc6f50e63cc47]
#
============================================================
--- app.ml	834eb830af7b4c524b219cd8c928cc8e94ba1354
+++ app.ml	07ab9f9e45097db0f3110a86bf82c966cea7ca8c
@@ -176,15 +176,14 @@ class ctrl w ~prefs ~manager ~status ~vi
       agraph <- None ;
       self#clear ;
       may
-	(fun db ->
+	(fun mtn ->
 	  Ui.Busy.start busy ;
 	  let g1 =
 	    (self#status "agraph")#with_status
 	      "Building ancestry graph"
 	      (fun () ->
-		Ui.nice_fetch
-		  (fun db -> Database.fetch_ancestry_graph db query.Viz_types.query)
-		  db) in
+		Ui.with_grab
+		  (fun () -> Monotone.agraph mtn query.Viz_types.query)) in
 	  let g2 =
 	    Agraph.make
 	      g1
@@ -200,7 +199,7 @@ class ctrl w ~prefs ~manager ~status ~vi
 		      view self
 		      query.Viz_types.preselect) in
 	  agraph <- Some g2)
-	db
+	mtn

     method private layout_params =
       let (w, h, cw) = View.Canvas.id_size view.View.canvas self in
============================================================
--- automate.ml	226131260a583b06dfd4c61465ea9c8635df5737
+++ automate.ml	bd6b8f753127cfd4676276294b96ebdfea404823
@@ -380,6 +380,7 @@ let _submit p cmd cb =


 let _submit p cmd cb =
+  Viz_misc.log "mtn" "sending command '%s'" (String.concat " " cmd) ;
   let id = p.cmd_number in
   send_data p id (encode_stdio cmd) ;
   p.cmd_number <- id + 1 ;
============================================================
--- basic_io_lexer.mli	35b059d07b02f9b50d82d4156180da2d72414849
+++ basic_io_lexer.mli	20d5687ac500fa12ef010d839f80d7a7f5d05aea
@@ -1,8 +1,12 @@ type v =
 type v =
   | ID of string
   | STRING of string
+  | MULT of string list
+  | NONE
 type stanza = (string * v) list
 type t = stanza list

 val get_stanza : Lexing.lexbuf -> stanza option
 val parse      : Lexing.lexbuf -> t
+
+val string_of_elem : v -> string
============================================================
--- basic_io_lexer.mll	c2a66033259ea5a40cdc0bf4620ca5b661a62179
+++ basic_io_lexer.mll	ba4720c3e3ad4457f5c75e1caf20cc562cda77f3
@@ -1,12 +1,34 @@
 {
   type v =
     | ID of string
     | STRING of string
+    | MULT of string list
+    | NONE
   type stanza = (string * v) list
   type t = stanza list

   let string_buffer =
     Buffer.create 128
+
+  let rec make_value lex_value lb =
+    match lex_value lb with
+    | `NL -> NONE
+    | `STRING s ->
+	begin
+	  match make_value lex_value lb with
+	  | NONE ->
+	      STRING s
+	  | STRING s2 ->
+	      MULT [ s ; s2 ]
+	  | MULT sl ->
+	      MULT (s :: sl)
+	  | ID _ ->
+	      failwith "Basic_io_lexer: value"
+	end
+    | `ID id ->
+	match lex_value lb with
+	| `NL -> ID id
+	| _ -> failwith "Basic_io_lexer: value"
 }

 let id    = ['a'-'f' '0'-'9']*
@@ -16,8 +38,7 @@ rule lex = parse

 rule lex = parse
   | ws                           { lex lexbuf }
-  | ident as k                   { let v = lex_value lexbuf in
-				   let _ = nl lexbuf in
+  | ident as k                   { let v = make_value lex_value lexbuf in
                                    `TOK (k, v) }
   | nl                           { `END_OF_STANZA }
   | eof                          { `EOF }
@@ -28,9 +49,10 @@ and lex_value = parse

 and lex_value = parse
   | ws                           { lex_value lexbuf }
-  | '[' (id as id) ']'           { ID id }
+  | nl                           { `NL }
+  | '[' (id as id) ']'           { `ID id }
   | '"'                          { Buffer.clear string_buffer ;
-				   STRING (string lexbuf) }
+				   `STRING (string lexbuf) }

 and string = parse
   | '"'                          { Buffer.contents string_buffer }
@@ -76,5 +98,12 @@ and string = parse

   let parse lb =
     _parse [] lb
+
+  let string_of_elem = function
+    | MULT (s :: _)
+    | STRING s
+    | ID s -> s
+    | MULT []
+    | NONE -> ""
 }

============================================================
--- main.ml	ce99c7ae5acc3bc348255ed12b1972fc4e3405a7
+++ main.ml	59666f3ce595ac5513666dfbf041dec11bc514ad
@@ -32,10 +32,7 @@ let parse_MTN_options mtn_file =
 	(mtn_file "options")
     with Not_found | Sys_error _ -> [] in
   List.map
-    (fun (k, v) ->
-      match v with
-      | Basic_io_lexer.STRING s
-      | Basic_io_lexer.ID s -> k, s)
+    (fun (k, v) -> k, Basic_io_lexer.string_of_elem v)
     (List.flatten stanzas)

 let parse_MTN_revision mtn_file =
============================================================
--- monotone.ml	3f63dcb34f5c5181bef95b8a5c8679928fb700b2
+++ monotone.ml	07cf2f805ca932b3a36b66c26d680f4546f8bfe0
@@ -38,9 +38,10 @@ let get_elem st k =


 let get_elem st k =
-  match List.assoc k st with
-  | Basic_io_lexer.STRING s
-  | Basic_io_lexer.ID s -> s
+  try
+    Basic_io_lexer.string_of_elem
+      (List.assoc k st)
+  with Not_found -> "??"

 let sig_verif = function
   | "ok"      -> SIG_OK
@@ -81,3 +82,134 @@ let select mtn selector =
     mtn [ "select" ; selector ]
     +> Viz_misc.string_split '\n'

+
+
+let selectors_of_query = function
+  | { dom = QUERY_ALL ;
+      lim = QUERY_NO_LIMIT } ->
+      []
+  | { dom = QUERY_BRANCHES b ;
+      lim = QUERY_NO_LIMIT } ->
+      List.map (fun s -> "b:" ^ s) b
+  | { dom = QUERY_ALL ;
+      lim = QUERY_BETWEEN (d1, d2) } ->
+      [ Printf.sprintf "l:%s/e:%s" d1 d2 ]
+  | { dom = QUERY_BRANCHES b ;
+      lim = QUERY_BETWEEN (d1, d2) } ->
+      let d = Printf.sprintf "l:%s/e:%s" d1 d2 in
+      List.map (fun s -> Printf.sprintf "%s/b:%s" d s) b
+
+let get_ids mtn query =
+  List.fold_left
+    (fun set s ->
+      List.fold_left
+	(fun set id -> IdSet.add id set)
+	set
+	(select mtn s))
+    IdSet.empty
+    (selectors_of_query query)
+
+let graph mtn =
+  Automate.submit_sync
+    mtn [ "graph" ]
+
+let decode_graph f init data =
+  let pos = ref 0 in
+  let acc = ref init in
+  begin
+    try
+      while true do
+	let e = String.index_from data !pos '\n' in
+	let nb = (e - !pos + 1) / 41 in (* len = 40 x k + k - 1 where k ∈ { 1, 2, 3 } *)
+	let id = String.sub data !pos 40 in
+	let p =
+	  if nb <= 1 then
+	    []
+	  else if nb <= 2 then
+	    [ String.sub data (!pos + 41) 40 ]
+	  else
+	    [ String.sub data (!pos + 41) 40 ; String.sub data (!pos + 82) 40 ] in
+	acc := f !acc id p ;
+	pos := e + 1
+      done
+    with Not_found -> ()
+  end ;
+  !acc
+
+let ensure_node agraph id kind family =
+  try
+    let n = NodeMap.find id agraph.nodes in
+    n.kind <- kind ;
+    n.family <- family @ n.family ;
+    agraph
+  with Not_found ->
+    let n = { id = id ; kind = kind ; family = family } in
+    { agraph with nodes = NodeMap.add id n agraph.nodes }
+
+let ensure_edge agraph i1 i2 e =
+  { agraph with ancestry = EdgeMap.add (i1, i2) e agraph.ancestry }
+
+let interesting_node id_set id =
+  id_set = IdSet.empty || IdSet.mem id id_set
+
+let add_node ids agraph id p =
+  if interesting_node ids id
+  then begin
+    let agraph =
+      ensure_node agraph id
+	(if List.length p >= 2 then MERGE else REGULAR)
+	(List.map (fun i -> i, PARENT) p) in
+    let p =
+      List.map (fun id_p -> id_p, interesting_node ids id_p) p in
+    List.fold_left
+      (fun agraph (id_p, is_reg) ->
+	let agraph =
+	  ensure_node agraph id_p
+	    (if is_reg then REGULAR else NEIGHBOUR_IN)
+	    [ id, CHILD ] in
+	ensure_edge agraph
+	  id_p id
+	  (if is_reg then SAME_BRANCH else BRANCHING_NEIGH))
+      agraph p
+  end
+  else
+    match List.filter (interesting_node ids) p with
+    | [] ->
+	agraph
+    | p ->
+	let agraph =
+	  ensure_node agraph id
+	    NEIGHBOUR_OUT
+	    (List.map (fun i -> i, PARENT) p) in
+	List.fold_left
+	  (fun agraph id_p ->
+	    let agraph =
+	      ensure_node agraph id_p
+		REGULAR [ id, CHILD ] in
+	    ensure_edge agraph
+	      id_p id BRANCHING_NEIGH)
+	  agraph p
+
+let grab_tags mtn agraph =
+  Automate.submit_sync mtn [ "tags" ]
+    +> Lexing.from_string
+    +> Basic_io_lexer.parse
+    +> List.fold_left (fun agraph st ->
+      try
+	let n = NodeMap.find (get_elem st "revision") agraph.nodes in
+	n.kind <- TAGGED (get_elem st "tag") ;
+	agraph
+      with Not_found -> agraph)
+    agraph
+
+let agraph mtn query =
+  let ids = get_ids mtn query in
+  graph mtn
+    +> decode_graph (add_node ids) empty_agraph
+    +> grab_tags mtn
+
+(* TODO:
+   - the "all_propagates" switch
+   - branching edges
+   - spanning edges
+ *)
============================================================
--- monotone.mli	501932e7b04b87a18442dd08c930e54f907c3474
+++ monotone.mli	10c00b941773d4fd958d3eedf8b6f4d11b6c85a8
@@ -9,3 +9,4 @@ val select : t -> string -> string list
 val get_certs_and_revision : t -> string -> Viz_types.node_data
 val cert_value : t -> string -> string -> string list
 val select : t -> string -> string list
+val agraph : t -> Viz_types.query -> Viz_types.agraph
============================================================
--- revision.ml	7ebe36ea4f1c4b9a6f0e9660d32ba991995b116e
+++ revision.ml	ed65760918027461605d1691fd2fc6f50e63cc47
@@ -19,6 +19,8 @@ type tok = Basic_io_lexer.v =
 type tok = Basic_io_lexer.v =
   | ID of string
   | STRING of string
+  | MULT of string list
+  | NONE


 let rec _star acc p = parser