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

#
#
# add_file "schema_lexer.mll"
#  content [ed61256b28d1710d45787fce7b236f43759f6676]
#
# patch "Makefile"
#  from [44c31b63a433dde21fc61e2d75307b88593e06f6]
#    to [32653cf1b11ec035b32a203fff2901341794ea76]
#
# patch "NEWS"
#  from [88774fde6367af4a58445e53b538b03bb088beed]
#    to [b13365f9cd671224411dc354a0e549b37c204871]
#
# patch "configure.ac"
#  from [03cceb99b4e24b768f300dc4c66c1d564a770f7a]
#    to [7bc8b6f9d4905cbce41553f06a011fcf0ea5c784]
#
# patch "database.ml"
#  from [c3a9041e726e3ad8f2fe3116c87b4f1951d5ffde]
#    to [8050fdf19eecbfea0acd1b5f5db5bd6ace5967f4]
#
# patch "mlsqlite/ocaml-sqlite3.c"
#  from [d50d50529fb7addea2647f3f2369fe47d1e462a9]
#    to [7c98e2fdeb9663865485a3f21374dae11f74f46f]
#
# patch "mlsqlite/sqlite3.ml"
#  from [1bab996441c6aa8dc1e528681d6dcdc89d928f42]
#    to [53295e5f3023a4343a9708c102aa6622e12633fb]
#
# patch "viz_misc.ml"
#  from [e4da8d228a71dca79261bf14be9db15399c6de74]
#    to [6fd0c3f159b19117f0baf4570c3cec8b0a24aedc]
#
# patch "viz_misc.mli"
#  from [05b0d6067400240a80ed825580a60e65346b8b5e]
#    to [0cfad473122dc2494c4886ebf8ec3d362ef7ea5a]
#
============================================================
--- schema_lexer.mll	ed61256b28d1710d45787fce7b236f43759f6676
+++ schema_lexer.mll	ed61256b28d1710d45787fce7b236f43759f6676
@@ -0,0 +1,24 @@
+
+let ws    = [' ''\r''\n''\t']+
+let sep   = ['('')'','';']
+let token = [^ ' ''\r''\n''\t''('')'','';']+
+
+rule lex = parse
+  | ws          { lex lexbuf }
+  | sep         { Lexing.lexeme lexbuf }
+  | token       { Lexing.lexeme lexbuf }
+  | eof         { raise End_of_file }
+
+{
+ let massage_sql_tokens s =
+   let l = ref [] in
+   begin
+     try
+       let lb = Lexing.from_string s in
+       while true do
+	 l := (lex lb) :: !l
+       done
+     with End_of_file -> ()
+   end ;
+   String.concat " " (List.rev !l)
+}
============================================================
--- Makefile	44c31b63a433dde21fc61e2d75307b88593e06f6
+++ Makefile	32653cf1b11ec035b32a203fff2901341794ea76
@@ -19,7 +19,7 @@ SRC = base64.ml base64.mli sqlite3.ml sq
       dot_lexer.ml dot_parser.ml dot_parser.mli \
       revision_types.mli revision_lexer.ml revision_parser.ml revision_parser.mli \
       subprocess.ml subprocess.mli \
-      components.ml \
+      components.ml schema_lexer.ml \
       database.ml database.mli agraph.ml agraph.mli \
       autocolor.ml autocolor.mli viz_style.ml viz_style.mli \
       icon.ml ui.ml ui.mli unidiff.ml unidiff.mli \
@@ -43,7 +43,7 @@ DISTSRC = Makefile configure.ac config.m
           dot_types.mli dot_lexer.mll dot_parser.mly \
           subprocess.ml subprocess.mli icon.ml ui.ml ui.mli \
           revision_types.mli revision_lexer.mll revision_parser.mly \
-          components.ml database.ml database.mli agraph.ml agraph.mli \
+          components.ml schema_lexer.mll database.ml database.mli agraph.ml agraph.mli \
           unidiff.ml unidiff.mli gnomecanvas_hack.c view.ml view.mli \
           query.ml query.mli app.mli app.ml main.ml \
           mlsqlite/sqlite3.ml mlsqlite/sqlite3.mli mlsqlite/ocaml-sqlite3.c \
