The unified diff between revisions [7891617d..] and [78746ed3..] is displayed below. It can also be downloaded as a raw diff.

#
#
# add_file "INSTALL"
#  content [f4e6f306f6a19cf698f77b8ac43c8db16af19c4c]
#
# add_file "gnomecanvas_hack.c"
#  content [ed8e248d636d567cacfe4727a9370ee4283097af]
#
# patch "Makefile"
#  from [473b5d39237dbd706049a1879888aea2f93b957b]
#    to [e24ee4ebcb8c535231a27e69c5bab89976e9b9d8]
#
# patch "NEWS"
#  from [17aa2aca5ca090cf3d46bfc1590fd8bf3bea6536]
#    to [3602e8bd4779572b71e1b69ed41097bfcfadacda]
#
# patch "README"
#  from [e5cbc58372ee38f678c2084bb336dc807a183063]
#    to [909fde8b736d5c46c04dd68111f2718dab03cfe7]
#
# patch "configure.ac"
#  from [ec7e74911afd17b2816ada7c0a0ad5349b95340d]
#    to [fe7b2a288ec73db3487937bd1cc2538ba7494603]
#
# patch "database-mt.ml"
#  from [bfbc64267c32b93b83e8d14b1414352d0b6ddb6d]
#    to [4f652fbc8f02cf793f9f61724fee5ce446e201b8]
#
# patch "view.ml"
#  from [85fe039f1aaf23419b2c230887c361382493c78a]
#    to [69c88b304f62c440cbc49ec4c62a89a98a42da90]
#
============================================================
--- INSTALL	f4e6f306f6a19cf698f77b8ac43c8db16af19c4c
+++ INSTALL	f4e6f306f6a19cf698f77b8ac43c8db16af19c4c
@@ -0,0 +1,58 @@
+
+Compiling monotone-viz from sources
+===================================
+
+* OCaml
+Monotone-viz is written in Objective caml, so you'll need the ocaml
+compilers [1]. They are binaries available, from the ocaml homepage or
+from other vendors (e.g. Linux distributions). It is also easy to
+compile from source, something like this should work:
+
+ $ ./configure -prefix /opt/caml
+ $ make world.opt
+ $ make install
+
+
+* GTK+ & libgnomecanvas
+You'll need the development packages of GTK+ 2.4 (or newer) and
+libgnomecanvas.
+
+
+* LablGTK
+LablGTK is a GTK+ bindings for ocaml [2]. It is packaged for some
+Linux distributions, but make sure you have *at least* version 2.4.0.
+The latest version is lablgtk2-20050218.
+
+  $ ./configure --with-gnomecanvas
+  $ make world
+  $ make install
+
+
+* Monotone
+You need the compiled monotone sources, for monotone-viz statically
+links the sqlite library embedded in monotone.  So, in the
+monotone-viz directory, create a link named monotone :
+
+  $ ln -s /path/to/monotone-tree monotone
+
+
+* Monotone-viz
+Compiling monotone-viz should now be as simple as :
+
+  $ ./configure
+  $ make
+
+
+* Installing & cleaning
+There is no `install' target for the Makefile : monotone-viz is a
+single executable, just copy it somewhere in your PATH.
+Also the ocaml compiler statically links everything caml-related so
+you can delete your ocaml installation if you so wish :
+
+  $ rm -Rf /opt/ocaml
+
+
+
+
+[1] http://caml.inria.fr/ocaml/release.en.html
+[2] http://wwwfun.kurims.kyoto-u.ac.jp/soft/olabl/lablgtk.html
============================================================
--- gnomecanvas_hack.c	ed8e248d636d567cacfe4727a9370ee4283097af
+++ gnomecanvas_hack.c	ed8e248d636d567cacfe4727a9370ee4283097af
@@ -0,0 +1,84 @@
+#include <caml/mlvalues.h>
+
+#include <libgnomecanvas/libgnomecanvas.h>
+#include <pango/pangoft2.h>
+
+static GObjectSetPropertyFunc orig_gnome_canvas_text_set_property;
+
+static void
+my_gnome_canvas_text_set_property (GObject            *object,
+				   guint               param_id,
+				   const GValue       *value,
+				   GParamSpec         *pspec)
+{
+  static const char fmap_key[] = "monotone-viz-PangoFT2FontMap";
+  GnomeCanvasItem *item;
+  GnomeCanvasText *text;
+  PangoFontMap *fmap;
+
+  item = GNOME_CANVAS_ITEM (object);
+  text = GNOME_CANVAS_TEXT (object);
+
+  if (!text->layout && item->canvas->aa) {
+    PangoLanguage *language;
+    PangoContext *gtk_context, *context;
+
+    fmap = g_object_get_data (G_OBJECT (item->canvas), fmap_key);
+
+    if (fmap == NULL) {
+      GtkWidget *c_w;
+      GdkScreen *screen;
+      gint	pixels, mm;
+      double	dpi_x, dpi_y;
+
+
+      c_w = GTK_WIDGET (item->canvas);
+      screen = gtk_widget_has_screen (c_w) ? gtk_widget_get_screen (c_w) : gdk_screen_get_default();
+      pixels = gdk_screen_get_width (screen);
+      mm = gdk_screen_get_width_mm (screen);
+      dpi_x = (((double) pixels * 25.4) / (double) mm);
+
+      pixels = gdk_screen_get_height (screen);
+      mm = gdk_screen_get_height_mm (screen);
+      dpi_y = (((double) pixels * 25.4) / (double) mm);
+
+      fmap = pango_ft2_font_map_new ();
+      pango_ft2_font_map_set_resolution (PANGO_FT2_FONT_MAP (fmap),
+					 dpi_x, dpi_y);
+
+      g_object_set_data_full (G_OBJECT (item->canvas), fmap_key, fmap, g_object_unref);
+    }
+
+    gtk_context = gtk_widget_get_pango_context (GTK_WIDGET (item->canvas));
+    context = pango_ft2_font_map_create_context (PANGO_FT2_FONT_MAP (fmap));
+    language = pango_context_get_language (gtk_context);
+    pango_context_set_language (context, language);
+    pango_context_set_base_dir (context,
+				pango_context_get_base_dir (gtk_context));
+    pango_context_set_font_description (context,
+					pango_context_get_font_description (gtk_context));
+
+    text->layout = pango_layout_new (context);
+    g_object_unref (G_OBJECT (context));
+  }
+
+  return orig_gnome_canvas_text_set_property (object, param_id, value, pspec);
+}
+
+CAMLprim value
+ml_fix_libgnomecanvas_pango (value text_obj)
+{
+  static GnomeCanvasTextClass *ct_class;
+  GObjectClass *go_class;
+
+  if (ct_class)
+    return Val_unit;
+
+  ct_class = g_type_class_ref (GNOME_TYPE_CANVAS_TEXT);
+  go_class = G_OBJECT_CLASS (ct_class);
+
+  orig_gnome_canvas_text_set_property = go_class->set_property;
+  go_class->set_property = my_gnome_canvas_text_set_property;
+
+  return Val_unit;
+}
============================================================
--- Makefile	473b5d39237dbd706049a1879888aea2f93b957b
+++ Makefile	e24ee4ebcb8c535231a27e69c5bab89976e9b9d8
@@ -10,8 +10,8 @@ MLINCDIRS = -I $(LABLGTK_DIR) -I glib -I
 VPATH = glib crypto

 MLINCDIRS = -I $(LABLGTK_DIR) -I glib -I crypto
-CINCDIRS  = -I $(LABLGTK_DIR) -ccopt "$(GTK_CFLAGS) $(CRYPTO_CFLAGS)"
 GTK_CFLAGS := $(shell pkg-config gtk+-2.0 --cflags)
+GNOMECANVAS_CFLAGS := $(shell pkg-config libgnomecanvas-2.0 --cflags)


 SRC = gspawn.ml gspawn.mli giochannel.ml giochannel.mli \
@@ -27,6 +27,10 @@ SRC = gspawn.ml gspawn.mli giochannel.ml
       icon.ml unidiff.ml unidiff.mli \
       view.ml view.mli ui.ml main.ml

+C_OBJ = glib/ocaml-gspawn.o glib/ocaml-giochannel.o \
+        crypto/ocaml-openssl.o \
+        gnomecanvas_hack.o
+
 USE_P4 = viz_style.ml

 OBJ  = $(patsubst %.ml,%.cmo,$(filter %.ml, $(SRC)))
@@ -61,11 +65,14 @@ database.ml :
 database.ml :
 	ln -s git.ml $@

-lib3rdparty.a : glib/ocaml-gspawn.o glib/ocaml-giochannel.o crypto/ocaml-openssl.o
+lib3rdparty.a : $(C_OBJ)
 	ar crs lib3rdparty.a $^

 glib/ocaml-gspawn.o : gspawn_tags.c gspawn_tags.h
 glib/ocaml-giochannel.o : giochannel_tags.c giochannel_tags.h
+glib/ocaml-%.o           : CINCDIRS = -I $(LABLGTK_DIR) -ccopt "$(GTK_CFLAGS)"
+crypto/ocaml-openssl.o   : CINCDIRS = -ccopt "$(CRYPTO_CFLAGS)"
+gnomecanvas_hack.o       : CINCDIRS = -ccopt "$(GNOMECANVAS_CFLAGS)"

 %.ml : %.mll
 	$(OCAMLLEX) $<
@@ -116,7 +123,7 @@ dist : ../$(NAME)-$(VERSION).tar.gz
         tar zcvf $(@F) $(addprefix $(NAME)-$(VERSION)/,$(DISTSRC)) && \
         mv $(NAME)-$(VERSION) "$$DIRNAME"

-# not config.make
+# no config.make
 ifndef OCAMLLEX
 $(error run ./configure first (cf README))
 endif
============================================================
--- NEWS	17aa2aca5ca090cf3d46bfc1590fd8bf3bea6536
+++ NEWS	3602e8bd4779572b71e1b69ed41097bfcfadacda
@@ -1,3 +1,10 @@
+0.9:
+- the application window has an icon !
+- the layout is a bit more compact
+- the find box also finds tags regexps and dates
+- the diff window has a save button
+
+
 0.8:
 - update to sqlite3
 - fix the keyboard navigation for left-to-right layout
============================================================
--- README	e5cbc58372ee38f678c2084bb336dc807a183063
+++ README	909fde8b736d5c46c04dd68111f2718dab03cfe7
@@ -27,7 +27,9 @@
 - make
 - install the binary git-viz somewhere

+see INSTALL for an in-depth description of this procedure.

+
 RUNNING
 =======
 usage: git-viz [options] [git-controlled directory]
@@ -38,8 +40,7 @@
 STYLE FILE
 ==========
 Appearance can be controlled via a style file, named
-`.mononote-viz.style', in the home directory or in the current
-directory.
+`.mononote-viz.style', in the home directory.

 grammar:
   "font" <font_name>
============================================================
--- configure.ac	ec7e74911afd17b2816ada7c0a0ad5349b95340d
+++ configure.ac	fe7b2a288ec73db3487937bd1cc2538ba7494603
@@ -3,7 +3,12 @@ AC_PROG_CAMLP4
 AC_PROG_OCAML
 AC_PROG_OCAML_TOOLS
 AC_PROG_CAMLP4
+if test -z "$CAMLP4O" ; then
+  AC_MSG_ERROR([

+Could not find camlp4o. Camlp4 is required to build monotone-viz.])
+fi
+
 # Check LablGTK
 AC_ARG_WITH([lablgtk-dir],
 	    AS_HELP_STRING([--with-lablgtk-dir],
============================================================
--- database-mt.ml	bfbc64267c32b93b83e8d14b1414352d0b6ddb6d
+++ database-mt.ml	4f652fbc8f02cf793f9f61724fee5ce446e201b8
@@ -83,28 +83,30 @@ let auto_cl_re = [
   Str.regexp "\\(\\(explicit_\\)?merge of\\|propagate \\(of\\|from\\)\\) ", MERGE ;
   Str.regexp "disapproval of ", DISAPPROVE
 ]
-let re_match re s = Str.string_match re s 0
+let re_match s (re, _) = Str.string_match re s 0

 let process_changelog_row g = function
   | [| id; cl |] ->
       let cl = monot_decode cl in
-      if not (List.exists (fun (re, _) -> re_match re cl) auto_cl_re)
+      if not (List.exists (re_match cl) auto_cl_re)
       then g else begin
-	let (_, kind) =
-	  try List.find (fun (re, k) -> re_match re cl) auto_cl_re
-	  with Not_found -> assert false (* means I f*cked up the regexps *) in
+	let (_, kind) = List.find (re_match cl) auto_cl_re in
 	let node =
 	  try NodeMap.find id g.nodes
 	  with Not_found -> assert false (* monotone db is inconsistent *) in
 	let updated_edges =
 	  if kind = DISAPPROVE
 	  then begin
-	    match node.family with
-	    | [ pid, PARENT ] ->
-		EdgeMap.add (pid, id) DISAPPROVED g.ancestry
-	    | _ ->
-		g.ancestry
-	  end
+	    let pid =
+	      try list_rassoc PARENT node.family
+	      with Not_found -> assert false in
+	    let a = EdgeMap.add (pid, id) DISAPPROVED g.ancestry in
+	    try
+	      let pnode = NodeMap.find pid g.nodes in
+	      let gpid = list_rassoc PARENT pnode.family in
+	      EdgeMap.add (gpid, pid) DISAPPROVED a
+	    with Not_found -> a
+	  end
 	  else g.ancestry in
 	let updated_nodes =
 	  if kind <> node.kind
@@ -117,11 +119,7 @@ let process_branching_edge_row g = funct

 let process_branching_edge_row g = function
   | [| parent; child |] ->
-      { g with ancestry =
-	begin
-	  assert (NodeMap.mem parent g.nodes && NodeMap.mem child g.nodes) ;
-	  EdgeMap.add (parent, child) BRANCHING g.ancestry
-	end }
+      { g with ancestry = EdgeMap.add (parent, child) BRANCHING g.ancestry }
   | _ -> g


============================================================
--- view.ml	85fe039f1aaf23419b2c230887c361382493c78a
+++ view.ml	69c88b304f62c440cbc49ec4c62a89a98a42da90
@@ -497,6 +497,9 @@ module Canvas = struct
 
 module Canvas = struct

+  external pango_fix : unit -> unit = "ml_fix_libgnomecanvas_pango"
+  let _ = pango_fix ()
+
   let set_busy_cursor =
     let busy_cursor = Gdk.Cursor.create `WATCH in
     let normal_cursor = Gdk.Cursor.create `LEFT_PTR in
@@ -706,11 +709,7 @@ module Canvas = struct
 	else
 	  GnoCanvas.rect ~x1:(~-. x) ~y1:(~-. y) ~x2:x ~y2:y ~props g in
       if node.c_kind = DISAPPROVE
-      then
-	begin
-	  let sqrt2_2 = sqrt 2. /. 2. in
-	  rect#affine_relative [| sqrt2_2 ; sqrt2_2 ; sqrt2_2 ; ~-. sqrt2_2 ; 0. ; 0. |]
-	end ;
+      then rect#affine_relative [| 0.5 ; 0.5 ; 0.5 ; -0.5 ; 0. ; 0. |] ;
       if node.c_kind = REGULAR || node.c_kind = NEIGHBOUR then
 	begin
 	  let scaled_font_size = font_size *. v.canvas.ppu in
@@ -811,7 +810,10 @@ module Canvas = struct

     let id =
       Glib.Idle.add (fun () ->
-	try snd (PQueue.pop_maximum q) () ; true
+	try
+	  for i = 1 to 10 do
+	    snd (PQueue.pop_maximum q) ()
+	  done ; true
 	with Heap.EmptyHeap ->
 	  v.canvas.background_rendering <- None ;
 	  pr#progress_end () ;
@@ -884,13 +886,13 @@ module Find = struct
 	Canvas.center_on v n
     | _ ->
 	let candidates =
-	  if is_id q
-	  then locate_id v q
-	  else if is_date q
-	  then locate_date v q
-	  else
-	    try locate_tag v (Str.regexp q)
-	    with Failure _ -> [] in
+	  try
+	    if is_id q
+	    then locate_id v q
+	    else if is_date q
+	    then locate_date v q
+	    else locate_tag v (Str.regexp q)
+	  with Failure _ | Invalid_argument _ -> [] in
 	match candidates with
  	| [] ->
 	    v.find.last_find <- (q, [])
@@ -962,6 +964,19 @@ let make ~aa ~prefs ~packing =

   Branch_selector.connect v (handle_query v) ;

+  begin
+    let clipboard = GData.clipboard Gdk.Atom.primary in
+    ignore
+      (v.canvas.w#event#connect#button_press
+	 (function
+	   | b when GdkEvent.Button.button b = 2 ->
+	       may
+		 (Signal.emit v.find.find_signal)
+		 clipboard#text ;
+	       true
+	   | _ -> false))
+  end ;
+
   connect_event v (function
     | `NODE_SELECT id ->
 	Canvas.display_selection_marker v id ;
@@ -1056,15 +1071,13 @@ let set_prefs v p =
     v.prefs <- { v.prefs with style = p.style } ;
     need_redraw := true
   end ;
-  if v.agraph <> None
-  then begin
-    if !need_layout || !need_redraw
-    then Canvas.clear v ;
-    if !need_layout
-    then handle_query v (Agraph.get_query (some v.agraph))
-    else if !need_redraw
-    then Canvas.update_graph v
-  end
+  match v.agraph with
+  | Some g when !need_layout ->
+      handle_query v (Agraph.get_query g)
+  | Some g when !need_redraw ->
+      Canvas.clear v ;
+      Canvas.update_graph v
+  | _ -> ()

 let get_ancestors v id =
   Agraph.get_ancestors (some v.agraph) id