# 
# 
# patch "agraph.ml"
#  from [6eecb1bfd0370d394ea4311512029a3d10676c52]
#    to [a1fbfdb58c3ff99dfde25b729f89c7503c4d5e9b]
# 
# patch "database.ml"
#  from [7604187a479916f97c38d7e9e3fa5bf392f48c24]
#    to [450047b3d2042b15cb627188f47bc09547b1c6af]
# 
# patch "view.ml"
#  from [3ea5a5c223697b104c3cd158ec06b89f510323ad]
#    to [1939b8c99f699eb33005125453a29933794bbb90]
# 
# patch "viz_types.ml"
#  from [fa26708f30ff98ccee703267a4d5567c9a0545c9]
#    to [155a8730aa4d15f76597efa96a689bc01e39b76f]
# 
# patch "viz_types.mli"
#  from [2f027d5caef8b2f45a32eea1e3e165894f4437b5]
#    to [1f4386c49f92acb7c868e93ccf62986219a3da49]
# 
============================================================
--- agraph.ml	6eecb1bfd0370d394ea4311512029a3d10676c52
+++ agraph.ml	a1fbfdb58c3ff99dfde25b729f89c7503c4d5e9b
@@ -21,6 +21,9 @@ let ppi = 72.
 
 let ppi = 72.
 
+let node_kind agraph id =
+  (NodeMap.find id agraph.nodes).kind
+
 
 (* DOT output *)
 
@@ -32,9 +35,10 @@ let find_heads agraph =
 	IdSet.add child children)
       agraph.ancestry
       (IdSet.empty, IdSet.empty) in
-  IdSet.diff
+  IdSet.filter
+    (fun id ->
+      not (neighbour_kind (node_kind agraph id)))
     (IdSet.diff children parents)
-    agraph.neighbour_nodes
 
 let dot_format params agraph =
   let b = Buffer.create 4096 in
@@ -102,10 +106,7 @@ let dot_format params agraph =
 	!+ "  %S -> %S" s t ;
 	if kind = SPANNING then !+ " [minlen = 5]" ;
 	if IdSet.mem t heads then !+ " [weight = 2]" ;
-	!+ " ;\n" ;
-	if IdSet.mem t agraph.neighbour_nodes 
-	    && not (IdSet.mem s agraph.neighbour_nodes)
-	then !+ "  { rank = same ; %S ; %S }" s t)
+	!+ " ;\n")
       agraph.ancestry
   end ;
 
@@ -143,7 +144,7 @@ let convert_node agraph nodes node_attr 
 let convert_node agraph nodes node_attr id a =
   let this_node_attr = update_node_attr node_attr a in
   try
-    let kind = (NodeMap.find id agraph.nodes).kind in
+    let kind = node_kind agraph id in
     let width  = ppi *. this_node_attr.width in
     let height = ppi *. this_node_attr.height in
     let (x, y) = 
============================================================
--- database.ml	7604187a479916f97c38d7e9e3fa5bf392f48c24
+++ database.ml	450047b3d2042b15cb627188f47bc09547b1c6af
@@ -6,9 +6,6 @@ let monot_decode s = Base64.decode ~acce
 let monot_encode s = Base64.encode ~linelength:72 s
 let monot_decode s = Base64.decode ~accept_spaces:true s
 
-let sql_escape s =
-  String.concat "''" (string_split ~collapse:false '\'' s)
-
 let may_decode base64 v =
   if base64 then monot_decode v else v
 