@@ -160,11 +160,13 @@ dist : ../$(NAME)-$(VERSION).tar.gz
 	@$(OCAMLDEP) $(DEP_FLAGS) -pp '$(CAMLP4O)' $(USE_P4) >> $@

 dist : ../$(NAME)-$(VERSION).tar.gz
-../$(NAME)-$(VERSION).tar.gz : $(DISTSRC)
-	test -d lablgtk
+dist-nolablgtk : ../$(NAME)-$(VERSION)-nolablgtk.tar.gz
+../$(NAME)-$(VERSION).tar.gz : $(DISTSRC)  $(DIST_LABLGTK)
+../$(NAME)-$(VERSION)-nolablgtk.tar.gz : $(DISTSRC)
+../%.tar.gz :
 	export DIRNAME="$${PWD##*/}" ; \
         cd .. && mv "$$DIRNAME" $(NAME)-$(VERSION) && \
-        tar zcvf $(@F) $(addprefix $(NAME)-$(VERSION)/,$(DISTSRC) $(DIST_LABLGTK)) && \
+        tar zcvf $(@F) $(addprefix $(NAME)-$(VERSION)/,$^) && \
         mv $(NAME)-$(VERSION) "$$DIRNAME"

 # no config.make
============================================================
--- NEWS	88774fde6367af4a58445e53b538b03bb088beed
+++ NEWS	b13365f9cd671224411dc354a0e549b37c204871
@@ -1,3 +1,8 @@
+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
============================================================
--- configure.ac	03cceb99b4e24b768f300dc4c66c1d564a770f7a
+++ configure.ac	7bc8b6f9d4905cbce41553f06a011fcf0ea5c784
@@ -1,4 +1,4 @@
-AC_INIT(monotone-viz, 0.12)
+AC_INIT(monotone-viz, 0.13)

 AC_PROG_OCAML
 AC_PROG_OCAML_TOOLS
@@ -42,7 +42,7 @@ if test "$LOCAL_LABLGTK" = "no" ; then
 fi

 if test "$LOCAL_LABLGTK" = "no" ; then
-  FINDLIB_LABLGTK=$(ocamlfind query lablgtk2 2> /dev/null)
+  FINDLIB_LABLGTK="$(ocamlfind query lablgtk2 2> /dev/null)"
   AC_CHECK_OCAML_MODULE(lablgtk, LABLGTK_DIR, GFile, +lablgtk2 +lablgtk ${FINDLIB_LABLGTK})
   # Stop if LablGTK is not found
   if test -z "$LABLGTK_DIR" ; then
@@ -52,7 +52,7 @@ option or the LABLGTK_DIR environment va
 specify its location to configure with the `--with-lablgtk-dir='
 option or the LABLGTK_DIR environment variable.])
   fi
-  LABLGTK_DIR=$(echo $LABLGTK_DIR | sed "s@^+@$OCAMLLIB/@")
+  LABLGTK_DIR="$(echo $LABLGTK_DIR | sed "s@^+@$OCAMLLIB/@")"
   # Check if LablGTK was compiled with libgnomecanvas support
   AC_MSG_CHECKING([GnomeCanvas support])
   if test -r "$LABLGTK_DIR/lablgnomecanvas.cma" ; then
@@ -119,15 +119,15 @@ option.])
 option.])
   fi
   if test "${MONOTONE_DIR:0:1}" != "/" ; then
-    MONOTONE_DIR=$(pwd)/$MONOTONE_DIR
+    MONOTONE_DIR="$(pwd)/$MONOTONE_DIR"
   fi
 fi
 AC_SUBST(MONOTONE_DIR)


 # Check for libcrypto using pkg-config, defaulting to /usr/lib
-CRYPTO_LIB_DIR=$(pkg-config openssl --variable=libdir)
-CRYPTO_LIB=${CRYPTO_LIB_DIR:-/usr/lib}/libcrypto.a
+CRYPTO_LIB_DIR="$(pkg-config openssl --variable=libdir)"
+CRYPTO_LIB="${CRYPTO_LIB_DIR:-/usr/lib}/libcrypto.a"
 AC_SUBST(CRYPTO_LIB)


============================================================
--- database.ml	c3a9041e726e3ad8f2fe3116c87b4f1951d5ffde
+++ database.ml	8050fdf19eecbfea0acd1b5f5db5bd6ace5967f4
@@ -9,39 +9,64 @@ let sql_escape s =
 let sql_escape s =
   String.concat "''" (string_split ~collapse:false '\'' s)

-let register_base64_functions db =
+let may_decode base64 v =
+  if base64 then monot_decode v else v
+
+let acc_one_col base64 acc row =
+  may_decode base64 row.(0) :: acc
+
+
+
+let setup_sqlite 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.create_fun_1 db "unbase64" (fun s -> `TEXT (monot_decode (Sqlite3.value_text s)))
+  Sqlite3.exec db "PRAGMA temp_store = MEMORY"

