The unified diff between revisions [aaae92d1..] and [99d8190a..] is displayed below. It can also be downloaded as a raw diff.

#
#
# patch "Makefile"
#  from [32653cf1b11ec035b32a203fff2901341794ea76]
#    to [a85bfc4e3926532be115ff04e569720f5ae103fd]
#
# patch "NEWS"
#  from [b13365f9cd671224411dc354a0e549b37c204871]
#    to [b91db41ad4c5f746f901a2ac9744b748c2270a40]
#
# patch "README"
#  from [e9ec472a54765c5a05481be8b4cbf0879bdb49fe]
#    to [ca8f7f128d188deaecc95d31dc580154e53fd454]
#
# patch "agraph.ml"
#  from [c9152945a3b80583ed6fc6e8b8c45f69a75b62be]
#    to [6eecb1bfd0370d394ea4311512029a3d10676c52]
#
# patch "agraph.mli"
#  from [08e41b7cf67369cbf32876a38add40bfd2c09ba8]
#    to [6095dfc14ecc5804edac4d3cf1755af9382a6bb8]
#
# patch "app.ml"
#  from [1684eb27e8ef243f7c213acdb1eda2765549f067]
#    to [ecdd153474516d486e2ad04862b65f537522a10e]
#
# patch "configure.ac"
#  from [7bc8b6f9d4905cbce41553f06a011fcf0ea5c784]
#    to [f43ff3f89e46fbc86684dc6a2008b90cfd7c9355]
#
# patch "database.ml"
#  from [8050fdf19eecbfea0acd1b5f5db5bd6ace5967f4]
#    to [ed9278cbb1ee9179bb761ae8e21ebf91b1f13811]
#
# patch "database.mli"
#  from [e94e03fdf58c03a0229b72f1ff1bfcf7533afb65]
#    to [adea7c4edcb55913177145025fc45d57bad3c1b0]
#
# patch "main.ml"
#  from [b3012be53c72a238d19c83ecc734bfc33a2a2cd4]
#    to [8e7e32724f4bd07a10a9c6caee878dfff2b33281]
#
# patch "ui.ml"
#  from [966f78220372d018943bd4049f8ffc4e910098d0]
#    to [40c46b362676e4393b6730d7604018994344ebcd]
#
# patch "ui.mli"
#  from [616701fcf70199bc40d48051187777b1f55e632d]
#    to [d25fe1553276726e4cd998b1010d280139e5534b]
#
# patch "view.ml"
#  from [1e5e6a1a88d2bdc2627821f1e770b5aa4c3c86b3]
#    to [744a670f23e96b7cc95638ce3b3eed208a40460d]
#
# patch "view.mli"
#  from [fc58aa1b7db2d23c654b7c407ee1da2a2503ddcc]
#    to [10a06ee77ef495e988563bffb5a58bc03e2cd6eb]
#
# patch "viz_types.ml"
#  from [2348af90556459bd15ea99ce8d5b45b2f2dbe82c]
#    to [fa26708f30ff98ccee703267a4d5567c9a0545c9]
#
# patch "viz_types.mli"
#  from [c3524724d488bbf3da18ba9de56ab98d9a08599f]
#    to [2f027d5caef8b2f45a32eea1e3e165894f4437b5]
#
============================================================
--- Makefile	32653cf1b11ec035b32a203fff2901341794ea76
+++ Makefile	a85bfc4e3926532be115ff04e569720f5ae103fd
@@ -133,6 +133,7 @@ clean :
 	rm -f *.a *.so *.o *.cm* monotone-viz
 	rm -f dot_lexer.ml dot_parser.ml dot_parser.mli
 	rm -f revision_lexer.ml revision_parser.ml revision_parser.mli
+	rm -f schema_lexer.ml
 	cd mlsqlite && rm -f *.a *.so *.o *.cm*
 	cd $(OCAMLNET) && rm -f *.o *.cm*
 	cd $(EXTLIB) && rm -f *.o *.cm*