@@ -77,102 +74,60 @@ let sql_of_bool b = if b then `INT 1 els
 
 let sql_of_bool b = if b then `INT 1 else `INT 0
 
-let id_set_add_if t v s =
-  if t && v <> "" then IdSet.add v s else s
 
-let add_node kind id rel_id rel nodes =
-  try
-    let current_node = NodeMap.find id nodes in
-    if List.mem_assoc rel_id current_node.family
-    then 
-      nodes
-    else 
-      NodeMap.add id 
-	{ current_node with family = (rel_id, rel) :: current_node.family }
-	nodes
-  with Not_found -> 
-    NodeMap.add id 
-      { id = id ; kind = kind ; family = [ rel_id, rel ] } 
-      nodes
 
+let get_relative n r =
+  List.fold_left
+    (fun acc -> function
+      | (id, rel) when r = rel -> id :: acc
+      | _  -> acc)
+    []
+    n.family
 
-let process_ancestry_row g parent parent_kind child child_kind =
-  assert (parent_kind = REGULAR || child_kind = REGULAR) ;
-  assert (parent <> "" && child <> "") ; 
-  { nodes    = (add_node parent_kind parent child CHILD (
-		add_node child_kind child parent PARENT g.nodes)) ;
+let count_parents n = 
+  List.length (get_relative n PARENT)
 
-    ancestry = 
-      EdgeMap.add (parent, child)
-        (if parent_kind = REGULAR && child_kind = REGULAR 
-         then SAME_BRANCH 
-         else BRANCHING)
-        g.ancestry ;
+let find_merge_nodes g =
+  NodeMap.iter 
+    (fun id node ->
+      if node.kind = REGULAR && count_parents node > 1
+      then node.kind <- MERGE)
+    g.nodes
 
-    neighbour_nodes = (id_set_add_if (parent_kind <> REGULAR) parent (
-		       id_set_add_if (child_kind  <> REGULAR) child
-			 g.neighbour_nodes))
-  }
+let count_all_parents db = 
+  let stmt =
+      Sqlite3.prepare_one
+      db "SELECT COUNT(parent) FROM revision_ancestry WHERE parent != '' AND child = ?" in
+  fun id ->
+    Sqlite3.reset stmt ;
+    Sqlite3.bind stmt 1 (`TEXT id) ;
+    Sqlite3.fold_rows
+      (fun _ stmt -> Sqlite3.column_int stmt 0)
+      0 stmt
 
-let process_ancestry_row_simple g = function
-  | [| "" ; child |] -> 
-      if not (NodeMap.mem child g.nodes) 
-      then begin
-	let new_node = { id = child ; kind = REGULAR ; family = [] } in
-	let nodes = NodeMap.add child new_node g.nodes in
-	{ g with nodes = nodes }
-      end
-      else g
+let count_regular_children db = 
+  let stmt =
+    Sqlite3.prepare_one db 
+      (Printf.sprintf 
+	 "SELECT COUNT(child) FROM revision_ancestry, %s WHERE parent = ? AND child = id"
+	 view_name_domain) in
+  fun id ->
+    Sqlite3.reset stmt ;
+    Sqlite3.bind stmt 1 (`TEXT id) ;
+    Sqlite3.fold_rows
+      (fun _ stmt -> Sqlite3.column_int stmt 0)
+      0 stmt
 
-  | [| parent ; child |] -> 
-      process_ancestry_row g 
-	parent REGULAR
-	child REGULAR
+let is_interesting_neighbour_out db = 
+  let count_p = count_all_parents db in
+  let count_c = count_regular_children db in
+  let start_of_branch id = 
+    count_p id = 1 in
+  let end_of_branch p_id =
+    count_c p_id = 0 in
+  fun id_parent id ->
+    start_of_branch id || end_of_branch id_parent
 
-  | _ -> g
-
-let process_ancestry_row_neigh_out g = function
-  | [| parent ; child ; "0" |] -> 
-	process_ancestry_row g 
-	  parent REGULAR
-	  child NEIGHBOUR_OUT
-  | [| parent ; child ; _ |] ->       
-      { g with ancestry = EdgeMap.add (parent, child) SAME_BRANCH g.ancestry }
-  | _ -> g
-
-let process_ancestry_row_neigh_in g = function
-  | [| parent ; child ; "0" |] -> 
-      process_ancestry_row g 
-	parent NEIGHBOUR_IN
-	child REGULAR
-  | [| parent ; child ; _ |] ->       
-      { g with ancestry = EdgeMap.add (parent, child) SAME_BRANCH g.ancestry }
-  | _ -> g
-
-
-let number_of_parent node =
-  List.fold_left
-    (fun n -> function 
-      | (_, PARENT) -> n + 1
-      | _ -> n)
-    0
-    node.family
-
-let find_merge_nodes nodes =
-  NodeMap.fold
-    (fun id node m ->
-      if number_of_parent node > 1
-      then NodeMap.add id { node with kind = MERGE } m
-      else m)
-    nodes
-    nodes
-
-let process_branching_edge_row g = function
-  | [| parent; child |] ->
-      { g with ancestry = EdgeMap.add (parent, child) BRANCHING g.ancestry }
-  | _ -> g
-
-
 let fetch_children db = 
   let stmt = lazy 
       (Sqlite3.prepare_one
@@ -186,24 +141,61 @@ let fetch_children db = 
       init
       stmt
 
+let collect_tags db base64 g =
+  Sqlite3.fetch_f db
+    (fun () row ->
+      let id = row.(0) in
+      let n = NodeMap.find id g.nodes in
+      let tag = may_decode base64 row.(1) in
+      n.kind <- TAGGED tag)
+    ()
+    "SELECT C.id, C.value FROM revision_certs AS C, %s AS D WHERE name = 'tag' AND C.id = D.id"
+    view_name_limit
 
-let collect_tags db base64 nodes =
-  let stmt = Sqlite3.prepare_one db 
-      "SELECT value FROM revision_certs WHERE id = ? AND name = 'tag'" in
-  NodeMap.fold
-    (fun id node m ->
-      Sqlite3.reset stmt ;
-      Sqlite3.bind stmt 1 (`TEXT id) ;
-      Sqlite3.fold_rows
-	(fun m stmt -> 
-	  let r = Sqlite3.column_blob stmt 0 in
-	  let v = may_decode base64 r in
-	  NodeMap.add id { node with kind = TAGGED v } m)
-	m
-	stmt)
-    nodes
-    nodes
 