+let schema_id db =
+  let lines =
+    Sqlite3.fetch
+      db
+      "SELECT sql FROM sqlite_master \
+      	WHERE (type = 'table' OR type = 'index') \
+      	  AND sql IS NOT NULL \
+      	  AND name NOT LIKE 'sqlite_stat%' \
+      	ORDER BY name"
+      (acc_one_col false) [] in
+  let schema_data = String.concat "\n" (List.rev lines) in
+  let schema = Schema_lexer.massage_sql_tokens schema_data in
+  Viz_misc.hex_enc (Crypto.sha1 schema)
+
 let has_rosters db =
   Sqlite3.fetch db
     "SELECT name FROM sqlite_master WHERE name = 'rosters'"
     (fun _ _ -> true)
     false

-let fetch_pubkeys db tbl =
+let uses_base64 rosters schema_id =
+  not rosters || schema_id = "1db80c7cee8fa966913db1a463ed50bf1b0e5b0e"
+
+let fetch_pubkeys db base64 tbl =
   Sqlite3.fetch db
     "SELECT id, keydata, ROWID FROM public_keys"
     (fun () -> function
       | [| id; data; rowid |] ->
 	  begin
 	    try
-	      let key = Crypto.decode_rsa_pubkey (monot_decode data) in
+	      let data = may_decode base64 data in
+	      let key = Crypto.decode_rsa_pubkey data in
 	      Hashtbl.add tbl id (key, int_of_string rowid - 1)
 	    with Failure _ -> ()
 	  end
       | _ -> ())
     ()

-let fetch_branches db =
+let fetch_branches base64 db =
   List.sort compare
     (Sqlite3.fetch db
        "SELECT DISTINCT value FROM revision_certs WHERE name = 'branch'"
-       (fun acc row -> monot_decode row.(0) :: acc)
+       (acc_one_col base64)
        [])

 let view_name_domain = "ids_of_branch"
@@ -118,45 +143,23 @@ let process_ancestry_row_neigh_in g = fu
   | _ -> g


-let auto_cl_re = [
-  Str.regexp "\\(\\(explicit_\\)?merge of\\|propagate \\(of\\|from\\)\\) ", MERGE ;
-  Str.regexp "disapproval of ", DISAPPROVE
-]
-let re_match s (re, _) = Str.string_match re s 0
+let number_of_parent node =
+  List.fold_left
+    (fun n -> function
+      | (_, PARENT) -> n + 1
+      | _ -> n)
+    0
+    node.family

-let may_find f l = try Some (List.find f l) with Not_found -> None
+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_changelog_row g = function
-  | [| id; cl |] ->
-      begin
-	let cl = monot_decode cl in
-	match may_find (re_match cl) auto_cl_re with
-	| None -> g
-	| Some (_, kind) ->
-	    let node = NodeMap.find id g.nodes in
-	    let updated_edges =
-	      if kind = DISAPPROVE
-	      then begin
-		try
-		  let pid = list_rassoc PARENT node.family 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
-		with Not_found -> g.ancestry
-	      end
-	      else g.ancestry in
-	    let updated_nodes =
-	      if kind <> node.kind
-	      then NodeMap.add id { node with kind = kind } g.nodes
-	      else g.nodes in
-	    { g with ancestry = updated_edges ; nodes = updated_nodes }
-      end
-  | _ -> g
-
-
 let process_branching_edge_row g = function
   | [| parent; child |] ->
       { g with ancestry = EdgeMap.add (parent, child) BRANCHING g.ancestry }
