CHANGES

 
 * marks some incompatible change
 
+version 1.8.8, October 17, 2017
+-------------------------------
+ o fixed installation (Virgile Prevosto, Jacques-Pascal Deplaix)
+ o safe-string compatible (Jacques-Pascal Deplaix)
+ * fixed method get_edge_layout of class abstract_model of DGraphModel.Make. The
+   bug could have occured when there are several edges between two vertices.
+ o [Traverse/Pack] added Dfs.fold and Dfs.fold_component (tail-recursive)
+   (contributed by Guillaume Chelfi)
+ * fixed implementation of Golberg-Tarjan maximal flow algorithm
+   (contributed by Guyslain Naves)
+   No more function min_capacity in the input interface.
+   Renaming as follows: Flow.Goldberg -> Flow.Goldberg_Tarjan
+   and Pack.goldberg -> Pack.goldberg_tarjan
+ o new functors [WeakTopological] and [ChaoticIteration] to compute
+   fixpoints with widening, following Bourdoncle's algorithms (contributed
+   by Thibault Suzanne)
+
+version 1.8.7, April 12, 2016
+-----------------------------
+ o fixed examples/demo.ml so that it also compiles with an installed OCamlGraph
+ o [Components] fixed stack overflow with [scc] (patch by Albin Coquereau)
+ o [Dominator] fixed stack overflow (patch by Albin Coquereau)
+ o new functor [Path.Johnson] to compute all pairs of shortest paths
+   using Johnson's algorithm (contributed by Mrio Pereira)
+ o fixed configuration on Windows (patch by Martin R. Neuhuer)
+ o new functor [Components.Undirected] to compute connected components
+ o Graphviz: fixed printing of attribute BgcolorWithTransparency
+ * Prim, Nonnegative: function weight now has the more general type "edge -> t"
+   (to be consistent with Path)
+ o new module type Sig.WEIGHT (used in Path, Prim, and Nonnegative)
+ o Fixpoint: do not catch Not_found raised by a user-provided function.
+ o Adding folds to BFS.
+
 version 1.8.6, January 23, 2015
 -------------------------------
- o Dominator: new functor [Make_graph] with may use graph building operations,
+ * Dominator: new functor [Make_graph] with may use graph building operations,
    while the old functor [Make] now only requires a read-only graph.
+   Function [compute_all] and [compute_dom_graph] are now only defined in the
+   new [Make_graph] functor.
  o Graphviz: support for additional polygonal-shapes
  o New module Clique (contributed by Giselle Reis)
  o Avoid ocamldoc error with OCaml 4.02

INSTALL → INSTALL.adoc

 
-===========================
-How to create the library ?
-===========================
+= How to create the library ?
 
 You need Objective Caml >= 3.10.2 to compile this library.
 
@@ -9,6 +7,9 @@ Configure with
 
 	./configure
 
+(If the `./configure` file does not exist,
+run `autoconf` first.)
+
 Compile with
 
 	make
@@ -21,9 +22,7 @@ findlib users may also do
 
 	make install-findlib
 
-=================================
-How to create the documentation ?
-=================================
+== How to create the documentation ?
 
 create a local documentation with
 

META.in

@@ -2,4 +2,22 @@ version = "VERSION"
 description = "Generic Graph Library"
 requires=""
 archive(byte) = "CMA"
+archive(byte,plugin) = "CMA"
 archive(native) = "CMXA"
+archive(native,plugin) = "CMXS"
+
+package "dgraph" (
+  exists_if = "dgraph.cmi"
+  description = "Library to visualize graph in a Lablgtk canvas"
+  requires = "ocamlgraph lablgtk2.gnomecanvas"
+  archive(byte) = "dgraph.cmo"
+  archive(native) = "dgraph.cmx"
+)
+
+package "viewgraph" (
+  exists_if = "viewgraph.cmi"
+  description = "Library to visualize graph in a Lablgtk canvas (deprecated)"
+  requires = "ocamlgraph lablgtk2.gnomecanvas"
+  archive(byte) = "viewgraph.cmo"
+  archive(native) = "viewgraph.cmx"
+)

Makefile.in

@@ -43,11 +43,11 @@ LIBEXT = @LIBEXT@
 OBJEXT = @OBJEXT@
 
 # Others global variables
-SRCDIR	= src
-LIBDIR	= lib
+OCAMLGRAPH_SRCDIR	= src
+OCAMLGRAPH_LIBDIR	= lib
 
-INCLUDES= -I $(SRCDIR) -I $(LIBDIR)
-BFLAGS = $(INCLUDES) -g -dtypes
+INCLUDES= -I $(OCAMLGRAPH_SRCDIR) -I $(OCAMLGRAPH_LIBDIR)
+BFLAGS = $(INCLUDES) -g -dtypes -w +a -w -4 -w -44 -w -50 -w -48 -w -29
 OFLAGS = $(INCLUDES)
 
 # main target
@@ -64,16 +64,16 @@ endif
 # bytecode and native-code compilation
 ######################################
 
-LIB= unionfind heap bitv
-LIB:=$(patsubst %, $(LIBDIR)/%.cmo, $(LIB))
+OCAMLGRAPH_LIB= unionfind heap bitv persistentQueue
+OCAMLGRAPH_LIB:=$(patsubst %, $(OCAMLGRAPH_LIBDIR)/%.cmo, $(OCAMLGRAPH_LIB))
 
 CMO =	version util blocks persistent imperative \
 	delaunay builder classic rand oper \
 	components path nonnegative traverse coloring topological kruskal flow \
 	prim dominator graphviz gml dot_parser dot_lexer dot pack \
 	gmap minsep cliquetree mcs_m md strat fixpoint leaderlist contraction \