+let ensure_node g id k =
+  try NodeMap.find id g.nodes, g
+  with Not_found ->
+    let n = { id = id ; kind = k ; family = [] } in
+    n, { g with nodes = NodeMap.add id n g.nodes }
+
+let process_regular_node g = function
+  | [| id |] ->
+      let _, g = ensure_node g id REGULAR in
+      g
+  | _ -> g
+
+let add_edge g id1 k1 id2 k2 ek = 
+  let n1, g = ensure_node g id1 k1 in
+  n1.family <- (id2, CHILD) :: n1.family ;
+  let n2, g = ensure_node g id2 k2 in
+  n2.family <- (id1, PARENT) :: n2.family ;
+  { g with ancestry = EdgeMap.add (id1, id2) ek g.ancestry }
+      
+
+let process_neighb_in g = function
+  | [| id ; child |] ->
+      add_edge g id NEIGHBOUR_IN child REGULAR BRANCHING_NEIGH
+  | _ -> g
+
+let process_neighb_out db =
+  let is_interesting = is_interesting_neighbour_out db in
+  fun g -> function
+    | [| parent ; id |] when is_interesting parent id ->
+	add_edge g parent REGULAR id NEIGHBOUR_OUT BRANCHING_NEIGH
+    | _ -> g
+
+let process_ancestry g = function
+  | [| parent ; child |] ->
+      add_edge g parent REGULAR child REGULAR SAME_BRANCH
+  | _ -> g
+
+let process_branching_edge g = function
+  | [| parent ; child |] ->
+      add_edge g parent REGULAR child REGULAR BRANCHING
+  | _ -> g
+      
+
 let fetch_agraph_with_view db base64 (query, query_limit) =
   let view_name_limit =
     if query_limit <> QUERY_NO_LIMIT