@@ -202,12 +205,9 @@ let fetch_agraph_with_view db (query, qu
         WHERE child IN %s AND parent != '' AND parent NOT IN %s"
       view_name_domain view_name_limit view_name_limit in

-  (* look at changelogs to decide what nodes are 'uninteresting'
-     (ie merge or disapproval nodes) *)
+  (* find merge/propagate nodes (they have more than one parent) *)
   let agraph =
-    Sqlite3.fetch_f db process_changelog_row agraph
-      "SELECT C.id, C.value FROM revision_certs AS C, %s AS B WHERE C.name = 'changelog' AND C.id = B.id"
-      view_name_limit in
+    { agraph with nodes = find_merge_nodes agraph.nodes } in

   (* determine the branching edges *)
   let agraph =
@@ -240,14 +240,14 @@ let fetch_agraph_with_view db (query, qu
   agraph


-let encode_quote s =
-  let enc = monot_encode s in
-  let l = String.length enc in
-  let o = String.make (l + 2) '\'' in
-  String.blit enc 0 o 1 l ;
-  o
+let encode_quote base64 s =
+  if base64
+  then
+    String.concat "" [ "\'" ; monot_encode s ; "\'" ]
+  else
+    String.concat "" [ "X\'" ; Viz_misc.hex_enc s ; "\'" ]

-let fetch_with_view query db f =
+let fetch_with_view query base64 db f =
   let (query_domain, query_limit) = query in

   let register_date_p () =
@@ -255,7 +255,10 @@ let fetch_with_view query db f =
     | QUERY_BETWEEN (d1, d2) ->
 	Sqlite3.create_fun_1 db "date_p"
 	  (fun arg ->
-	    let d = monot_decode (Sqlite3.value_text arg) in
+	    let d =
+	      if base64
+	      then monot_decode (Sqlite3.value_text arg)
+	      else Sqlite3.value_blob arg in
 	    sql_of_bool (d1 <= d && d <= d2))
     | _ -> () in

@@ -271,7 +274,7 @@ let fetch_with_view query db f =
             WHERE name = 'branch' AND value IN (%s)"
 	  view_name_domain
 	  (String.concat ", "
-	     (List.map encode_quote q)) in
+	     (List.map (encode_quote base64) q)) in

   let view_query_date_limit () =
     Printf.sprintf
@@ -304,8 +307,8 @@ let fetch_with_view query db f =
       Sqlite3.exec_f db "DROP TABLE %s" view_name_domain)
     ()

-let fetch_agraph query db =
-  try fetch_with_view query db fetch_agraph_with_view
+let fetch_agraph query base64 db =
+  try fetch_with_view query base64 db fetch_agraph_with_view
   with exn ->
     Printf.eprintf "fetch_agraph exn: %s\n%!"
       (Printexc.to_string exn) ;
@@ -319,13 +322,13 @@ let decode_and_parse_revision rostered s
   revision_parser
     Revision_lexer.lex
     (Lexing.from_string
-       (Unzip.inflate_str ~kind:Unzip.GZip (monot_decode s)))
+       (Unzip.inflate_str ~kind:Unzip.GZip s))