-	graphml merge mincut clique
-CMO := $(LIB) $(patsubst %, $(SRCDIR)/%.cmo, $(CMO))
+	graphml merge mincut clique weakTopological chaoticIteration
+CMO := $(OCAMLGRAPH_LIB) $(patsubst %, $(OCAMLGRAPH_SRCDIR)/%.cmo, $(CMO))
 
 CMX = $(CMO:.cmo=.cmx)
 CMA = graph.cma
@@ -112,12 +112,18 @@ graph.cmo: $(CMI) $(CMO)
 graph.cmx: $(CMI) $(CMX)
 	$(OCAMLOPT) $(INCLUDES) -pack -o $@ $^
 
-VERSION=1.8.6
+VERSION=1.8.8
+
+ifdef SOURCE_DATE_EPOCH
+BUILD_DATE=$(shell date -u -d "@$(SOURCE_DATE_EPOCH)" 2>/dev/null || date -u -r "$(SOURCE_DATE_EPOCH)" 2>/dev/null || date)
+else
+BUILD_DATE=$(shell date)
+endif
 
 src/version.ml: Makefile
 	rm -f $@
 	echo "let version = \""$(VERSION)"\"" > $@
-	echo "let date = \""`date`"\"" >> $@
+	echo 'let date = "'"$(BUILD_DATE)"'"' >> $@
 
 # gtk2 graph editor
 ###################
@@ -246,12 +252,12 @@ graph.cmx: | $(DGRAPH_DIR)/dgraph.byte \
 	$(ED_DIR)/editor.byte
 endif
 
-$(CMX): | $(SRCDIR)/blocks.cmo
+$(CMX): | $(OCAMLGRAPH_SRCDIR)/blocks.cmo
 
 # No .mli for blocks.ml: so, to avoid clash when generating block.cmi
 # from both ocamlc and ocamlopt, force to fully compile the bytecode library
 # before the native one
-$(SRCDIR)/blocks.cmx: | graph.cmo
+$(OCAMLGRAPH_SRCDIR)/blocks.cmx: | graph.cmo
 
 # Examples
 ##########
@@ -316,6 +322,9 @@ test: $(CMA) tests/test.ml
 test-bf: $(CMA) tests/test_bf.ml
 	ocaml unix.cma graphics.cma $^
 
+test-johnson: $(CMA) tests/test_johnson.ml
+	ocaml unix.cma graphics.cma $^
+
 bin/test-ts: $(CMXA) tests/test_topsort.ml
 	mkdir -p bin
 	$(OCAMLOPT) -o $@ unix.cmxa $^
@@ -351,7 +360,7 @@ bin/testunix.opt: $(CMXA) myTest/testunix.ml
 	$(OCAMLOPT) -unsafe -inline 100 -o $@ unix.cmxa $^
 
 check: $(CMA) tests/check.ml bin/test-ts
-	ocaml $(CMA) tests/test_clique.ml tests/check.ml
+	ocaml -I . $(CMA) tests/test_clique.ml tests/check.ml
 	bin/test-ts 10
 
 # Additional rules
@@ -391,7 +400,7 @@ endif
 install-byte:
 	mkdir -p $(INSTALL_LIBDIR)
 	cp -f graph.cmo graph.cmi $(CMA) $(INSTALL_LIBDIR)