============================================================
--- NEWS	b13365f9cd671224411dc354a0e549b37c204871
+++ NEWS	b91db41ad4c5f746f901a2ac9744b748c2270a40
@@ -1,8 +1,17 @@
+0.14:
+- support new format of monotone db (using BLOBs instead of base64 encoding)
+  /!\ these newer monotones (after 0.26pre2) use sqlite 3.3, if you're building
+      monotone-viz with a shared sqlite lib, make sure it is compatible !
+- display a nice dialog when the database is locked (e.g. during netsync)
+- when a revision has a tag cert, use it as label instead of the revision's id
+
+
 0.13:
 - support monotone 0.26pre1 (it still works fine with monotone <= 0.25)
 - stop displaying `disapprove' nodes in a special way (this allows a faster
   loading of the database)

+
 0.12:
 - change the way displayed branches are selected: now one can view
   any set of branches
============================================================
--- README	e9ec472a54765c5a05481be8b4cbf0879bdb49fe
+++ README	ca8f7f128d188deaecc95d31dc580154e53fd454
@@ -14,6 +14,8 @@
 - dot from the graphviz package
   http://www.research.att.com/sw/tools/graphviz/
 - GTK+ 2.4, libgnomecanvas
+- OpenSSL development files
+- either a compiled monotone tree or sqlite development files


 COMPILING
@@ -23,7 +25,10 @@
   compile/install LablGTK
   run `aclocal -I . && autoconf' to generate configure
 - run ./configure, with the following options if needed:
-    --with-lablgtk-dir
+    --with-lablgtk-dir=
+    --without-local-lablgtk
+    --with-monotone-dir=
+    --without-shared-sqlite
     --bindir
 - make
 - make install
@@ -36,6 +41,7 @@
 usage: monotone-viz [options] [db [branch]]
 options:
   -noaa don't use an anti-aliased canvas
+  --version print version number and exit

 If db and branch are not specified on the command line and
 monotone-viz is run from a monotone-controlled directory, it will