-let fetch_revision_set rostered db id =
+let fetch_revision_set rostered b64 db id =
   decode_and_parse_revision
     rostered
     (List.hd
-       (Sqlite3.fetch_f db (fun acc row -> row.(0) :: acc) []
+       (Sqlite3.fetch_f db (acc_one_col b64) []
 	  "SELECT data FROM revisions WHERE id = '%s'" id))

 let verify_cert_sig pubkeys keypair name id v signature =
@@ -338,10 +341,10 @@ let verify_cert_sig pubkeys keypair name
     else SIG_BAD
   with Not_found -> SIG_UNKNOWN

-let process_certs pubkeys acc = function
+let process_certs pubkeys b64 acc = function
   | [| id; name; v; keypair; signature |] ->
-      let dec_v = monot_decode v in
-      let dec_sig = monot_decode signature in
+      let dec_v = may_decode b64 v in
+      let dec_sig = may_decode b64 signature in
       { c_id = id ;
 	c_name = name ;
 	c_value = dec_v ;
@@ -349,8 +352,8 @@ let process_certs pubkeys acc = function
 	c_signature = verify_cert_sig pubkeys keypair name id dec_v dec_sig } :: acc
   | _ -> acc

-let fetch_certs db pubkeys id =
-  Sqlite3.fetch_f db (process_certs pubkeys) []
+let fetch_certs db pubkeys b64 id =
+  Sqlite3.fetch_f db (process_certs pubkeys b64) []
     "SELECT id, name, value, keypair, signature \
        FROM revision_certs WHERE id = '%s'" id

@@ -369,17 +372,18 @@ let fetch_one_cert_field stmt id name ki
     (fun acc stmt ->
       let v = Sqlite3.column_text stmt 0 in
       match kind with
-      | `SIGNER -> v :: acc
-      | `VALUE  -> monot_decode v :: acc)
+      | `SIGNER
+      | `VALUE -> v :: acc
+      | `VALUE_B64 -> monot_decode v :: acc)
     []
     stmt

-let get_matching_cert db name p =
+let get_matching_cert db b64 name p =
   List.rev
     (Sqlite3.fetch_f db
        (fun acc -> function
 	 | [| id; v |] ->
-	     let dv = monot_decode v in
+	     let dv = may_decode b64 v in
 	     if p dv
 	     then (id, dv) :: acc
 	     else acc
@@ -421,11 +425,13 @@ type t = {


 type t = {
-    filename : string ;
-    db       : Sqlite3.db ;
-    pubkeys  : (string, Crypto.pub_rsa_key * int) Hashtbl.t ;
-    stmts    : Sqlite3.stmt array ;
-    mutable rostered : bool ;
+    filename  : string ;
+    db        : Sqlite3.db ;
+    pubkeys   : (string, Crypto.pub_rsa_key * int) Hashtbl.t ;
+    stmts     : Sqlite3.stmt array ;
+    rostered  : bool ;
+    base64    : bool ;
+    schema_id : string
   }


@@ -447,18 +453,23 @@ let open_db fname =
   let pubkeys = Hashtbl.create 17 in
   let stmts = [| prepare_fetch_one_cert_signer db ;
                  prepare_fetch_one_cert_value db |] in
-  let v = {
-    filename = fname ;
-    db       = db ;
-    pubkeys  = pubkeys ;
-    stmts    = stmts ;
-    rostered = false } in
-  sqlite_try (fun db ->
-    register_base64_functions db ;
-    fetch_pubkeys db pubkeys ;
-    v.rostered <- has_rosters db)
-    v ;
-  v
+  try
+    setup_sqlite db ;
+    let rostered = has_rosters db in
+    let schema   = schema_id db in
+    let base64   = uses_base64 rostered schema in
+    fetch_pubkeys db base64 pubkeys ;
+    { filename  = fname ;
+      db        = db ;
+      pubkeys   = pubkeys ;
+      stmts     = stmts ;
+      rostered  = rostered ;
+      base64    = base64 ;
+      schema_id = schema
+    }
+  with Sqlite3.Error (_, msg) ->
+    Sqlite3.close_db db ;
+    Viz_types.errorf "Error processing database %s:\n%s" fname msg

 let close_db { db = db ; stmts = stmts } =
   Sqlite3.close_db db
@@ -471,16 +482,16 @@ let fetch_branches db =
 let get_filename d = d.filename

 let fetch_branches db =
-  sqlite_try fetch_branches db
+  sqlite_try (fetch_branches db.base64) db

 let fetch_ancestry_graph db query =
-  sqlite_try (fetch_agraph query) db
+  sqlite_try (fetch_agraph query db.base64) db

 let fetch_revision d id =
     try
       let revision_set =
 	sqlite_try (fun db ->
-	  fetch_revision_set d.rostered db id)
+	  fetch_revision_set d.rostered d.base64 db id)
 	  d in
       let (manifest_id, edges) = revision_set in
       { revision_id = id ;
@@ -497,27 +508,28 @@ let fetch_certs_and_revision d id =
   { (fetch_revision d id)
     with certs =
       sqlite_try (fun db ->
-	fetch_certs db d.pubkeys id) d }
+	fetch_certs db d.pubkeys d.base64 id) d }

 let fetch_cert_signer db id name =
   sqlite_try (fun _ -> fetch_one_cert_field db.stmts.(0) id name `SIGNER) db

 let fetch_cert_value db id name =