-	cp -f $(SRCDIR)/*.mli $(INSTALL_LIBDIR)
+	cp -f $(OCAMLGRAPH_SRCDIR)/*.mli $(INSTALL_LIBDIR)
 ifeq (@LABLGNOMECANVAS@,yes)
 	mkdir -p $(BINDIR)
 	cp -f $(ED_DIR)/editor.byte $(BINDIR)/graph-editor.byte
@@ -405,7 +414,7 @@ install-opt: install-byte
 	mkdir -p $(INSTALL_LIBDIR)
 	cp -f graph$(OBJEXT) graph$(LIBEXT) graph.cmi graph.cmx \
 		$(CMXA) $(CMXS) $(INSTALL_LIBDIR)
-	cp -f $(SRCDIR)/*.mli $(INSTALL_LIBDIR)
+	cp -f $(OCAMLGRAPH_SRCDIR)/*.mli $(INSTALL_LIBDIR)
 ifeq (@LABLGNOMECANVAS@,yes)
 	mkdir -p $(BINDIR)
 	cp -f $(ED_DIR)/editor.opt $(BINDIR)/graph-editor.opt
@@ -421,26 +430,37 @@ ifdef DESTDIR
 OCAMLFINDDEST := -destdir $(DESTDIR)
 endif
 
+ifeq ($(OCAMLBEST),byte)
+  OCAMLFIND_OPT_FILES=
+else
+  OCAMLFIND_OPT_FILES=graph$(OBJEXT) graph$(LIBEXT) graph.cmx $(CMXA) $(CMXS)
+  ifeq (@LABLGNOMECANVAS@,yes)
+    OCAMLFIND_OPT_FILES+=\
+      $(VIEWER_CMXLIB) $(VIEWER_CMXLIB:.cmx=.o) \
+      $(DGRAPH_CMXLIB) $(DGRAPH_CMXLIB:.cmx=.o)
+  endif
+endif
+
 install-findlib: META
 ifdef OCAMLFIND
 ifeq (@LABLGNOMECANVAS@,yes)
 	$(OCAMLFIND) install $(OCAMLFINDDEST) ocamlgraph META \
-		$(SRCDIR)/*.mli $(VIEWER_DIR)/*.mli $(DGRAPH_DIR)/*.mli \
-		graph$(OBJEXT) graph$(LIBEXT) graph.cmx graph.cmo graph.cmi \
-		$(CMA) $(CMXA) \
-		$(VIEWER_CMXLIB) $(VIEWER_CMOLIB) $(VIEWER_CMILIB) \
-                $(VIEWER_CMXLIB:.cmx=.o) \
-                $(DGRAPH_CMXLIB) $(DGRAPH_CMOLIB) $(DGRAPH_CMILIB) \
-                $(DGRAPH_CMXLIB:.cmx=.o)
+		$(OCAMLGRAPH_SRCDIR)/*.mli $(VIEWER_DIR)/*.mli $(DGRAPH_DIR)/*.mli \
+		graph.cmo graph.cmi \
+		$(CMA) \
+		$(VIEWER_CMOLIB) $(VIEWER_CMILIB) \
+                $(DGRAPH_CMOLIB) $(DGRAPH_CMILIB) \
+                $(OCAMLFIND_OPT_FILES)
 else
 	$(OCAMLFIND) install $(OCAMLFINDDEST) ocamlgraph META \
-		$(SRCDIR)/*.mli $(VIEWER_DIR)/*.mli $(DGRAPH_DIR)/*.mli \
-		graph$(LIBEXT) graph.cmx graph.cmo graph.cmi $(CMA) $(CMXA)
+		$(OCAMLGRAPH_SRCDIR)/*.mli $(VIEWER_DIR)/*.mli $(DGRAPH_DIR)/*.mli \
+		graph$(LIBEXT) graph.cmo graph.cmi $(CMA) \
+	        $(OCAMLFIND_OPT_FILES)
 endif
 endif
 
 META: META.in Makefile
-	sed -e s/VERSION/$(VERSION)/ -e s/CMA/$(CMA)/ -e s/CMXA/$(CMXA)/ \
+	sed -e s/VERSION/$(VERSION)/ -e s/CMA/$(CMA)/ -e s/CMXA/$(CMXA)/ -e s/CMXS/$(CMXS)/ \
 		$@.in > $@
 
 # documentation
@@ -449,25 +469,27 @@ META: META.in Makefile
 DOCFILES=$(NAME).ps $(NAME).html
 
 NODOC	= blocks dot_parser dot_lexer version
-NODOC	:= $(patsubst %, $(SRCDIR)/%.cmo, $(NODOC))
-DOC_CMO	= $(filter-out $(NODOC) $(LIB), $(CMO))
+NODOC	:= $(patsubst %, $(OCAMLGRAPH_SRCDIR)/%.cmo, $(NODOC))
+DOC_CMO	= $(filter-out $(NODOC) $(OCAMLGRAPH_LIB), $(CMO))
 DOC_SRC	= $(CMI:.cmi=.mli) $(DOC_CMO:.cmo=.mli) $(DOC_CMO:.cmo=.ml)
 ifeq (@LABLGNOMECANVAS@,yes)
 DOC_SRC := $(DOC_SRC) $(DGRAPH_CMI:.cmi=.mli)
 endif
+DOC_CHARSET = utf-8
 
 .PHONY: doc
 doc: $(DOC_CMO)
 	mkdir -p doc
 	rm -f doc/*
-	$(OCAMLDOC) -d doc -html $(DGRAPH_INCLUDES) -I lib -I src $(DOC_SRC)
+	$(OCAMLDOC) -charset $(DOC_CHARSET) -d doc -html $(DGRAPH_INCLUDES) \
+		-I lib -I src $(DOC_SRC)
 
 # literate programming
 $(NAME).tex: $(DOC_SRC)
 	$(OCAMLWEB) -o $@ $^
 
 wc:
-	ocamlwc -p $(SRCDIR)/*.mli $(SRCDIR)/*.ml
+	ocamlwc -p $(OCAMLGRAPH_SRCDIR)/*.mli $(OCAMLGRAPH_SRCDIR)/*.ml
 
 # file headers
 ##############
@@ -476,9 +498,9 @@ headers:
 	headache \
 	   -c misc/headache_config.txt \
 	   -h misc/header.txt \
-	   Makefile.in configure.in README \
-	   $(LIBDIR)/*.ml $(LIBDIR)/*.ml[ily] \
-	   $(SRCDIR)/*.ml $(SRCDIR)/*.ml[ily] \
+	   Makefile.in configure.in README.adoc \
+	   $(OCAMLGRAPH_LIBDIR)/*.ml $(OCAMLGRAPH_LIBDIR)/*.ml[ily] \
+	   $(OCAMLGRAPH_SRCDIR)/*.ml $(OCAMLGRAPH_SRCDIR)/*.ml[ily] \
 	   $(ED_DIR)/*.ml $(ED_DIR)/*.mli
 	headache \
 	   -c misc/headache_config.txt \
@@ -500,7 +522,7 @@ FILES = src/*.ml* lib/*.ml* Makefile.in configure configure.in META.in  \
 	view_graph/README view_graph/Makefile \
 	dgraph/*.ml dgraph/*.mli \
 	examples/*.ml tests/*.ml \
-	README FAQ CREDITS INSTALL COPYING LICENSE CHANGES
+	README.adoc FAQ CREDITS INSTALL.adoc COPYING LICENSE CHANGES
 
 export: source export-doc export-web export-delaunay
 
@@ -511,7 +533,7 @@ source:
 	cp --parents $(FILES) export/$(EXPORTDIR)
 	cd export ; tar cf $(TAR) $(EXPORTDIR) ; gzip -f --best $(TAR)
 	cp export/$(TAR).gz $(FTP)
-	cp README FAQ CREDITS COPYING LICENSE CHANGES $(EXAMPLES) $(FTP)
+	cp README.adoc FAQ CREDITS COPYING LICENSE CHANGES $(EXAMPLES) $(FTP)
 
 # Build and install the .tar.gz requiered by Frama-C
 framac: EXPORTDIR=ocamlgraph
@@ -611,12 +633,12 @@ configure: configure.in
 
 clean:
 	rm -f *~
-	for d in $(SRCDIR) $(LIBDIR) $(ED_DIR) $(VIEWER_DIR) $(DGRAPH_DIR) \
+	for d in $(OCAMLGRAPH_SRCDIR) $(OCAMLGRAPH_LIBDIR) $(ED_DIR) $(VIEWER_DIR) $(DGRAPH_DIR) \
 		tests examples; \
 	do \
 	  rm -f $$d/*.cm[iox] $$d/*$(OBJEXT) $$d/*~ $$d/*.annot; \
 	done
-	rm -f $(GENERATED) $(SRCDIR)/dot_parser.output
+	rm -f $(GENERATED) $(OCAMLGRAPH_SRCDIR)/dot_parser.output
 	rm -f graph.*a graph.cm* graph.o graph$(LIBEXT)
 	rm -f $(ED_DIR)/editor.byte $(ED_DIR)/editor.opt
 	rm -f $(VIEWER_DIR)/viewgraph.byte $(VIEWER_DIR)/viewgraph.opt
@@ -638,8 +660,8 @@ svnclean svn-clean:: dist-clean
 .depend depend: $(GENERATED)
 	rm -f .depend
 	$(OCAMLDEP) $(INCLUDES) -I $(ED_DIR) -I $(VIEWER_DIR) -I $(DGRAPH_DIR)\
-		$(LIBDIR)/*.ml $(LIBDIR)/*.mli \
-		$(SRCDIR)/*.ml $(SRCDIR)/*.mli \
+		$(OCAMLGRAPH_LIBDIR)/*.ml $(OCAMLGRAPH_LIBDIR)/*.mli \
+		$(OCAMLGRAPH_SRCDIR)/*.ml $(OCAMLGRAPH_SRCDIR)/*.mli \
 		$(ED_DIR)/*.mli $(ED_DIR)/*.ml \
 		$(VIEWER_DIR)/*.mli $(VIEWER_DIR)/*.ml \
 		$(DGRAPH_DIR)/*.mli $(DGRAPH_DIR)/*.ml > .depend

README → README.adoc

-**************************************************************************
-*                                                                        *
-*  OCamlgraph: a generic graph library for OCaml                         *
-*  Copyright (C) 2004-2013                                               *
-*  Sylvain Conchon, Jean-Christophe Filliatre and Julien Signoles        *
-*                                                                        *
-*  This software is free software; you can redistribute it and/or        *
-*  modify it under the terms of the GNU Library General Public           *
-*  License version 2.1, with the special exception on linking            *
-*  described in file LICENSE.                                            *
-*                                                                        *
-*  This software is distributed in the hope that it will be useful,      *
-*  but WITHOUT ANY WARRANTY; without even the implied warranty of        *
-*  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.                  *
-*                                                                        *
-**************************************************************************
-
+= OCamlgraph
 
 OCamlgraph is a graph library for Ocaml. Its contribution is three-fold:
 
@@ -22,19 +6,19 @@ OCamlgraph is a graph library for Ocaml. Its contribution is three-fold:
    operations and algorithms over graphs, in Graph.Pack.Digraph.
    It is a reasonably efficient imperative data structure for directed graphs
    with vertices and edges labeled with integers.
-
++
 Have a look at this module first in order to get an overview of what
-   this library provides. See also `demo.ml'.
+this library provides. See also `demo.ml`.
 
 2. Then OCamlgraph provides several other graph implementations for those
-   not satisfied with the one above. Some are persistent (imutable) and other
+   not satisfied with the one above. Some are persistent (immutable) and other
    imperative (mutable). Some are directed and other are not.
    Some have labels for vertices, or labels for edges, or both.
    Some have abstract types for vertices. etc.
- 
++
 See interface Sig for the graph signatures and modules Persistent and
 Imperative for the implementations.
-
++
 These implementations are written as functors: you give the types of
 vertices labels, edge labels, etc. and you get the data structure as a
 result.
@@ -47,30 +31,35 @@ OCamlgraph is a graph library for Ocaml. Its contribution is three-fold:
    all vertices, over the successors of a vertex, etc.
 
 
-How to link with OCamlgraph
----------------------------
+== How to link with OCamlgraph
 
-OCamlgraph is packaged as a single module `Graph'. Link is done as follows:
+You can use the `ocamlgraph` ocamlfind package:
 
-- bytecode
+	ocamlfind ocamlopt -package ocamlgraph ...
+
+(To produce an executable, also add the `-linkpkg` option.)
+
+If you want to invoke the compiler directly, OCamlgraph is packaged as
+a single module `Graph`. Linking is done as follows:
+
+bytecode::
 
 	ocamlc graph.cma <other files>
 
-- native code
+native code::
 
 	ocamlopt graph.cmxa <other files>
 
+== Examples
 
-Examples
---------
-
-You'll find examples of OCamlgraph use in demo.ml, demo_planar.ml and color.ml 
-(you can compile these programs with "make demo.opt", "make demo_planar.opt"
-and "make color.opt" respectively).
+You'll find examples of OCamlgraph use in subdirectory examples/
+(demo.ml, demo_planar.ml, color.ml, etc.).  You can compile these
+programs with `make examples`. Corresponding binaries are produced in
+subdirectory bin/. You can also build them individually, e.g. `make
+bin/demo.opt` compiles examples/demo.ml.
 
 
-Bug reports
------------
+== Bug reports
 
 Bug reports can be sent to
 

configure

@@ -1745,7 +1745,7 @@ esac
 
 # OCAMLLIB=`$OCAMLC -v | tail -n 1 | cut -f 4 -d " "`
 # OCAMLLIB=`$OCAMLC -v | tail -n 1 | sed -e 's|[[^:]]*: \(.*\)|\1|' `
-OCAMLLIB=`$OCAMLC -where | tr -d '\r'`
+OCAMLLIB=`$OCAMLC -where | tr -d '\\r' | tr '\\\\' '/'`
 echo "ocaml library path is $OCAMLLIB"
 
 # then we look for ocamlopt; if not present, we issue a warning
@@ -2249,7 +2249,7 @@ fi
 if test "$OCAMLFIND" = "" ; then
    echo "No ocamlfind detected"
 else
-   OCAMLLIB_BY_FINDLIB=`ocamlfind printconf stdlib | tr -d '\\r'`
+   OCAMLLIB_BY_FINDLIB=`ocamlfind printconf stdlib | tr -d '\\r' | tr '\\\\' '/'`
    if test "$OCAMLLIB_BY_FINDLIB" = "$OCAMLLIB" ; then
       echo "OCamlfind detected and enabled"
    else

configure.in

@@ -59,7 +59,7 @@ esac
 
 # OCAMLLIB=`$OCAMLC -v | tail -n 1 | cut -f 4 -d " "`
 # OCAMLLIB=`$OCAMLC -v | tail -n 1 | sed -e 's|[[^:]]*: \(.*\)|\1|' `
-OCAMLLIB=`$OCAMLC -where | tr -d '\r'`
+OCAMLLIB=`$OCAMLC -where | tr -d '\\r' | tr '\\\\' '/'`
 echo "ocaml library path is $OCAMLLIB"
 
 # then we look for ocamlopt; if not present, we issue a warning
@@ -146,7 +146,7 @@ AC_CHECK_PROG(OCAMLFIND,ocamlfind,ocamlfind)
 if test "$OCAMLFIND" = "" ; then
    echo "No ocamlfind detected"
 else
-   OCAMLLIB_BY_FINDLIB=`ocamlfind printconf stdlib | tr -d '\\r'`
+   OCAMLLIB_BY_FINDLIB=`ocamlfind printconf stdlib | tr -d '\\r' | tr '\\\\' '/'`
    if test "$OCAMLLIB_BY_FINDLIB" = "$OCAMLLIB" ; then
       echo "OCamlfind detected and enabled"
    else

dgraph/dGraphModel.ml

@@ -27,7 +27,6 @@
 
 open Graph
 open XDot
-open Printf
 
 exception DotError of string
 
@@ -62,12 +61,16 @@ end
 
 (* BUILDING A MODEL WITH AN OCAML GRAPH *)
 
-module Make(G : Graphviz.GraphWithDotAttrs) = struct
+module Make(G : Graphviz.GraphWithDotAttrs)
+ = struct
+
+   exception Multiple_layouts of (G.E.t * edge_layout) list
 
   type cluster = string
   module X = XDot.Make(G)
 
-  class model layout g : [G.vertex, G.edge, cluster] abstract_model = object
+  class model layout g : [G.vertex, G.edge, cluster] abstract_model =
+  object (self)
 
     (* Iterators *)
     method iter_edges f = G.iter_edges f g
@@ -79,7 +82,7 @@ module Make(G : Graphviz.GraphWithDotAttrs) = struct
     method iter_vertex f = G.iter_vertex f g
     method iter_associated_vertex f v = f v
     method iter_clusters f =
-      Hashtbl.iter (fun k v -> f k) layout.X.cluster_layouts
+      Hashtbl.iter (fun k _ -> f k) layout.X.cluster_layouts
 
     (* Membership functions *)
     method find_edge = try G.find_edge g with Not_found -> assert false
@@ -97,8 +100,28 @@ module Make(G : Graphviz.GraphWithDotAttrs) = struct
       with Not_found -> assert false
 
     method get_edge_layout e =
-      try X.HE.find layout.X.edge_layouts e
-      with Not_found -> assert false
+      try X.HE.find e layout.X.edge_layouts
+      with Not_found ->
+        (* if there are several edges from a vertex [v1] to a vertex [v2], they
+           can share the same layout. In that case, one these edges is
+           unfortunately not in the layout table because of key sharing. Try to
+           recover it when possible by creating a list of all possible layouts
+           for the given edge. If there is only one, easy win, otherwise return
+           them all in an exception and let the caller decide what to do *)
+        let layouts = ref [] in
+        self#iter_succ_e
+          (fun e' ->
+            if G.V.equal (self#dst e) (self#dst e') then
+              try
+                let layout = X.HE.find e' layout.X.edge_layouts in
+                if not (List.exists (fun (_, l) -> layout = l) !layouts) then
+                  layouts := (e', layout) :: !layouts
+              with Not_found -> ())
+          (self#src e);
+        match !layouts with
+        | [] -> assert false
+        | [ _, x ] -> x
+        | _ :: _ :: _ -> raise (Multiple_layouts !layouts)
 
     method get_cluster_layout c =
       try Hashtbl.find layout.X.cluster_layouts c
@@ -114,8 +137,7 @@ module Make(G : Graphviz.GraphWithDotAttrs) = struct
     close_out out;
     (* Get layout from dot file *)
     let layout =
-      try
-        X.layout_of_dot ~cmd ~dot_file g 
+      try X.layout_of_dot ~cmd ~dot_file g
       with X.DotError err -> raise (DotError err)
     in
     let model = new model layout g in
@@ -160,7 +182,6 @@ module DotParser =
 
 module DotModel = struct
   type cluster = string
-  type clusters_hash = (cluster, Graph.Dot_ast.attr list) Hashtbl.t
   class model g clusters_hash bounding_box
     : [DotG.vertex, DotG.edge, cluster] abstract_model
     =

dgraph/dGraphModel.mli

@@ -55,6 +55,9 @@ class type ['vertex, 'edge, 'cluster] abstract_model = object
   (** Dot layout *)
   method bounding_box : bounding_box
   method get_edge_layout : 'edge -> edge_layout
+  (** @raise Multiple_layouts when there are several possible layouts for the
+      given edge *)
+
   method get_vertex_layout : 'vertex -> node_layout
   method get_cluster_layout : 'cluster -> cluster_layout
 end
@@ -62,9 +65,8 @@ end
 (** This functor creates a model from a graph *)
 module Make(G : Graph.Graphviz.GraphWithDotAttrs) : sig
 
-  open G
-
   type cluster = string
+  exception Multiple_layouts of (G.E.t * edge_layout) list
 
   class model:
     XDot.Make(G).graph_layout -> G.t -> [G.V.t, G.E.t, cluster] abstract_model

dgraph/dGraphRandModel.ml

@@ -24,10 +24,6 @@
 (**************************************************************************)
 
 open Graph
-open DGraphView
-open Printf
-
-let ($) f x = f x
 
 let element = function
   | [] -> invalid_arg "empty list in element"

dgraph/dGraphSubTree.ml

@@ -133,7 +133,7 @@ struct
     let complete_to_depth v missing =
       let pred_vertex = ref v in
       let next_vertex = ref v in
-      for i = 1 to missing - 1 do
+      for _i = 1 to missing - 1 do
         next_vertex := Tree.V.create (Tree.V.label v);
         HT.add tree.ghost_vertices !next_vertex ();
         let new_ghost_edge =

dgraph/dGraphTreeLayout.ml

@@ -25,8 +25,6 @@
 
 open Graph
 
-let ($) f x = f x
-
 let set_if_none field value = match field with
   | None -> Some value
   | Some a -> Some a
@@ -158,8 +156,8 @@ struct
 
   (* Convert an int in hexadecimal representing a color in rgb format to a
      string prefixed by # *)
-  let string_color i = Printf.sprintf "#%06X" i;;
-  let string_color32 i = Printf.sprintf "#%08lX" i;;
+  let string_color i = Printf.sprintf "#%06X" i
+  let string_color32 i = Printf.sprintf "#%08lX" i
 
   (** @return an array of positions to draw an edge from positions and
       dimensions of vertices *)
@@ -176,7 +174,7 @@ struct
     [| xsrc, ystart;
        xsrc +. xdec, ystart +. ydec;
        xdst -. xdec, yend -. ydec;
-       xdst, yend |];;
+       xdst, yend |]
 
   (** @return an array to draw an arrow from start and end positions of the
       edge *)
@@ -366,7 +364,7 @@ struct
     | `Dotted -> XDotDraw.Dotted
     | `Bold -> XDotDraw.Bold
     | `Invis -> XDotDraw.Invisible
-    | `Rounded -> XDotDraw.Rounded;;
+    | `Rounded -> XDotDraw.Rounded
 
   (* FOR VERTEX *)
 
@@ -412,11 +410,11 @@ struct
       let pos_array = [|(x,y1);(x1,y);(x,y2);(x2,y)|] in
       if filled then [ XDotDraw.Filled_polygon pos_array ]
       else [ XDotDraw.Unfilled_polygon pos_array ]
-    |_ -> [ XDotDraw.Unfilled_ellipse ((0.,0.),0.,0.) ];;
+    |_ -> [ XDotDraw.Unfilled_ellipse ((0.,0.),0.,0.) ]
 
   let vattrs_to_draw_operations v vattributes geometry_info =
     let vattrs = try HV.find vattributes v with Not_found -> assert false in
-    let width, height = get_dimensions v geometry_info in
+    let width, _height = get_dimensions v geometry_info in
     (* Vertex shape drawing *)
     XDotDraw.Pen_color (string_color32 (the vattrs.color)) ::
     XDotDraw.Style (List.map (style_to_style_attr) vattrs.style) ::
@@ -456,122 +454,6 @@ struct
 
   open Graphviz.DotAttributes
 
-  let get_clusters tree =
-    let clusters = Hashtbl.create 20 in
-    Tree.iter_vertex
-      (fun v -> match Tree.get_subgraph v with
-      | None -> ()
-      | Some c -> Hashtbl.add clusters c v)
-      tree;
-    clusters;;
-
-  let rec get_cluster_color = function
-    | [] -> 0x000000
-    | `Color c :: _ -> c
-    | _ :: q -> get_cluster_color q;;
-
-  let find_cluster_corners l geometry_info =
-    let max_x_distance = 2. *. geometry_info.x_offset in
-    let max_y_distance = 2. *. float geometry_info.y_offset in
-    let rec find_corners l corners_array =
-      let (minx,miny) = corners_array.(0) in
-      let (maxx,maxy) = corners_array.(3) in
-      match l with
-      |[] -> corners_array
-      |v :: tl ->
-        let x, y = get_position v geometry_info in
-        let w, h = get_dimensions v geometry_info in
-        let halfw = w /. 2. in
-        let x1 = x -. halfw and x2 = x +. halfw in
-        let y1 = y -. h and y2 = y +. h in
-          (* Should cluster be split in two *)
-        let x1_distance = minx -. x1 in
-        let x2_distance = x2 -. maxx in
-        let y1_distance = miny -. y1 in
-        let y2_distance = y2 -. maxy in
-        if x1_distance > max_x_distance ||
-          x2_distance > max_x_distance ||
-          y1_distance > max_y_distance ||
-          y2_distance > max_y_distance ||
-          ((x1_distance <> 0. || x2_distance <> 0.) &&
-              (y1_distance <> 0. || y2_distance <> 0.))
-        then
-          Array.append (find_corners tl corners_array)
-            (find_corners tl [| x1, y1; x1, y2; x2, y2; x2, y1 |])
-        else
-          let newminx = min x1 minx in
-          let newminy = min y1 miny in
-          let newmaxx = max x2 maxx in
-          let newmaxy = max y2 maxy in
-          find_corners tl [|(newminx,newminy);(newminx,newmaxy);
-                            (newmaxx,newmaxy);(newmaxx,newminy)|]
-    in
-    match l with
-    | [] ->
-      let z = 0., 0. in
-      Array.make 4 z
-    | v :: q ->
-      let x, y = get_position v geometry_info in
-      let w, h = get_dimensions v geometry_info in
-      let halfw = w /. 2. in
-      let x1 = x -. halfw in
-      let x2 = x +. halfw in
-      let y1 = y -. h in
-      let y2 = y +. h in
-      find_corners q [| x1, y1; x1, y2; x2, y2; x2, y1 |];;
-
-  let cluster_to_cluster_layout tree c clusters geometry_info =
-    let border_padding = 10. in
-    let vertices =
-      try Hashtbl.find_all clusters c
-      with Not_found -> assert false
-    in
-    let corners_array = find_cluster_corners vertices geometry_info in
-    let add_padding corners_array =
-      let (x1,y1) = corners_array.(0) in
-      let (x2,y2) = corners_array.(3) in
-      let x1_padded = x1 -. border_padding in
-      let x2_padded = x2 +. border_padding in
-      let y1_padded = y1 -. border_padding in
-      let y2_padded = y2 +. border_padding in
-      [|(x1_padded,y1_padded);(x1_padded,y2_padded);
-      (x2_padded,y2_padded);(x2_padded,y1_padded)|]
-    in
-    let rec _cut_corners_array corners_array =
-      ignore (assert false);
-      (* [JS 2010/09/09] does not work:
-         exponential time seems to be required! *)
-      let length = Array.length corners_array in
-      if length > 4 then
-        XDotDraw.Unfilled_polygon (add_padding (Array.sub corners_array 0 4)) ::
-        (_cut_corners_array (Array.sub corners_array 4 (length-4)))
-      else
-        [ XDotDraw.Unfilled_polygon (add_padding corners_array) ]
-    in
-    let (x1,y1) = corners_array.(0) in
-    let (x2,y2) = corners_array.(3) in
-    {
-      XDot.c_pos = ((x1 +. x2) /. 2., (y1 +. y2) /. 2.);
-      XDot.c_bbox = ((x1,y1),(x2,y2));
-      XDot.c_draw =
-        XDotDraw.Pen_color
-          (string_color (get_cluster_color c.sg_attributes)) ::
-        (*cut_corners_array corners_array*)[];
-      XDot.c_ldraw = []
-    };;
-
-  let build_cluster_layouts tree geometry_info =
-    let cluster_layouts = Hashtbl.create 7 in
-    let clusters = get_clusters tree in
-    let visited = ref [] in
-    Hashtbl.iter
-      (fun c _ ->
-        if not (List.mem c !visited) then
-          let lay = cluster_to_cluster_layout tree c clusters geometry_info in
-          Hashtbl.add cluster_layouts c.sg_name lay)
-    clusters;
-    cluster_layouts;;
-
   (* FOR EDGE *)
 
   type eattributes = {
@@ -590,7 +472,9 @@ struct
     mutable style : [ `Solid | `Dashed | `Dotted | `Bold | `Invis ] list
   }
 
-  let rec attributes_list_to_eattributes eattrs : edge list -> _ = function
+  let rec attributes_list_to_eattributes (eattrs:eattributes)
+      : edge list -> _
+    = function
     |[] -> ()
     | `Color c :: q ->
       eattrs.color <-
@@ -637,7 +521,7 @@ struct
       |`Labeldistance _ | `Labelfloat _ | `Layer _ | `Minlen _ | `Penwidth _
       | `Samehead _  | `Sametail _ | `Taillabel _ | `Tailport _ | `Tailurl _
       | `Weight _ ) :: q ->
-      attributes_list_to_eattributes eattrs q;;
+      attributes_list_to_eattributes eattrs q
 
   let eattrs_to_operation tree e geometry_info =
     let eattrs = {
@@ -736,11 +620,11 @@ struct
          HV.add vertex_layouts v n_layout)
       tree;
 
-    let edge_layouts = HE.create 97 in
+    let edge_layouts = ref HE.empty in
     Tree.iter_edges_e
       (fun e ->
          let e_layout = edge_to_edge_layout tree e geometry_info in
-        HE.add edge_layouts e e_layout)
+         edge_layouts := HE.add e e_layout !edge_layouts)
       tree;
 
     let cluster_layouts = Hashtbl.create 7
@@ -748,10 +632,10 @@ struct
     (*  build_cluster_layouts tree geometry_info*)
     in
     { vertex_layouts = vertex_layouts;
-      edge_layouts = edge_layouts;
+      edge_layouts = !edge_layouts;
       cluster_layouts = cluster_layouts;
       bbox =
-        let ((x1,y1), (x2,y2) as bb) =
+        let ((_,_), (_,_) as bb) =
           HV.fold
             (fun v (x, y) ((minx, miny),(maxx, maxy) as acc) ->
                if TreeManipulation.is_ghost_node v then acc
@@ -833,7 +717,7 @@ struct
     bind_tree_tables forward_table backward_table root geometry_info
 
   (* VERTICES *)
-  let rec parse_n_draw_operations operations (abs, ord as pos) =
+  let parse_n_draw_operations operations (abs, ord as pos) =
     let polygon pts =
       let length = float (Array.length pts) in
       let oldabssum, oldordsum =
@@ -864,7 +748,7 @@ struct
           let translate_x,translate_y =
             node_pos_x-.initial_node_pos_x,node_pos_y-.initial_node_pos_y
           in
-        let (x,y as pos) = (* same affine move as the attached node has had*)
+          let (_,_ as pos) = (* same affine move as the attached node has had*)
             pos_x+.translate_x,
             pos_y+.translate_y
           in
@@ -872,9 +756,9 @@ struct
         | op -> op)
       operations
 
-  let parse_vertex_layout tree v orig_layout geometry_info =
+  let parse_vertex_layout _tree v orig_layout geometry_info =
     let width, height = get_dimensions v geometry_info in
-    let (abs, ord as pos) = get_position v geometry_info in
+    let (_,_ as pos) = get_position v geometry_info in
     { XDot.n_name = orig_layout.XDot.n_name;
       n_pos = pos;
       n_bbox = XDot.bounding_box pos width height;
@@ -901,7 +785,7 @@ struct
     | XDotDraw.Pen_color c :: tl ->
       XDotDraw.Pen_color c :: XDotDraw.Fill_color c ::
       (parse_e_draw_operations tl src dst geometry_info)
-    | op :: tl -> op :: (parse_e_draw_operations tl src dst geometry_info);;
+    | op :: tl -> op :: (parse_e_draw_operations tl src dst geometry_info)
 
   let rec parse_e_ldraw_operations operations src dst geometry_info =
     match operations with
@@ -912,9 +796,9 @@ struct
       let pos = ((xsrc +. xdst) /. 2., (ysrc +. ydst) /. 2.) in
       XDotDraw.Text (pos, align, w, s) ::
       (parse_e_ldraw_operations tl src dst geometry_info)
-      | op :: tl -> op :: (parse_e_ldraw_operations tl src dst geometry_info);;
+    | op :: tl -> op :: (parse_e_ldraw_operations tl src dst geometry_info)
 
-  let parse_edge_layout tree e layout geometry_info =
+  let parse_edge_layout _tree e layout geometry_info =
     let src = Tree.E.src e and dst = Tree.E.dst e in
     {
       XDot.e_draw =
@@ -925,11 +809,9 @@ struct
       e_tdraw = [];
       e_hldraw = [];
       e_tldraw = []
-    };;
+    }
 
   (* CLUSTERS *)
-  let parse_cluster_layout tree c global_layout geometry_info =
-    ();;
 
   let from_model tree root model =
     let geometry_info =
@@ -948,7 +830,7 @@ struct
          let v_layout = parse_vertex_layout tree v old_layout geometry_info in
          HV.add vertex_layouts v v_layout)
       tree;
-    let edge_layouts = HE.create 97 in
+    let edge_layouts = ref HE.empty in
     Tree.iter_edges_e
       (fun e ->
          let src = Tree.V.label (Tree.E.src e) in
@@ -964,15 +846,15 @@ struct
                e_tldraw = [] }
          in
          let e_layout = parse_edge_layout tree e old_layout geometry_info in
-        HE.add edge_layouts e e_layout)
+         edge_layouts := HE.add e e_layout !edge_layouts)
       tree;
     let cluster_layouts = Hashtbl.create 7 in
     let root_pos = get_position root geometry_info in
     { vertex_layouts = vertex_layouts;
-      edge_layouts = edge_layouts;
+      edge_layouts = !edge_layouts;
       cluster_layouts = cluster_layouts;
       bbox =
-        let ((x1,y1), (x2,y2) as bb) =
+        let ((_,_), (_,_) as bb) =
           HV.fold
             (fun v (x, y) ((minx, miny),(maxx, maxy) as acc) ->
                if TreeManipulation.is_ghost_node v then acc

dgraph/dGraphTreeModel.ml

@@ -39,9 +39,10 @@ module type S = sig
   end
 
   type cluster = string
+  type graph_layout
 
   class tree_model :
-    XDot.Make(Tree).graph_layout ->
+    graph_layout ->
     TreeManipulation.t ->
     [Tree.V.t, Tree.E.t, cluster] DGraphModel.abstract_model
 
@@ -61,6 +62,7 @@ struct
   type cluster = string
 
   module X = XDot.Make(T)
+  type graph_layout = X.graph_layout
 
   class tree_model layout tree
     : [ T.V.t, T.E.t, cluster ] DGraphModel.abstract_model
@@ -134,7 +136,7 @@ struct
         with Not_found -> assert false
 
       method get_edge_layout e =
-      try X.HE.find layout.X.edge_layouts e
+        try X.HE.find e layout.X.edge_layouts
         with Not_found -> assert false
 
       method get_cluster_layout c =

dgraph/dGraphTreeModel.mli

@@ -37,9 +37,10 @@ module type S = sig
   end
 
   type cluster = string
+  type graph_layout
 
   class tree_model :
-    XDot.Make(Tree).graph_layout ->
+    graph_layout ->
     TreeManipulation.t ->
     [ Tree.V.t, Tree.E.t, cluster ] DGraphModel.abstract_model
 

dgraph/dGraphView.ml

@@ -27,8 +27,6 @@ open DGraphViewItem
 
 let ($) f x = f x
 
-let distance x y = if x > y then x - y else y - x
-
 class type ['vertex, 'edge, 'cluster] view = object
   inherit GnoCanvas.canvas
   method model : ('vertex, 'edge, 'cluster) DGraphModel.abstract_model
@@ -291,8 +289,8 @@ module Make(V: Sig.HASHABLE)(E: Sig.HASHABLE)(C: Sig.HASHABLE) = struct
         ignore $ self#set_center_scroll_region true;
         ignore $ self#set_scroll_region ~x1 ~y1 ~x2 ~y2 ;
         (* Attach zoom events *)
-      ignore $ self#event#connect#key_press self#zoom_keys_ev;
-      ignore $ self#event#connect#scroll self#zoom_mouse_ev;
+        ignore $ self#event#connect#key_press ~callback:self#zoom_keys_ev;
+        ignore $ self#event#connect#scroll ~callback:self#zoom_mouse_ev;
 
     end
 
@@ -305,7 +303,7 @@ module Make(V: Sig.HASHABLE)(E: Sig.HASHABLE)(C: Sig.HASHABLE) = struct
     in
     (* Grab focus to process keyboard input *)
     ignore $ canvas#event#connect#enter_notify 
-      (fun _ -> canvas#misc#grab_focus () ; false); 
+      ~callback:(fun _ -> canvas#misc#grab_focus () ; false); 
     let view = 
       new view ?delay_node ?delay_edge ?delay_cluster
         (Gobject.unsafe_cast canvas#as_widget)