============================================================
--- agraph.ml	c9152945a3b80583ed6fc6e8b8c45f69a75b62be
+++ agraph.ml	6eecb1bfd0370d394ea4311512029a3d10676c52
@@ -3,8 +3,9 @@ type layout_params = {

 type layout = Viz_types.cgraph
 type layout_params = {
-    box_w     : float ;
-    box_h     : float ;
+    box_w      : float ;
+    box_h      : float ;
+    char_width : float ;
     lr_layout : bool ;
     dot_program : string ;
   }
@@ -57,18 +58,31 @@ let dot_format params agraph =
   end ;

   begin
+    (* nodes with tags *)
+    NodeMap.iter
+      (fun id n ->
+	match n.kind with
+	| TAGGED tag ->
+	    let w =
+	      params.char_width *. float (String.length tag + 4) in
+	    !+ "  %S [width = %g] ;\n" id w
+	| _ -> ())
+      agraph.nodes
+  end ;
+
+  begin
     (* merge nodes *)
     let s = min params.box_w params.box_h in
     !+ "  node [shape=circle, width = %f, height = %f] ;\n" s s ;
     do_nodes (fun n -> n.kind = MERGE) ;
   end ;

-  begin
-    (* disapproval nodes *)
-    let s = min params.box_w params.box_h in
-    !+ "  node [shape=diamond, width = %f, height = %f] ;\n" s s ;
-    do_nodes (fun n -> n.kind = DISAPPROVE) ;
-  end ;
+(*   begin *)
+(*     (* disapproval nodes *) *)
+(*     let s = min params.box_w params.box_h in *)
+(*     !+ "  node [shape=diamond, width = %f, height = %f] ;\n" s s ; *)
+(*     do_nodes (fun n -> n.kind = DISAPPROVE) ; *)
+(*   end ; *)

   let heads = find_heads agraph in
   begin
@@ -261,6 +275,7 @@ let make agraph query layout_params stat
     query = query ;
     agraph = agraph ;
     layout_params = { layout_params with
+		      char_width = layout_params.char_width /. ppi ;
 		      box_w = layout_params.box_w /. ppi ;
 		      box_h = layout_params.box_h /. ppi } ;
     layout = None ;
============================================================
--- agraph.mli	08e41b7cf67369cbf32876a38add40bfd2c09ba8
+++ agraph.mli	6095dfc14ecc5804edac4d3cf1755af9382a6bb8
@@ -4,6 +4,7 @@ type layout_params = {
 type layout_params = {
     box_w     : float ;
     box_h     : float ;
+    char_width : float ;
     lr_layout : bool ;
     dot_program : string ;
   }
============================================================
--- app.ml	1684eb27e8ef243f7c213acdb1eda2765549f067
+++ app.ml	ecdd153474516d486e2ad04862b65f537522a10e
@@ -89,9 +89,12 @@ class ctrl w ~prefs ~manager ~status ~vi
       prefs <- new_prefs ;
       Ui.Prefs.update_prefs self old_prefs new_prefs

+    method private locked_db _ =
+      Ui.LockedDB.show self
+
     method open_db ?id ?branch fname =
       self#close_db () ;
-      let m_db = Database.open_db fname in
+      let m_db = Database.open_db ~busy_handler:self#locked_db fname in
       db <- Some m_db ;
       View.open_db view self ;
       Ui.open_db manager self ;
@@ -193,8 +196,9 @@ class ctrl w ~prefs ~manager ~status ~vi
 	db

     method private layout_params =
-      let (w, h) = View.Canvas.id_size view.View.canvas self in
-      { Agraph.box_w = float w ;
+      let (w, h, cw) = View.Canvas.id_size view.View.canvas self in
+      { Agraph.char_width = float cw ;
+	Agraph.box_w = float w ;
 	Agraph.box_h = float h ;
 	Agraph.lr_layout = prefs.Viz_style.lr_layout ;
 	Agraph.dot_program = prefs.Viz_style.dot_path }
============================================================
--- configure.ac	7bc8b6f9d4905cbce41553f06a011fcf0ea5c784
+++ configure.ac	f43ff3f89e46fbc86684dc6a2008b90cfd7c9355
@@ -1,4 +1,4 @@
-AC_INIT(monotone-viz, 0.13)
+AC_INIT(monotone-viz, 0.14)

 AC_PROG_OCAML
 AC_PROG_OCAML_TOOLS
@@ -93,7 +93,7 @@ AC_ARG_WITH([shared-sqlite],
 	    MONOTONE_DIR=$withval,
 	    MONOTONE_DIR=monotone)
 AC_ARG_WITH([shared-sqlite],
-            AS_HELP_STRING([--with-shared-sqlite],
+            AS_HELP_STRING([--without-shared-sqlite],
 	                   [use a system-wide shared sqlite library]),
             SHARED_SQLITE=$withval,
             SHARED_SQLITE=maybe)
============================================================
--- database.ml	8050fdf19eecbfea0acd1b5f5db5bd6ace5967f4
+++ database.ml	ed9278cbb1ee9179bb761ae8e21ebf91b1f13811
@@ -17,12 +17,15 @@ let acc_one_col base64 acc row =



-let setup_sqlite db =
+let setup_sqlite ?busy_handler db =
   if Viz_misc.debug "sql"
   then
     Sqlite3.trace_set db
       (fun s -> prerr_string "### sql: " ; prerr_endline s) ;
-  Sqlite3.exec db "PRAGMA temp_store = MEMORY"
+  Sqlite3.exec db "PRAGMA temp_store = MEMORY" ;
+  may
+    (Sqlite3.busy_set db)
+    busy_handler

 let schema_id db =
   let lines =
@@ -179,6 +182,23 @@ let fetch_children db =
       init
       stmt

+
+let collect_tags db 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 v = Sqlite3.column_text stmt 0 in
+	  NodeMap.add id { node with kind = TAGGED v } m)
+	m
+	stmt)
+    nodes
+    nodes
+
 let fetch_agraph_with_view db (query, query_limit) =
   let view_name_limit =
     if query_limit <> QUERY_NO_LIMIT
@@ -209,6 +229,10 @@ let fetch_agraph_with_view db (query, qu
   let agraph =
     { agraph with nodes = find_merge_nodes agraph.nodes } in

+  (* get tags *)
+  let agraph =
+    { agraph with nodes = collect_tags db agraph.nodes } in
+
   (* determine the branching edges *)
   let agraph =
     begin
@@ -443,7 +467,7 @@ let sqlite_try f db =



-let open_db fname =
+let open_db ?busy_handler fname =
   if not (Sys.file_exists fname)
   then Viz_types.errorf "No such file: %s" fname ;
   let db =
@@ -451,10 +475,10 @@ let open_db fname =
     with Sqlite3.Error (_, msg) ->
       Viz_types.errorf "Could not open database %s:\n%s" fname msg in
   let pubkeys = Hashtbl.create 17 in
-  let stmts = [| prepare_fetch_one_cert_signer db ;
-                 prepare_fetch_one_cert_value db |] in
   try
-    setup_sqlite db ;
+    setup_sqlite ?busy_handler db ;
+    let stmts = [| prepare_fetch_one_cert_signer db ;
+                   prepare_fetch_one_cert_value db |] in
     let rostered = has_rosters db in
     let schema   = schema_id db in
     let base64   = uses_base64 rostered schema in
============================================================
--- database.mli	e94e03fdf58c03a0229b72f1ff1bfcf7533afb65
+++ database.mli	adea7c4edcb55913177145025fc45d57bad3c1b0
@@ -4,7 +4,7 @@ type t

 (** Any of these function can raise Viz_types.Error *)

-val open_db    : string -> t
+val open_db    : ?busy_handler:(int -> [`FAIL | `RETRY]) -> string -> t
 val close_db   : t -> unit

 val with_progress : (unit -> unit) -> (t -> 'a) -> t -> 'a
============================================================
--- main.ml	b3012be53c72a238d19c83ecc734bfc33a2a2cd4
+++ main.ml	8e7e32724f4bd07a10a9c6caee878dfff2b33281
@@ -100,12 +100,19 @@ let parse_cli () =
   (!aa, parse_options (Q.to_list !anons))


-let exn_handler parent exn =
-  Ui.error_notice ~parent
-    (match exn with
-    | Viz_types.Error msg -> msg
-    | exn ->
-	Printf.sprintf "Uncaught exception: %s" (Printexc.to_string exn))
+let exn_handler ctrl = function
+  | Sqlite3.Error (Sqlite3.LOCKED, _) ->
+      ()
+  | exn ->
+      ctrl#error_notice
+	begin
+	  match exn with
+	  | Viz_types.Error msg -> msg
+	  | exn ->
+	      Printf.sprintf
+		"Uncaught exception: %s"
+		(Printexc.to_string exn)
+	end

 let main =
   let w = GWindow.window
@@ -115,12 +122,12 @@ let main =

   let (aa, mt_options) = parse_cli () in

-  GtkSignal.user_handler := exn_handler w ;
-
   let prefs = Viz_style.load () in

   let ctrl = App.make w ~aa ~prefs in

+  GtkSignal.user_handler := exn_handler ctrl ;
+
   ignore
     (Glib.Idle.add
        (fun () ->
@@ -135,8 +142,7 @@ let main =
 		 ctrl#open_db ~branch fname
 	     | MTopt_full (fname, branch, id) ->
 		 ctrl#open_db ~id ~branch fname
-	   with Viz_types.Error msg ->
-	     ctrl#error_notice msg
+	   with exn -> exn_handler ctrl exn
 	 end ;
 	 false)) ;

============================================================
--- ui.ml	966f78220372d018943bd4049f8ffc4e910098d0
+++ ui.ml	40c46b362676e4393b6730d7604018994344ebcd
@@ -288,8 +288,57 @@ end
     resp
 end

+module LockedDB = struct

+  let message ctrl =
+    let db_fname =
+      Database.get_filename
+	(some ctrl#get_db) in
+    Printf.sprintf
+      "<big>Database <tt>%s</tt> is currently in use by another process.</big>"
+      (Glib.Markup.escape_text db_fname)

+  let show ctrl =
+    (* for some reason GtkMessageDialog looks ugly here, so I rool my own GtkDialog *)
+    let dialog =
+      GWindow.dialog
+	~no_separator:true
+	~parent:ctrl#get_toplevel
+	~destroy_with_parent:true
+	~title:"Monotone-viz: database locked"
+	~modal:true () in
+    begin
+      let vbox = dialog#vbox in
+      vbox#set_border_width 12 ;
+      let hbox = GPack.hbox ~spacing:12 ~border_width:12 ~packing:vbox#pack () in
+      ignore (GMisc.image
+		~stock:`DIALOG_WARNING
+		~icon_size:`DIALOG
+		~yalign:0.
+		~packing:hbox#pack
+		()) ;
+      ignore (GMisc.label
+		~markup:(message ctrl)
+		~line_wrap:true ~selectable:true
+		~xalign:0. ~yalign:0.
+		~packing:(hbox#pack ~expand:true)
+		())
+    end ;
+    begin
+      dialog#add_button_stock `CANCEL `CANCEL ;
+      dialog#add_button "Retry" `RETRY
+    end ;
+    let resp =
+      match dialog#run () with
+      | `CANCEL | `DELETE_EVENT -> `FAIL
+      | `RETRY -> `RETRY in
+    dialog#destroy () ;
+    resp
+
+end
+
+
+
 
 let ui_info = "\
   <ui>\
============================================================
--- ui.mli	616701fcf70199bc40d48051187777b1f55e632d
+++ ui.mli	d25fe1553276726e4cd998b1010d280139e5534b
@@ -41,6 +41,9 @@ end
   val show : t -> string option
 end

+module LockedDB : sig
+  val show : #App.t -> [`FAIL | `RETRY]
+end

 type manager
 val make  : unit -> manager * GObj.widget * GObj.widget
============================================================
--- view.ml	1e5e6a1a88d2bdc2627821f1e770b5aa4c3c86b3
+++ view.ml	744a670f23e96b7cc95638ce3b3eed208a40460d
@@ -1096,11 +1096,12 @@ module Canvas = struct
     let char_width = GPango.to_pixels metrics#approx_char_width in
     let ascent = GPango.to_pixels metrics#ascent in
     let descent = GPango.to_pixels metrics#descent in
-    let (w, h) as s =
+    let (w, h, cw) as s =
       ((id_width + 4) * char_width,
-       (ascent + descent) * 2) in
+       (ascent + descent) * 2,
+       char_width) in
     if Viz_misc.debug "font"
-    then Printf.eprintf "### font: width = %d, height = %d\n%!" w h ;
+    then Printf.eprintf "### font: width = %d, height = %d, char_width = %d\n%!" w h cw ;
     s

   let scroll view view_width target target_width =
@@ -1203,10 +1204,15 @@ module Canvas = struct
 	  GnoCanvas.rect ~x1:(~-. x) ~y1:(~-. y) ~x2:x ~y2:y ~props g in
       if node.c_kind = DISAPPROVE
       then rect#affine_relative [| 0.5 ; 0.5 ; 0.5 ; -0.5 ; 0. ; 0. |] ;
-      if node.c_kind = REGULAR || is_neighbor node then
+      let text =
+	match node.c_kind with
+	| TAGGED t -> t
+	| REGULAR -> String.sub id 0 id_width
+	| _ when is_neighbor node -> String.sub id 0 id_width
+	| _ -> "" in
+      if text <> "" then
 	begin
 	  let scaled_font_size = font_size *. c.ppu in
-	  let text = String.sub id 0 id_width in
           let t = GnoCanvas.text
               ~text ~font
               ~props:([ `SIZE_POINTS scaled_font_size ] @ text_props) g in
============================================================
--- view.mli	fc58aa1b7db2d23c654b7c407ee1da2a2503ddcc
+++ view.mli	10a06ee77ef495e988563bffb5a58bc03e2cd6eb
@@ -19,7 +19,7 @@ module Canvas :
   sig
     type t
     val zoom : t -> #App.t -> [< `IN | `OUT ] -> unit -> unit
-    val id_size : t -> #App.t -> int * int
+    val id_size : t -> #App.t -> int * int * int
     val center_on : t -> #App.t -> string * Viz_types.c_node -> unit
   end

============================================================
--- viz_types.ml	2348af90556459bd15ea99ce8d5b45b2f2dbe82c
+++ viz_types.ml	fa26708f30ff98ccee703267a4d5567c9a0545c9
@@ -39,6 +39,7 @@ type node_kind =
   | NEIGHBOUR_OUT
   | MERGE
   | DISAPPROVE
+  | TAGGED of string

 type relation = PARENT | CHILD

============================================================
--- viz_types.mli	c3524724d488bbf3da18ba9de56ab98d9a08599f
+++ viz_types.mli	2f027d5caef8b2f45a32eea1e3e165894f4437b5
@@ -42,6 +42,7 @@ type node_kind =
   | NEIGHBOUR_OUT
   | MERGE
   | DISAPPROVE
+  | TAGGED of string

 type relation = PARENT | CHILD