-  sqlite_try (fun _ -> fetch_one_cert_field db.stmts.(1) id name `VALUE) db
+  let kind = if db.base64 then `VALUE_B64 else `VALUE in
+  sqlite_try (fun _ -> fetch_one_cert_field db.stmts.(1) id name kind) db

 let get_key_rowid { pubkeys = pubkeys } id =
   let (_, rowid) = Hashtbl.find pubkeys id in
   rowid

 let get_matching_tags db p =
-  get_matching_cert db.db "tag" p
+  get_matching_cert db.db db.base64 "tag" p

 let get_matching_dates db d_pref =
-  get_matching_cert db.db "date"
+  get_matching_cert db.db db.base64 "date"
     (string_is_prefix d_pref)

 let get_matching_ids db id_pref =
-  get_matching_cert db.db "branch"
+  get_matching_cert db.db db.base64 "branch"
     (string_is_prefix id_pref)

 let run_monotone_diff db monotone_exe status cb (old_id, new_id) =
============================================================
--- mlsqlite/ocaml-sqlite3.c	d50d50529fb7addea2647f3f2369fe47d1e462a9
+++ mlsqlite/ocaml-sqlite3.c	7c98e2fdeb9663865485a3f21374dae11f74f46f
@@ -122,7 +122,7 @@ ml_finalize_sqlite3 (value v)
 static void
 ml_finalize_sqlite3 (value v)
 {
-  struct user_function *list, *next;;
+  struct user_function *list, *next;
   struct ml_sqlite3_data *data = Sqlite3_data_val(v);
   caml_remove_global_root (&data->callbacks);
   caml_remove_global_root (&data->stmt_store);
@@ -806,14 +806,15 @@ ml_sqlite3_value_blob (value v)
 CAMLprim value
 ml_sqlite3_value_blob (value v)
 {
-  value r;
+  CAMLparam1(v);
+  CAMLlocal1(r);
   int len;
   const void *data;
   len = sqlite3_value_bytes (Sqlite3_value_val (v));
   r = caml_alloc_string (len);
   data = sqlite3_value_blob (Sqlite3_value_val (v));
   memcpy (Bp_val (r), data, len);
-  return r;
+  CAMLreturn(r);
 }

 CAMLprim value
@@ -837,7 +838,15 @@ ml_sqlite3_value_text (value v)
 CAMLprim value
 ml_sqlite3_value_text (value v)
 {
-  return caml_copy_string ((char *) sqlite3_value_text (Sqlite3_value_val (v)));
+  CAMLparam1(v);
+  CAMLlocal1(r);
+  int len;
+  const void *data;
+  len = sqlite3_value_bytes (Sqlite3_value_val (v));
+  r = caml_alloc_string (len);
+  data = sqlite3_value_text (Sqlite3_value_val (v));
+  memcpy (Bp_val (r), data, len);
+  CAMLreturn(r);
 }

 CAMLprim value
============================================================
--- mlsqlite/sqlite3.ml	1bab996441c6aa8dc1e528681d6dcdc89d928f42
+++ mlsqlite/sqlite3.ml	53295e5f3023a4343a9708c102aa6622e12633fb
@@ -259,7 +259,7 @@ let fetch_one ?column_names f init stmt
       let row =
 	Array.init
 	  (data_count stmt)
-	  (column_text stmt) in
+	  (column_blob stmt) in
       f acc row)
     init
     stmt
============================================================
--- viz_misc.ml	e4da8d228a71dca79261bf14be9db15399c6de74
+++ viz_misc.ml	6fd0c3f159b19117f0baf4570c3cec8b0a24aedc
@@ -178,6 +178,23 @@ let hex_dec s =
   o
 *)

+let char_of_hex v =
+  if v < 0xa
+  then Char.chr (v + Char.code '0')
+  else Char.chr (v - 0xa + Char.code 'a')
+
+let hex_enc s =
+  let len = String.length s in
+  let o = String.create (2 * len) in
+  for i = 0 to len - 1 do
+    let c = int_of_char s.[i] in
+    let hi = c lsr 4 in
+    o.[2*i] <- char_of_hex hi ;
+    let lo = c land 0xf in
+    o.[2*i + 1] <- char_of_hex lo
+  done ;
+  o
+
 let make_cache g =
   let tbl = Hashtbl.create 17 in
   fun k ->
============================================================
--- viz_misc.mli	05b0d6067400240a80ed825580a60e65346b8b5e
+++ viz_misc.mli	0cfad473122dc2494c4886ebf8ec3d362ef7ea5a
@@ -38,4 +38,6 @@ module Signal :
     val connect : 'a t -> ('a -> unit) -> unit
   end

+val hex_enc : string -> string
+
 val make_cache : ('a -> 'b) -> 'a -> 'b