@@ -212,31 +204,40 @@ let fetch_agraph_with_view db base64 (qu
 
   let agraph = Viz_types.empty_agraph in
 
-  (* grab all node ids and edges we're interested in *)
+  (* grab all our main nodes *)
   let agraph =
-    Sqlite3.fetch_f db process_ancestry_row_simple agraph 
-      "SELECT parent, child FROM revision_ancestry, %s \
-        WHERE (parent = '' OR parent = id) AND child IN %s" view_name_limit view_name_limit in
+    Sqlite3.fetch_f db process_regular_node agraph 
+      "SELECT id FROM %s" view_name_limit in
 
-  (* also grab neighbor nodes *)
+  (* neighbor IN *)
   let agraph =
-    Sqlite3.fetch_f db process_ancestry_row_neigh_out agraph 
-      "SELECT parent, child, child IN %s FROM revision_ancestry \
-        WHERE parent IN %s AND child NOT IN %s"
-      view_name_domain view_name_limit view_name_limit in
+    Sqlite3.fetch_f db process_neighb_in agraph 
+      "SELECT parent, child \
+         FROM %s AS D, revision_ancestry AS A \
+        WHERE D.id = A.child AND A.parent != '' AND A.parent NOT IN %s"
+      view_name_limit view_name_domain in
+
+  (* neighbor OUT *)
   let agraph =
-    Sqlite3.fetch_f db process_ancestry_row_neigh_in agraph 
-      "SELECT parent, child, parent IN %s FROM revision_ancestry \
-        WHERE child IN %s AND parent != '' AND parent NOT IN %s"
-      view_name_domain view_name_limit view_name_limit in
+    Sqlite3.fetch_f db (process_neighb_out db) agraph 
+      "SELECT parent, child \
+         FROM %s AS D, revision_ancestry AS A \
+        WHERE D.id = A.parent AND A.child NOT IN %s"
+      view_name_limit view_name_domain in
 
+  (* ancestry *)
+  let agraph =
+    Sqlite3.fetch_f db process_ancestry agraph 
+      "SELECT parent, child \
+         FROM %s AS D1, revision_ancestry AS A, %s AS D2 \
+        WHERE D1.id = A.parent AND A.child = D2.id"
+      view_name_limit view_name_limit in
+
   (* find merge/propagate nodes (they have more than one parent) *)
-  let agraph =
-    { agraph with nodes = find_merge_nodes agraph.nodes } in
+  find_merge_nodes agraph ;
 
   (* get tags *)
-  let agraph =
-    { agraph with nodes = collect_tags db base64 agraph.nodes } in
+  collect_tags db base64 agraph ;
 
   (* determine the branching edges *)
   let agraph =
@@ -248,11 +249,12 @@ let fetch_agraph_with_view db base64 (qu
       | _ -> 
 	  (* we need another database query *)
 	  Sqlite3.fetch_f db
-	    process_branching_edge_row agraph
+	    process_branching_edge agraph
             "SELECT parent, child \
-               FROM revision_ancestry AS A \
-              WHERE A.child IN %s AND A.parent != '' AND \
-	            NOT EXISTS \
+               FROM %s, revision_ancestry \
+              WHERE id = child \
+                AND parent != '' \
+                AND NOT EXISTS \
                      (SELECT P.id FROM revision_certs AS C, revision_certs AS P \
                        WHERE C.id = A.child AND P.id = A.parent \
                              AND C.name = 'branch' AND P.name = 'branch' \
@@ -284,10 +286,7 @@ let fetch_with_view query base64 db f =
     | QUERY_BETWEEN (d1, d2) ->
 	Sqlite3.create_fun_1 db "date_p"
 	  (fun arg ->
-	    let d = 
-	      if base64
-	      then monot_decode (Sqlite3.value_text arg)
-	      else Sqlite3.value_blob arg in
+	    let d = may_decode base64 (Sqlite3.value_text arg) in
 	    sql_of_bool (d1 <= d && d <= d2))
     | _ -> () in
 
@@ -308,8 +307,8 @@ let fetch_with_view query base64 db f =
   let view_query_date_limit () =
     Printf.sprintf
       "CREATE TEMP TABLE %s AS \
-       SELECT DISTINCT id FROM revision_certs \
-        WHERE name = 'date' AND id IN %s AND date_p(value)"
+       SELECT DISTINCT id FROM %s NATURAL JOIN revision_certs \
+        WHERE name = 'date' AND date_p(value)"
       view_name_limit view_name_domain in
   
   Viz_misc.bracket
============================================================
--- view.ml	3ea5a5c223697b104c3cd158ec06b89f510323ad
+++ view.ml	1939b8c99f699eb33005125453a29933794bbb90
@@ -1252,7 +1252,8 @@ module Canvas = struct
       let color = 
 	match s.edge_kind with
 	  SAME_BRANCH -> "black"
-	| BRANCHING -> "orange"
+	| BRANCHING
+	| BRANCHING_NEIGH -> "orange"
 	| DISAPPROVED -> "red" 
 	| SPANNING -> "darkgrey" in
       let bpath = GnomeCanvas.PathDef.new_path () in
============================================================
--- viz_types.ml	fa26708f30ff98ccee703267a4d5567c9a0545c9
+++ viz_types.ml	155a8730aa4d15f76597efa96a689bc01e39b76f
@@ -44,11 +44,19 @@ type a_node = {
 type relation = PARENT | CHILD
 
 type a_node = {
-    id       : string ;
-    kind     : node_kind ;
-    family   : (string * relation) list ;
+            id       : string ;
+    mutable kind     : node_kind ;
+    mutable family   : (string * relation) list ;
   }
 
+let neighbour_kind = function
+  | NEIGHBOUR_IN
+  | NEIGHBOUR_OUT -> true
+  | REGULAR
+  | MERGE
+  | DISAPPROVE
+  | TAGGED _ -> false
+
 type node_data = {
     revision_id  : string ;
     manifest_id  : string ;
@@ -57,15 +65,15 @@ type edge_kind =
   }
 
 type edge_kind =
-  | BRANCHING
   | SAME_BRANCH
   | DISAPPROVED
+  | BRANCHING
+  | BRANCHING_NEIGH
   | SPANNING
 
 type agraph = {
   nodes           : a_node NodeMap.t ;
   ancestry        : edge_kind EdgeMap.t ;
-  neighbour_nodes : IdSet.t ;
 }
 
 type c_node = {
@@ -90,8 +98,7 @@ let empty_agraph = { nodes = NodeMap.emp
 }
 
 let empty_agraph = { nodes = NodeMap.empty; 
-		     ancestry = EdgeMap.empty; 
-		     neighbour_nodes = IdSet.empty }
+		     ancestry = EdgeMap.empty }
 let empty_cgraph = { bb = (0., 0., 0., 0.); 
 		     c_nodes = NodeMap.empty ; 
 		     c_edges = EdgeMap.empty }
============================================================
--- viz_types.mli	2f027d5caef8b2f45a32eea1e3e165894f4437b5
+++ viz_types.mli	1f4386c49f92acb7c868e93ccf62986219a3da49
@@ -47,11 +47,13 @@ type a_node = {
 type relation = PARENT | CHILD
 
 type a_node = {
-    id       : string ;
-    kind     : node_kind ;
-    family   : (string * relation) list ;
+            id       : string ;
+    mutable kind     : node_kind ;
+    mutable family   : (string * relation) list ;
   }
 
+val neighbour_kind : node_kind -> bool
+
 type node_data = {
     revision_id  : string ;
     manifest_id  : string ;
@@ -60,15 +62,16 @@ type edge_kind =
   }
 
 type edge_kind =
-  | BRANCHING
   | SAME_BRANCH
   | DISAPPROVED
+  | BRANCHING
+  | BRANCHING_NEIGH
   | SPANNING
 
+
 type agraph = {
   nodes           : a_node NodeMap.t ;
   ancestry        : edge_kind EdgeMap.t ;
-  neighbour_nodes : IdSet.t ;
 }
 
 type c_node = {